summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
committerSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
commit7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch)
tree24d0f1d2a9751ca8c063409fd2ab71478b296efb
Imported Upstream version 7.9.2
-rw-r--r--.pc/.quilt_patches1
-rw-r--r--.pc/.quilt_series1
-rw-r--r--.pc/.version1
-rwxr-xr-x.pc/10-shebang.patch/contrib/scripts/dir2org.zsh56
-rw-r--r--.pc/30-local-mk.patch/local.mk0
-rw-r--r--.pc/applied-patches2
-rw-r--r--COPYING674
-rw-r--r--Makefile97
-rw-r--r--README45
-rw-r--r--contrib/README96
-rw-r--r--contrib/babel/langs/ob-fomus.el93
-rw-r--r--contrib/babel/langs/ob-oz.el294
-rw-r--r--contrib/babel/library-of-babel.org584
-rw-r--r--contrib/lisp/htmlize.el1769
-rw-r--r--contrib/lisp/org-annotate-file.el131
-rw-r--r--contrib/lisp/org-bibtex-extras.el155
-rw-r--r--contrib/lisp/org-bookmark.el88
-rw-r--r--contrib/lisp/org-checklist.el140
-rw-r--r--contrib/lisp/org-choose.el542
-rw-r--r--contrib/lisp/org-collector.el229
-rw-r--r--contrib/lisp/org-contacts.el621
-rw-r--r--contrib/lisp/org-contribdir.el38
-rw-r--r--contrib/lisp/org-depend.el420
-rw-r--r--contrib/lisp/org-drill.el3001
-rw-r--r--contrib/lisp/org-e-ascii.el1807
-rw-r--r--contrib/lisp/org-e-beamer.el1069
-rw-r--r--contrib/lisp/org-e-groff.el2090
-rw-r--r--contrib/lisp/org-e-html.el3044
-rw-r--r--contrib/lisp/org-e-latex.el2726
-rw-r--r--contrib/lisp/org-e-man.el1363
-rw-r--r--contrib/lisp/org-e-odt.el3762
-rw-r--r--contrib/lisp/org-e-publish.el1200
-rw-r--r--contrib/lisp/org-e-texinfo.el1844
-rw-r--r--contrib/lisp/org-elisp-symbol.el161
-rw-r--r--contrib/lisp/org-eval-light.el201
-rw-r--r--contrib/lisp/org-eval.el219
-rw-r--r--contrib/lisp/org-exp-bibtex.el148
-rw-r--r--contrib/lisp/org-expiry.el361
-rw-r--r--contrib/lisp/org-export-generic.el1504
-rw-r--r--contrib/lisp/org-export.el4518
-rw-r--r--contrib/lisp/org-git-link.el220
-rw-r--r--contrib/lisp/org-interactive-query.el312
-rw-r--r--contrib/lisp/org-invoice.el401
-rw-r--r--contrib/lisp/org-jira.el65
-rw-r--r--contrib/lisp/org-learn.el177
-rw-r--r--contrib/lisp/org-mac-iCal.el251
-rw-r--r--contrib/lisp/org-mac-link-grabber.el467
-rw-r--r--contrib/lisp/org-mairix.el332
-rw-r--r--contrib/lisp/org-man.el64
-rw-r--r--contrib/lisp/org-md.el461
-rw-r--r--contrib/lisp/org-mime.el336
-rw-r--r--contrib/lisp/org-mtags.el257
-rw-r--r--contrib/lisp/org-notify.el377
-rw-r--r--contrib/lisp/org-notmuch.el105
-rw-r--r--contrib/lisp/org-panel.el641
-rw-r--r--contrib/lisp/org-registry.el271
-rw-r--r--contrib/lisp/org-screen.el108
-rw-r--r--contrib/lisp/org-secretary.el232
-rw-r--r--contrib/lisp/org-static-mathjax.el171
-rw-r--r--contrib/lisp/org-sudoku.el290
-rw-r--r--contrib/lisp/org-toc.el488
-rw-r--r--contrib/lisp/org-track.el219
-rw-r--r--contrib/lisp/org-velocity.el724
-rw-r--r--contrib/lisp/org-wikinodes.el340
-rw-r--r--contrib/lisp/org2rem.el651
-rw-r--r--contrib/lisp/orgtbl-sqlinsert.el116
-rw-r--r--contrib/scripts/.gitignore1
-rw-r--r--contrib/scripts/StartOzServer.oz231
-rwxr-xr-xcontrib/scripts/dir2org.zsh54
-rw-r--r--contrib/scripts/docco.css185
-rw-r--r--contrib/scripts/org-docco.org206
-rwxr-xr-xcontrib/scripts/org2hpda106
-rw-r--r--contrib/scripts/staticmathjax/.gitignore1
-rw-r--r--contrib/scripts/staticmathjax/README.org79
-rw-r--r--contrib/scripts/staticmathjax/application.ini11
-rw-r--r--contrib/scripts/staticmathjax/chrome/chrome.manifest1
-rw-r--r--contrib/scripts/staticmathjax/chrome/content/main.js198
-rw-r--r--contrib/scripts/staticmathjax/chrome/content/main.xul11
-rw-r--r--contrib/scripts/staticmathjax/defaults/preferences/prefs.js1
-rw-r--r--debian/README.Debian7
-rw-r--r--debian/changelog416
-rw-r--r--debian/compat1
-rw-r--r--debian/control28
-rw-r--r--debian/copyright92
-rw-r--r--debian/dirs1
-rw-r--r--debian/doc-base11
-rw-r--r--debian/emacsen-install56
-rw-r--r--debian/emacsen-remove13
-rw-r--r--debian/emacsen-startup25
-rw-r--r--debian/patches/10-shebang.patch12
-rw-r--r--debian/patches/20-links-unescaping.patch26
-rw-r--r--debian/patches/30-local-mk.patch8
-rw-r--r--debian/patches/series3
-rwxr-xr-xdebian/rules52
-rw-r--r--debian/source/format1
-rw-r--r--debian/watch5
-rw-r--r--etc/Makefile31
-rw-r--r--etc/ORG-NEWS1432
-rw-r--r--etc/schema/od-manifest-schema-v1.2-cs01.rnc88
-rw-r--r--etc/schema/od-schema-v1.2-cs01.rnc6280
-rw-r--r--etc/schema/schemas.xml7
-rw-r--r--etc/styles/OrgOdtContentTemplate.xml263
-rw-r--r--etc/styles/OrgOdtStyles.xml797
-rw-r--r--etc/styles/README36
-rw-r--r--lisp/Makefile86
-rw-r--r--lisp/ob-C.el195
-rw-r--r--lisp/ob-R.el375
-rw-r--r--lisp/ob-asymptote.el150
-rw-r--r--lisp/ob-awk.el117
-rw-r--r--lisp/ob-calc.el108
-rw-r--r--lisp/ob-clojure.el96
-rw-r--r--lisp/ob-comint.el166
-rw-r--r--lisp/ob-css.el48
-rw-r--r--lisp/ob-ditaa.el91
-rw-r--r--lisp/ob-dot.el90
-rw-r--r--lisp/ob-emacs-lisp.el80
-rw-r--r--lisp/ob-eval.el261
-rw-r--r--lisp/ob-exp.el328
-rw-r--r--lisp/ob-fortran.el162
-rw-r--r--lisp/ob-gnuplot.el236
-rw-r--r--lisp/ob-haskell.el217
-rw-r--r--lisp/ob-io.el122
-rw-r--r--lisp/ob-java.el77
-rw-r--r--lisp/ob-js.el163
-rw-r--r--lisp/ob-keys.el103
-rw-r--r--lisp/ob-latex.el200
-rw-r--r--lisp/ob-ledger.el71
-rw-r--r--lisp/ob-lilypond.el436
-rw-r--r--lisp/ob-lisp.el108
-rw-r--r--lisp/ob-lob.el148
-rw-r--r--lisp/ob-matlab.el47
-rw-r--r--lisp/ob-maxima.el132
-rw-r--r--lisp/ob-mscgen.el85
-rw-r--r--lisp/ob-ocaml.el144
-rw-r--r--lisp/ob-octave.el282
-rw-r--r--lisp/ob-org.el70
-rw-r--r--lisp/ob-perl.el118
-rw-r--r--lisp/ob-picolisp.el194
-rw-r--r--lisp/ob-plantuml.el86
-rw-r--r--lisp/ob-python.el300
-rw-r--r--lisp/ob-ref.el265
-rw-r--r--lisp/ob-ruby.el245
-rw-r--r--lisp/ob-sass.el72
-rw-r--r--lisp/ob-scala.el120
-rw-r--r--lisp/ob-scheme.el137
-rw-r--r--lisp/ob-screen.el146
-rw-r--r--lisp/ob-sh.el216
-rw-r--r--lisp/ob-shen.el79
-rw-r--r--lisp/ob-sql.el169
-rw-r--r--lisp/ob-sqlite.el166
-rw-r--r--lisp/ob-table.el138
-rw-r--r--lisp/ob-tangle.el519
-rw-r--r--lisp/ob.el2604
-rwxr-xr-xlisp/org-agenda.el9227
-rw-r--r--lisp/org-archive.el540
-rw-r--r--lisp/org-ascii.el729
-rw-r--r--lisp/org-attach.el454
-rw-r--r--lisp/org-bbdb.el436
-rw-r--r--lisp/org-beamer.el656
-rw-r--r--lisp/org-bibtex.el687
-rw-r--r--lisp/org-capture.el1683
-rw-r--r--lisp/org-clock.el2780
-rw-r--r--lisp/org-colview-xemacs.el1720
-rw-r--r--lisp/org-colview.el1574
-rw-r--r--lisp/org-compat.el465
-rw-r--r--lisp/org-crypt.el273
-rw-r--r--lisp/org-ctags.el544
-rw-r--r--lisp/org-datetree.el210
-rw-r--r--lisp/org-docbook.el1454
-rw-r--r--lisp/org-docview.el90
-rw-r--r--lisp/org-element.el4356
-rw-r--r--lisp/org-entities.el574
-rw-r--r--lisp/org-eshell.el65
-rw-r--r--lisp/org-exp-blocks.el402
-rw-r--r--lisp/org-exp.el3351
-rw-r--r--lisp/org-faces.el781
-rw-r--r--lisp/org-feed.el698
-rw-r--r--lisp/org-footnote.el951
-rw-r--r--lisp/org-freemind.el1226
-rw-r--r--lisp/org-gnus.el295
-rw-r--r--lisp/org-habit.el386
-rw-r--r--lisp/org-html.el2752
-rw-r--r--lisp/org-icalendar.el687
-rw-r--r--lisp/org-id.el684
-rw-r--r--lisp/org-indent.el434
-rw-r--r--lisp/org-info.el79
-rw-r--r--lisp/org-inlinetask.el484
-rw-r--r--lisp/org-install.el2190
-rw-r--r--lisp/org-irc.el255
-rw-r--r--lisp/org-jsinfo.el262
-rw-r--r--lisp/org-latex.el2902
-rw-r--r--lisp/org-list.el3295
-rw-r--r--lisp/org-lparse.el2301
-rw-r--r--lisp/org-mac-message.el216
-rw-r--r--lisp/org-macs.el422
-rw-r--r--lisp/org-mew.el136
-rw-r--r--lisp/org-mhe.el227
-rw-r--r--lisp/org-mks.el134
-rw-r--r--lisp/org-mobile.el1132
-rw-r--r--lisp/org-mouse.el1107
-rw-r--r--lisp/org-odt.el2850
-rw-r--r--lisp/org-pcomplete.el337
-rw-r--r--lisp/org-plot.el354
-rw-r--r--lisp/org-protocol.el652
-rw-r--r--lisp/org-publish.el1195
-rw-r--r--lisp/org-remember.el1152
-rw-r--r--lisp/org-rmail.el121
-rw-r--r--lisp/org-special-blocks.el104
-rw-r--r--lisp/org-src.el866
-rw-r--r--lisp/org-table.el4835
-rw-r--r--lisp/org-taskjuggler.el695
-rw-r--r--lisp/org-timer.el446
-rw-r--r--lisp/org-version.el27
-rw-r--r--lisp/org-vm.el180
-rw-r--r--lisp/org-w3m.el170
-rw-r--r--lisp/org-wl.el316
-rw-r--r--lisp/org-xoxo.el125
-rw-r--r--lisp/org.el22447
-rw-r--r--local.mk1
-rw-r--r--mk/default.mk148
-rw-r--r--mk/org-fixup.el199
-rw-r--r--mk/targets.mk155
-rw-r--r--mk/version.mk2
-rw-r--r--request-assign-future.txt44
224 files changed, 158242 insertions, 0 deletions
diff --git a/.pc/.quilt_patches b/.pc/.quilt_patches
new file mode 100644
index 0000000..6857a8d
--- /dev/null
+++ b/.pc/.quilt_patches
@@ -0,0 +1 @@
+debian/patches
diff --git a/.pc/.quilt_series b/.pc/.quilt_series
new file mode 100644
index 0000000..c206706
--- /dev/null
+++ b/.pc/.quilt_series
@@ -0,0 +1 @@
+series
diff --git a/.pc/.version b/.pc/.version
new file mode 100644
index 0000000..0cfbf08
--- /dev/null
+++ b/.pc/.version
@@ -0,0 +1 @@
+2
diff --git a/.pc/10-shebang.patch/contrib/scripts/dir2org.zsh b/.pc/10-shebang.patch/contrib/scripts/dir2org.zsh
new file mode 100755
index 0000000..f91ff17
--- /dev/null
+++ b/.pc/10-shebang.patch/contrib/scripts/dir2org.zsh
@@ -0,0 +1,56 @@
+#!/usr/bin/env zsh
+
+# desc:
+#
+# Output an org compatible structure representing the filesystem from
+# the point passed on the command line (or . by default).
+#
+# options:
+# none
+#
+# usage:
+# dir2org.zsh [DIR]...
+#
+# author:
+# Phil Jackson (phil@shellarchive.co.uk)
+
+set -e
+
+function headline {
+ local depth="${1}"
+ local text="${2}"
+
+ printf "%${depth}s %s" "" | tr ' ' '*'
+ echo " ${text}"
+}
+
+function scan_and_populate {
+ local depth="${1}"
+ local dir="${2}"
+
+ headline ${depth} "${dir}"
+
+ # if there is no files in dir then just move on
+ [[ $(ls "${dir}" | wc -l) -eq 0 ]] && return
+
+ (( depth += 1 ))
+
+ for f in $(ls -d "${dir}"/*); do
+ if [ -d "${f}" ]; then
+ scan_and_populate ${depth} "${f}"
+ else
+ headline ${depth} "[[file://${f}][${${f##*/}%.*}]]"
+ fi
+ done
+
+ (( depth -= 1 ))
+}
+
+function main {
+ local scan_dir="${1:-$(pwd)}"
+ local depth=0
+
+ scan_and_populate ${depth} "${scan_dir}"
+}
+
+main "${@}"
diff --git a/.pc/30-local-mk.patch/local.mk b/.pc/30-local-mk.patch/local.mk
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/.pc/30-local-mk.patch/local.mk
diff --git a/.pc/applied-patches b/.pc/applied-patches
new file mode 100644
index 0000000..e2648c6
--- /dev/null
+++ b/.pc/applied-patches
@@ -0,0 +1,2 @@
+10-shebang.patch
+30-local-mk.patch
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..94a9ed0
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..9a96ffa
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,97 @@
+# Makefile - for the org-mode distribution
+# GNU make is required
+#
+# This file is not part of GNU Emacs
+
+# set up environment
+ include mk/default.mk # defaults, customizable via "local.mk"
+-include local.mk # optional local customization, use default.mk as template
+
+# default target is "all" unless overridden in local.mk
+all::
+
+# Describe valid make targets for org-mode.
+.PHONY: targets help helpall
+targets: help
+help helpall::
+ $(info )
+ $(info Getting Help)
+ $(info ============)
+ $(info )
+ $(info make help - show brief help)
+ $(info make targets - ditto)
+ $(info make helpall - show extended help)
+ $(info )
+ $(info Build and Check)
+ $(info ===============)
+ $(info make - build Org ELisp and all documentation)
+ $(info make all - ditto)
+ $(info make compile - build Org ELisp files)
+ $(info make single - build Org ELisp files, single Emacs per source)
+ $(info make autoloads - create org-install.el to load Org in-place)
+ $(info make test - build Org ELisp files and run test suite)
+helpall::
+ $(info make test-dirty - check without building first)
+ $(info make compile-dirty - build only stale Org ELisp files)
+ $(info )
+ $(info Compatibility)
+ $(info =============)
+ $(info make oldorg - what the old make did: compile autoloads info)
+ $(info )
+ $(info Cleaning)
+ $(info ========)
+ $(info make clean - remove built Org ELisp files and documentation)
+ $(info make cleanall - remove everything that can be built and all remnants)
+ $(info make clean-install - remove previous Org installation)
+ $(info )
+ $(info Configuration Check)
+ $(info ===================)
+help helpall::
+ $(info make config - check main configuration)
+helpall::
+ $(info make config-version - check Org version)
+ $(info make config-test - check test configuration)
+ $(info make config-exe - check executables configuration)
+ $(info make config-cmd - check command configuration)
+ $(info make config-all - check all configuration)
+ $(info )
+ $(info Documentation)
+ $(info =============)
+help helpall::
+ $(info make doc - build all documentation)
+helpall::
+ $(info make docs - ditto)
+help helpall::
+ $(info make info - build Info documentation)
+helpall::
+ $(info make html - build HTML documentation)
+ $(info make pdf - build PDF documentation)
+ $(info make card - build reference cards)
+ $(info make refcard - ditto)
+help helpall::
+ $(info )
+ $(info Installation)
+ $(info ============)
+ $(info make install - build and install Org)
+helpall::
+ $(info make install-etc - build and install files in /etc)
+ $(info make install-lisp - build and install Org Elisp files)
+ $(info make install-info - build and install Info documentation)
+ $(info )
+ $(info Convenience)
+ $(info ===========)
+ $(info make up0 - pull from upstream)
+ $(info make up1 - pull from upstream, build and check)
+ $(info make up2 - pull from upstream, build, check and install)
+ $(info make update - pull from upstream and build)
+ $(info make update2 - pull from upstream, build and install)
+ $(info make uncompiled - combine cleanlisp and autoloads)
+ $(info make local.mk - create new local.mk as template for adaptation)
+help helpall::
+ $(info )
+ $(info Full documentation on Worg)
+ $(info ==========================)
+ $(info http://orgmode.org/worg/dev/org-build-system.html)
+ @echo ""
+
+ include mk/targets.mk # toplevel make machinery
diff --git a/README b/README
new file mode 100644
index 0000000..32c7925
--- /dev/null
+++ b/README
@@ -0,0 +1,45 @@
+The is a distribution of Org, a plain text notes and project planning
+tool for Emacs.
+
+The version of this release is: 7.9.1
+
+The homepage of Org is at http://orgmode.org
+
+This distribution contains:
+
+README
+ This file.
+
+COPYING
+ The GNU General Public License.
+
+Makefile
+ The makefile to compile and install Org. For installation
+ instructions, see the manual or the more detailed procedure
+ on Worg: http://orgmode.org/worg/dev/org-build-system.html
+
+mk/
+ Files needed for building Org.
+
+lisp/
+ Directory with all the Emacs Lisp files that make up Org.
+
+doc/
+ The documentation files. org.texi is the source of the
+ documentation, org.html and org.pdf are formatted versions of it.
+
+contrib/
+ A directory with third-party additions for Org. Some really cool
+ stuff is in there.
+
+etc/
+ Files needed for the ODT exporter.
+
+testing/
+ Testing suite for Org.
+
+request-assign-future.txt
+ The form that contributors have to sign and get processed with
+ the FSF before contributed changes can be integrated into the Org
+ core. All files in this distribution except the contrib/ directory
+ have copyright assigned to the FSF.
diff --git a/contrib/README b/contrib/README
new file mode 100644
index 0000000..7f71ae9
--- /dev/null
+++ b/contrib/README
@@ -0,0 +1,96 @@
+This directory contains add-ons to Org-mode.
+
+These contributions are not part of GNU Emacs or of the official Org-mode
+package. But the git repository for Org-mode is glad to provide useful way
+to distribute and develop them as long as they are distributed under a free
+software license.
+
+Please put your contribution in one of these directories:
+
+LISP (emacs-lisp code)
+======================
+htmlize.el --- Convert buffer text and decorations to HTML
+org2rem.el --- Convert org appointments into reminders
+org-annotate-file.el --- Annotate a file with org syntax
+org-bibtex-extras.el --- Extras for working with org-bibtex entries
+org-bookmark.el --- Links to bookmarks
+org-checklist.el --- org functions for checklist handling
+org-choose.el --- Use TODO keywords to mark decision states
+org-collector.el --- Collect properties into tables
+org-contacts --- Contacts management
+org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
+org-depend.el --- TODO dependencies for Org-mode
+org-drill.el --- Self-testing with org-learn
+org-element.el --- Parser and applications for Org syntax
+org-elisp-symbol.el --- Org links to emacs-lisp symbols
+org-eval.el --- The <lisp> tag, adapted from Muse
+org-eval-light.el --- Evaluate in-buffer code on demand
+org-exp-bibtex.el --- Export citations to LaTeX and HTML
+org-expiry.el --- Expiry mechanism for Org entries
+org-export.el --- Generic Export Engine For Org
+org-export-generic.el --- Export framework for configurable backends
+org-git-link.el --- Provide org links to specific file version
+org-interactive-query.el --- Interactive modification of tags query
+org-invoice.el --- Help manage client invoices in OrgMode
+org-jira.el --- Add a jira:ticket protocol to Org
+org-learn.el --- SuperMemo's incremental learning algorithm
+org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
+org-mac-link-grabber.el --- Grab links and URLs from various Mac applications
+org-mairix.el --- Hook mairix search into Org for different MUAs
+org-man.el --- Support for links to manpages in Org-mode
+org-mime.el --- org html export for text/html MIME emails
+org-mtags.el --- Support for some Muse-like tags in Org-mode
+org-notify.el --- Notifications for Org-mode
+org-notmuch.el --- Support for links to notmuch messages
+org-panel.el --- Simple routines for us with bad memory
+org-registry.el --- A registry for Org links
+org-screen.el --- Visit screen sessions through Org-mode links
+org-secretary.el --- Team management with org-mode
+org-static-mathjax.el --- Muse-like tags in Org-mode
+org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables
+orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions
+org-toc.el --- Table of contents for Org-mode buffer
+org-track.el --- Keep up with Org development
+org-velocity.el --- something like Notational Velocity for Org
+org-wikinodes.el --- CamelCase wiki-like links for Org
+
+
+EXPORT ENGINE AND BACKENDS (emacs-lisp code)
+============================================
+
+org-export.el --- the new export engine
+org-e-latex.el --- LaTeX export backend
+org-e-ascii.el --- ASCII export backend
+org-e-beamer.el --- Beamer export backend
+org-e-groff.el --- Groff export backend
+org-e-html.el --- HTML export backend
+org-e-man.el --- man pages export backend
+org-e-odt.el --- ODT export backend
+org-e-texinfo.el --- TeXinfo export backend
+org-md.el --- MarkDown export backend
+
+
+BABEL
+=====
+library-of-babel.org --- Documentation for the library of babel
+langs/ob-fomus.el --- Org-babel functions for fomus evaluation
+langs/ob-oz.el --- Org-babel functions for Oz evaluation
+
+
+ODT (OpenDocumentText)
+======================
+README.org --- Legacy documentation for Org ODT exporter
+
+
+SCRIPTS (shell, bash, etc.)
+===========================
+
+dir2org.zsh --- Org compatible fs structure output
+ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL
+org2hpda --- Generate hipster pda style printouts from Org-mode
+org-docco.org --- docco side-by-side annotated code export to HTML
+StartOzServer.oz --- implements the Oz-side of the Org-babel Oz interface
+staticmathjax --- XULRunner application to process MathJax statically
+
+This directory also contains supporting files for the following
+packages: ob-oz.el, org-docco.org, and org-static-mathjax.el.
diff --git a/contrib/babel/langs/ob-fomus.el b/contrib/babel/langs/ob-fomus.el
new file mode 100644
index 0000000..f7c6ca8
--- /dev/null
+++ b/contrib/babel/langs/ob-fomus.el
@@ -0,0 +1,93 @@
+;;; ob-fomus.el --- org-babel functions for fomus evaluation
+
+;; Copyright (C) 2011-2012 Torsten Anders
+
+;; Author: Torsten Anders
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+;; Version:
+
+;;; License:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating Fomus source code.
+;; For information on Fomus see http://fomus.sourceforge.net/
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in fomus
+;;
+;; 2) we are generally only going to return results of type "file"
+;;
+;; 3) we are adding the "file" and "cmdline" header arguments
+;;
+;; 4) there are no variables (at least for now)
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-default-header-args:fomus
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating a fomus source block.")
+
+(defun org-babel-expand-body:fomus (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapc
+ (lambda (pair)
+ (let ((name (symbol-name (car pair)))
+ (value (cdr pair)))
+ (setq body
+ (replace-regexp-in-string
+ (concat "\$" (regexp-quote name))
+ (if (stringp value) value (format "%S" value))
+ body))))
+ vars)
+ body))
+
+(defun org-babel-execute:fomus (body params)
+ "Execute a block of Fomus code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (out-file (cdr (assoc :file params)))
+ (cmdline (cdr (assoc :cmdline params)))
+ (cmd (or (cdr (assoc :cmd params)) "fomus"))
+ (in-file (org-babel-temp-file "fomus-" ".fms")))
+ (with-temp-file in-file
+ (insert (org-babel-expand-body:fomus body params)))
+ ;; TMP: testing
+ ;; (message (concat cmd
+ ;; " " (org-babel-process-file-name in-file)
+ ;; " " cmdline
+ ;; " -o " (org-babel-process-file-name out-file)))
+ (org-babel-eval
+ (concat cmd
+ " " (org-babel-process-file-name in-file)
+ " " cmdline
+ " -o " (org-babel-process-file-name out-file)) "")
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:fomus (session params)
+ "Return an error because Fomus does not support sessions."
+ (error "Fomus does not support sessions"))
+
+(provide 'ob-fomus)
+
+;;; ob-fomus.el ends here
diff --git a/contrib/babel/langs/ob-oz.el b/contrib/babel/langs/ob-oz.el
new file mode 100644
index 0000000..b778b4a
--- /dev/null
+++ b/contrib/babel/langs/ob-oz.el
@@ -0,0 +1,294 @@
+;;; ob-oz.el --- org-babel functions for Oz evaluation
+
+;; Copyright (C) 2009-2012 Torsten Anders and Eric Schulte
+
+;; Author: Torsten Anders and Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+;; Version: 0.02
+
+;;; License:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating Oz source code.
+;;
+;; Oz code is always send to the Oz Programming Environment (OPI), the
+;; Emacs mode and compiler interface for Oz programs. Therefore, only
+;; session mode is supported. In practice, non-session code blocks are
+;; handled equally well by the session mode. However, only a single
+;; session is supported. Consequently, the :session header argument is
+;; ignored.
+;;
+;; The Org-babel header argument :results is interpreted as
+;; follows. :results output requires the respective code block to be
+;; an Oz statement and :results value requires an Oz
+;; expression. Currently, results are only supported for expressions
+;; (i.e. the result of :results output is always nil).
+;;
+;; Expression evaluation happens synchronously. Therefore there is an
+;; additional header argument :wait-time <number>, which specifies the
+;; maximum time to wait for the result of a given expression. nil
+;; means to wait as long as it takes to get a result (potentially wait
+;; forever).
+;;
+;; NOTE: Currently the copyright of this file may not be in a state to
+;; permit inclusion as core software into Emacs or Org-mode.
+
+;;; Requirements:
+
+;; - Mozart Programming System, the implementation of the Oz
+;; programming language (http://www.mozart-oz.org/), which includes
+;; the major mode mozart for editing Oz programs.
+;;
+;; - StartOzServer.oz which is located in the contrib/scripts
+;; directory of the Org-mode repository
+
+;;; TODO:
+
+;; - Decide: set communication to \\switch -threadedqueries?
+;;
+;; - Only start Oz compiler when required, e.g., load Org-babel only when needed?
+;;
+;; - Avoid synchronous evaluation to avoid blocking Emacs (complex
+;; Strasheela programs can take long to find a result..). In order
+;; to cleanly map code blocks to their associated results (which can
+;; arrive then in any order) I could use IDs
+;; (e.g. integers). However, how do I do concurrency in Emacs Lisp,
+;; and how can I define org-babel-execute:oz concurrently.
+;;
+;; - Expressions are rarely used in Oz at the top-level, and using
+;; them in documentation and Literate Programs will cause
+;; confusion. Idea: hide expression from reader and instead show
+;; them statement (e.g., MIDI output statement) and then include
+;; result in Org file. Implementation: for expressions (:results
+;; value) support an additional header argument that takes arbitrary
+;; Oz code. This code is not seen by the reader, but will be used
+;; for the actual expression at the end. Alternative: feed all
+;; relevant code as statement (:results output), then add expression
+;; as extra code block which outputs, e.g., file name (so the file
+;; name must be accessible by global var), but the code of this
+;; extra codeblock is not seen. Hm, in that case it might be even
+;; more easy to manually add this link to the Org file.
+;;
+
+
+(require 'ob)
+;;; major mode for editing Oz programs
+(require 'mozart)
+
+;;
+;; Interface to communicate with Oz.
+;; (1) For statements without any results: oz-send-string
+;; (2) For expressions with a single result: oz-send-string-expression
+;; (defined in org-babel-oz-ResultsValue.el)
+;;
+
+;; oz-send-string-expression implements an additional very direct
+;; communication between Org-babel and the Oz compiler. Communication
+;; with the Oz server works already without this code via the function
+;; oz-send-string from mozart.el.in, but this function does not get
+;; back any results from Oz to Emacs. The following code creates a
+;; socket for sending code to the OPI compiler and results are
+;; returned by the same socket. On the Oz side, a socket is opened and
+;; conected to the compiler of the OPI (via oz-send-string). On the
+;; Emacs side, a connection to this socket is created for feeding code
+;; and receiving results. This additional communication channel to the
+;; OPI compiler ensures that results are returned cleanly (e.g., only
+;; the result of the sent code is returned, no parsing or any
+;; processing of *Oz Emulator* is required).
+;;
+;; There is no buffer, nor sentinel involved. Oz code is send
+;; directly, and results from Oz are send back, but Emacs Lisp
+;; requires a filter function for processing results.
+
+(defvar org-babel-oz-server-dir
+ (file-name-as-directory
+ (expand-file-name
+ "contrib/scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../../.."
+ (file-name-directory (or load-file-name buffer-file-name))))))
+ "Path to the contrib/scripts directory in which
+StartOzServer.oz is located.")
+
+(defvar org-babel-oz-port 6001
+ "Port for communicating with Oz compiler.")
+(defvar org-babel-oz-OPI-socket nil
+ "Socket for communicating with OPI.")
+
+(defvar org-babel-oz-collected-result nil
+ "Aux var to hand result from org-babel-oz-filter to oz-send-string-expression.")
+(defun org-babel-oz-filter (proc string)
+ "Processes output from socket org-babel-oz-OPI-socket."
+;; (setq org-babel-oz-collected-results (cons string org-babel-oz-collected-results))
+ (setq org-babel-oz-collected-result string)
+ )
+
+
+(defun org-babel-oz-create-socket ()
+ (message "Create OPI socket for evaluating expressions")
+ ;; Start Oz directly
+ (run-oz)
+ ;; Create socket on Oz side (after Oz was started).
+ (oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'"))
+ ;; Wait until socket is created before connecting to it.
+ ;; Quick hack: wait 3 sec
+ ;;
+ ;; extending time to 30 secs does not help when starting Emacs for
+ ;; the first time (and computer does nothing else)
+ (sit-for 3)
+ ;; connect to OPI socket
+ (setq org-babel-oz-OPI-socket
+ ;; Creates a socket. I/O interface of Emacs sockets as for processes.
+ (open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port))
+ ;; install filter
+ (set-process-filter org-babel-oz-OPI-socket #'org-babel-oz-filter)
+)
+
+;; communication with org-babel-oz-OPI-socket is asynchronous, but
+;; oz-send-string-expression turns is into synchronous...
+(defun oz-send-string-expression (string &optional wait-time)
+ "Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil."
+ (if (not org-babel-oz-OPI-socket)
+ (org-babel-oz-create-socket))
+ (let ((polling-delay 0.1)
+ result)
+ (process-send-string org-babel-oz-OPI-socket string)
+ ;; wait for result
+ (if wait-time
+ (let ((waited 0))
+ (unwind-protect
+ (progn
+ (while
+ ;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over
+ (not (or (not (equal org-babel-oz-collected-result nil))
+ (> waited wait-time)))
+ (progn
+ (sit-for polling-delay)
+;; (message "org-babel-oz: next polling iteration")
+ (setq waited (+ waited polling-delay))))
+;; (message "org-babel-oz: waiting over, got result or waiting timed out")
+;; (message (format "wait-time: %s, waited: %s" wait-time waited))
+ (setq result org-babel-oz-collected-result)
+ (setq org-babel-oz-collected-result nil))))
+ (unwind-protect
+ (progn
+ (while (equal org-babel-oz-collected-result nil)
+ (sit-for polling-delay))
+ (setq result org-babel-oz-collected-result)
+ (setq org-babel-oz-collected-result nil))))
+ result))
+
+(defun org-babel-expand-body:oz (body params)
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if vars
+ ;; prepend code to define all arguments passed to the code block
+ (let ((var-string (mapcar (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-oz-var-to-oz (cdr pair))))
+ vars)))
+ ;; only add var declarations if any variables are there
+ (mapconcat #'identity
+ (append (list "local") var-string (list "in" body "end"))
+ "\n"))
+ body)))
+
+(defun org-babel-execute:oz (body params)
+ "Execute a block of Oz code with org-babel. This function is
+called by `org-babel-execute-src-block' via multiple-value-bind."
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (full-body (org-babel-expand-body:oz body params))
+ (wait-time (plist-get params :wait-time)))
+ ;; actually execute the source-code block
+ (org-babel-reassemble-table
+ (cond
+ ((member "output" result-params)
+ (message "Org-babel: executing Oz statement")
+ (oz-send-string full-body))
+ ((member "value" result-params)
+ (message "Org-babel: executing Oz expression")
+ (oz-send-string-expression full-body (or wait-time 1)))
+ (t (error "either 'output' or 'results' must be members of :results.")))
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :roname-names params))
+ (cdr (assoc :rownames params))))))
+
+;; This function should be used to assign any variables in params in
+;; the context of the session environment.
+(defun org-babel-prep-session:oz (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "org-babel-prep-session:oz unimplemented"))
+;; TODO: testing... (copied from org-babel-haskell.el)
+;; (defun org-babel-prep-session:oz (session params)
+;; "Prepare SESSION according to the header arguments specified in PARAMS."
+;; (save-window-excursion
+;; (org-babel-oz-initiate-session session)
+;; (let* ((vars (org-babel-ref-variables params))
+;; (var-lines (mapconcat ;; define any variables
+;; (lambda (pair)
+;; (format "%s=%s"
+;; (car pair)
+;; (org-babel-ruby-var-to-ruby (cdr pair))))
+;; vars "\n"))
+;; (vars-file (concat (make-temp-file "org-babel-oz-vars") ".oz")))
+;; (when vars
+;; (with-temp-buffer
+;; (insert var-lines) (write-file vars-file)
+;; (oz-mode)
+;; ;; (inferior-oz-load-file) ; ??
+;; ))
+;; (current-buffer))))
+;;
+
+
+;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml)
+;;
+;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process
+;; UNUSED DEF
+(defun org-babel-oz-initiate-session (&optional session params)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (unless (string= session "none")
+ ;; TODO: make it possible to have multiple sessions
+ (save-window-excursion
+ ;; (run-oz)
+ (get-buffer oz-compiler-buffer))))
+
+(defun org-babel-oz-var-to-oz (var)
+ "Convert an elisp var into a string of Oz source code
+specifying a var of the same value."
+ (if (listp var)
+;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]")
+ (eval var)
+ (format "%s" var) ; don't preserve string quotes.
+;; (format "%s" var)
+ ))
+
+;; TODO:
+(defun org-babel-oz-table-or-string (results)
+ "If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (error "org-babel-oz-table-or-string unimplemented"))
+
+
+(provide 'ob-oz)
+;;; org-babel-oz.el ends here
diff --git a/contrib/babel/library-of-babel.org b/contrib/babel/library-of-babel.org
new file mode 100644
index 0000000..0098e72
--- /dev/null
+++ b/contrib/babel/library-of-babel.org
@@ -0,0 +1,584 @@
+#+title: The Library of Babel
+#+author: Org-mode People
+#+STARTUP: hideblocks
+
+* Introduction
+
+The Library of Babel is an extensible collection of ready-made and
+easily-shortcut-callable source-code blocks for handling common tasks.
+Org-babel comes pre-populated with the source-code blocks located in
+this file. It is possible to add source-code blocks from any org-mode
+file to the library by calling =(org-babel-lob-ingest
+"path/to/file.org")=.
+
+This file is included in worg mainly less for viewing through the web
+interface, and more for contribution through the worg git repository.
+If you have code snippets that you think others may find useful please
+add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg.
+
+The raw Org-mode text of this file can be downloaded at
+[[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]]
+
+* Simple
+
+A collection of simple utility functions:
+
+#+name: echo
+#+begin_src emacs-lisp :var input="echo'd"
+ input
+#+end_src
+
+* File I/O
+
+** Reading and writing files
+
+Read the contents of the file at =file=. The =:results vector= and
+=:results scalar= header arguments can be used to read the contents of
+file as either a table or a string.
+
+#+name: read
+#+begin_src emacs-lisp :var file="" :var format=""
+ (if (string= format "csv")
+ (with-temp-buffer
+ (org-table-import (expand-file-name file) nil)
+ (org-table-to-lisp))
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name file))
+ (buffer-string)))
+#+end_src
+
+Write =data= to a file at =file=. If =data= is a list, then write it
+as a table in traditional Org-mode table syntax.
+
+#+name: write
+#+begin_src emacs-lisp :var data="" :var file="" :var ext='()
+ (flet ((echo (r) (if (stringp r) r (format "%S" r))))
+ (with-temp-file file
+ (case (and (listp data)
+ (or ext (intern (file-name-extension file))))
+ ('tsv (insert (orgtbl-to-tsv data '(:fmt echo))))
+ ('csv (insert (orgtbl-to-csv data '(:fmt echo))))
+ (t (org-babel-insert-result data)))))
+ nil
+#+end_src
+
+** Remote files
+
+*** json
+
+Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects.
+
+#+name: json
+#+begin_src emacs-lisp :var file='() :var url='()
+ (require 'json)
+ (cond
+ (file
+ (with-temp-filebuffer file
+ (goto-char (point-min))
+ (json-read)))
+ (url
+ (require 'w3m)
+ (with-temp-buffer
+ (w3m-retrieve url)
+ (goto-char (point-min))
+ (json-read))))
+#+end_src
+
+*** Google docs
+
+The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line
+tool. This tool provides functionality for accessing Google services
+from the command line, and the following code blocks use /googlecl/
+for reading from and writing to Google docs with Org-mode code blocks.
+
+**** Read a document from Google docs
+
+The =google= command seems to be throwing "Moved Temporarily" errors
+when trying to download textual documents, but this is working fine
+for spreadsheets.
+
+#+name: gdoc-read
+#+begin_src emacs-lisp :var title="example" :var format="csv"
+ (let* ((file (concat title "." format))
+ (cmd (format "google docs get --format %S --title %S" format title)))
+ (message cmd) (message (shell-command-to-string cmd))
+ (prog1 (if (string= format "csv")
+ (with-temp-buffer
+ (org-table-import (shell-quote-argument file) '(4))
+ (org-table-to-lisp))
+ (with-temp-buffer
+ (insert-file-contents (shell-quote-argument file))
+ (buffer-string)))
+ (delete-file file)))
+#+end_src
+
+For example, a line like the following can be used to read the
+contents of a spreadsheet named =num-cells= into a table.
+: #+call: gdoc-read(title="num-cells"")
+
+A line like the following can be used to read the contents of a
+document as a string.
+
+: #+call: gdoc-read(title="loremi", :format "txt")
+
+**** Write a document to a Google docs
+
+Write =data= to a google document named =title=. If =data= is tabular
+it will be saved to a spreadsheet, otherwise it will be saved as a
+normal document.
+
+#+name: gdoc-write
+#+begin_src emacs-lisp :var title="babel-upload" :var data=fibs(n=10) :results silent
+ (let* ((format (if (listp data) "csv" "txt"))
+ (tmp-file (make-temp-file "org-babel-google-doc" nil (concat "." format)))
+ (cmd (format "google docs upload --title %S %S" title tmp-file)))
+ (with-temp-file tmp-file
+ (insert
+ (if (listp data)
+ (orgtbl-to-csv
+ data '(:fmt (lambda (el) (if (stringp el) el (format "%S" el)))))
+ (if (stringp data) data (format "%S" data)))))
+ (message cmd)
+ (prog1 (shell-command-to-string cmd) (delete-file tmp-file)))
+#+end_src
+
+example usage
+: #+name: fibs
+: #+begin_src emacs-lisp :var n=8
+: (flet ((fib (m) (if (< m 2) 1 (+ (fib (- m 1)) (fib (- m 2))))))
+: (mapcar (lambda (el) (list el (fib el))) (number-sequence 0 (- n 1))))
+: #+end_src
+:
+: #+call: gdoc-write(title="fibs", data=fibs(n=10))
+
+* Plotting code
+
+** R
+
+Plot column 2 (y axis) against column 1 (x axis). Columns 3 and
+beyond, if present, are ignored.
+
+#+name: R-plot
+#+begin_src R :var data=R-plot-example-data
+plot(data)
+#+end_src
+
+#+tblname: R-plot-example-data
+| 1 | 2 |
+| 2 | 4 |
+| 3 | 9 |
+| 4 | 16 |
+| 5 | 25 |
+
+#+call: R-plot(data=R-plot-example-data)
+
+#+resname: R-plot(data=R-plot-example-data)
+: nil
+
+** Gnuplot
+
+* Org reference
+
+** Headline references
+
+#+name: headline
+#+begin_src emacs-lisp :var headline=top :var file='()
+ (save-excursion
+ (when file (get-file-buffer file))
+ (org-open-link-from-string (org-make-link-string headline))
+ (save-restriction
+ (org-narrow-to-subtree)
+ (buffer-string)))
+#+end_src
+
+#+call: headline(headline="headline references")
+
+* Tables
+
+** LaTeX Table Export
+
+*** booktabs
+
+This source block can be used to wrap a table in the latex =booktabs=
+environment. The source block adds a =toprule= and =bottomrule= (so
+don't use =hline= at the top or bottom of the table). The =hline=
+after the header is replaced with a =midrule=.
+
+Note that this function bypasses the Org-mode LaTeX exporter and calls
+=orgtbl-to-generic= to create the output table. This means that the
+entries in the table are not translated from Org-mode to LaTeX.
+
+It takes the following arguments -- all but the first two are
+optional.
+
+| arg | description |
+|-------+--------------------------------------------|
+| table | a reference to the table |
+| align | alignment string |
+| env | optional environment, default to "tabular" |
+| width | optional width specification string |
+
+#+name: booktabs
+#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var align='() :var env="tabular" :var width='() :noweb yes :results latex
+ (flet ((to-tab (tab)
+ (orgtbl-to-generic
+ (mapcar (lambda (lis)
+ (if (listp lis)
+ (mapcar (lambda (el)
+ (if (stringp el)
+ el
+ (format "%S" el))) lis)
+ lis)) tab)
+ (list :lend " \\\\" :sep " & " :hline "\\hline"))))
+ (org-fill-template
+ "
+ \\begin{%env}%width%align
+ \\toprule
+ %table
+ \\bottomrule
+ \\end{%env}\n"
+ (list
+ (cons "env" (or env "table"))
+ (cons "width" (if width (format "{%s}" width) ""))
+ (cons "align" (if align (format "{%s}" align) ""))
+ (cons "table"
+ ;; only use \midrule if it looks like there are column headers
+ (if (equal 'hline (second table))
+ (concat (to-tab (list (first table)))
+ "\n\\midrule\n"
+ (to-tab (cddr table)))
+ (to-tab table))))))
+#+end_src
+
+*** longtable
+
+This block can be used to wrap a table in the latex =longtable=
+environment, it takes the following arguments -- all but the first two
+are optional.
+
+| arg | description |
+|-----------+-------------------------------------------------------------|
+| table | a reference to the table |
+| align | optional alignment string |
+| width | optional width specification string |
+| hline | the string to use as hline separator, defaults to "\\hline" |
+| head | optional "head" string |
+| firsthead | optional "firsthead" string |
+| foot | optional "foot" string |
+| lastfoot | optional "lastfoot" string |
+
+#+name: longtable
+#+begin_src emacs-lisp :var table='((:table)) :var align='() :var width='() :var hline="\\hline" :var firsthead='() :var head='() :var foot='() :var lastfoot='() :noweb yes :results latex
+ (org-fill-template
+ "
+ \\begin{longtable}%width%align
+ %firsthead
+ %head
+ %foot
+ %lastfoot
+
+ %table
+ \\end{longtable}\n"
+ (list
+ (cons "width" (if width (format "{%s}" width) ""))
+ (cons "align" (if align (format "{%s}" align) ""))
+ (cons "firsthead" (if firsthead (concat firsthead "\n\\endfirsthead\n") ""))
+ (cons "head" (if head (concat head "\n\\endhead\n") ""))
+ (cons "foot" (if foot (concat foot "\n\\endfoot\n") ""))
+ (cons "lastfoot" (if lastfoot (concat lastfoot "\n\\endlastfoot\n") ""))
+ (cons "table" (orgtbl-to-generic
+ (mapcar (lambda (lis)
+ (if (listp lis)
+ (mapcar (lambda (el)
+ (if (stringp el)
+ el
+ (format "%S" el))) lis)
+ lis)) table)
+ (list :lend " \\\\" :sep " & " :hline hline)))))
+#+end_src
+
+*** booktabs-notes
+
+This source block builds on [[booktabs]]. It accepts two additional
+arguments, both of which are optional.
+
+#+tblname: arguments
+| arg | description |
+|--------+------------------------------------------------------|
+| notes | an org-mode table with footnotes |
+| lspace | if non-nil, insert =addlinespace= after =bottomrule= |
+
+An example footnote to the =arguments= table specifies the column
+span. Note the use of LaTeX, rather than Org-mode, markup.
+
+#+tblname: arguments-notes
+| \multicolumn{2}{l}{This is a footnote to the \emph{arguments} table.} |
+
+#+name: booktabs-notes
+#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var notes='() :var align='() :var env="tabular" :var width='() :var lspace='() :noweb yes :results latex
+ (flet ((to-tab (tab)
+ (orgtbl-to-generic
+ (mapcar (lambda (lis)
+ (if (listp lis)
+ (mapcar (lambda (el)
+ (if (stringp el)
+ el
+ (format "%S" el))) lis)
+ lis)) tab)
+ (list :lend " \\\\" :sep " & " :hline "\\hline"))))
+ (org-fill-template
+ "
+ \\begin{%env}%width%align
+ \\toprule
+ %table
+ \\bottomrule%spacer
+ %notes
+ \\end{%env}\n"
+ (list
+ (cons "env" (or env "table"))
+ (cons "width" (if width (format "{%s}" width) ""))
+ (cons "align" (if align (format "{%s}" align) ""))
+ (cons "spacer" (if lspace "\\addlinespace" ""))
+ (cons "table"
+ ;; only use \midrule if it looks like there are column headers
+ (if (equal 'hline (second table))
+ (concat (to-tab (list (first table)))
+ "\n\\midrule\n"
+ (to-tab (cddr table)))
+ (to-tab table)))
+ (cons "notes" (if notes (to-tab notes) ""))
+ )))
+#+end_src
+
+** Elegant lisp for transposing a matrix
+
+#+tblname: transpose-example
+| 1 | 2 | 3 |
+| 4 | 5 | 6 |
+
+#+name: transpose
+#+begin_src emacs-lisp :var table=transpose-example
+ (apply #'mapcar* #'list table)
+#+end_src
+
+#+resname:
+| 1 | 4 |
+| 2 | 5 |
+| 3 | 6 |
+
+** Convert every element of a table to a string
+
+#+tblname: hetero-table
+| 1 | 2 | 3 |
+| a | b | c |
+
+#+name: all-to-string
+#+begin_src emacs-lisp :var tbl='()
+ (defun all-to-string (tbl)
+ (if (listp tbl)
+ (mapcar #'all-to-string tbl)
+ (if (stringp tbl)
+ tbl
+ (format "%s" tbl))))
+ (all-to-string tbl)
+#+end_src
+
+#+begin_src emacs-lisp :var tbl=hetero-table
+ (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl)
+#+end_src
+
+#+name:
+| nil | nil | nil |
+| t | t | t |
+
+#+begin_src emacs-lisp :var tbl=all-to-string(hetero-table)
+ (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl)
+#+end_src
+
+#+name:
+| t | t | t |
+| t | t | t |
+
+* Misc
+
+** File-specific Version Control logging
+ :PROPERTIES:
+ :AUTHOR: Luke Crook
+ :END:
+
+This function will attempt to retrieve the entire commit log for the
+file associated with the current buffer and insert this log into the
+export. The function uses the Emacs VC commands to interface to the
+local version control system, but has only been tested to work with
+Git. 'limit' is currently unsupported.
+
+#+name: vc-log
+#+headers: :var limit=-1
+#+headers: :var buf=(buffer-name (current-buffer))
+#+begin_src emacs-lisp
+ ;; Most of this code is copied from vc.el vc-print-log
+ (require 'vc)
+ (when (vc-find-backend-function
+ (vc-backend (buffer-file-name (get-buffer buf))) 'print-log)
+ (let ((limit -1)
+ (vc-fileset nil)
+ (backend nil)
+ (files nil))
+ (with-current-buffer (get-buffer buf)
+ (setq vc-fileset (vc-deduce-fileset t)) ; FIXME: Why t? --Stef
+ (setq backend (car vc-fileset))
+ (setq files (cadr vc-fileset)))
+ (with-temp-buffer
+ (let ((status (vc-call-backend
+ backend 'print-log files (current-buffer))))
+ (when (and (processp status) ; Make sure status is a process
+ (= 0 (process-exit-status status))) ; which has not terminated
+ (while (not (eq 'exit (process-status status)))
+ (sit-for 1 t)))
+ (buffer-string)))))
+#+end_src
+
+** Trivial python code blocks
+
+#+name: python-identity
+#+begin_src python :var a=1
+a
+#+end_src
+
+#+name: python-add
+#+begin_src python :var a=1 :var b=2
+a + b
+#+end_src
+
+** Arithmetic
+
+#+name: lob-add
+#+begin_src emacs-lisp :var a=0 :var b=0
+ (+ a b)
+#+end_src
+
+#+name: lob-minus
+#+begin_src emacs-lisp :var a=0 :var b=0
+ (- a b)
+#+end_src
+
+#+name: lob-times
+#+begin_src emacs-lisp :var a=0 :var b=0
+ (* a b)
+#+end_src
+
+#+name: lob-div
+#+begin_src emacs-lisp :var a=0 :var b=0
+ (/ a b)
+#+end_src
+
+* GANTT Charts
+
+The =elispgantt= source block was sent to the mailing list by Eric
+Fraga. It was modified slightly by Tom Dye.
+
+#+name: elispgantt
+#+begin_src emacs-lisp :var table=gantttest
+ (let ((dates "")
+ (entries (nthcdr 2 table))
+ (milestones "")
+ (nmilestones 0)
+ (ntasks 0)
+ (projecttime 0)
+ (tasks "")
+ (xlength 1))
+ (message "Initial: %s\n" table)
+ (message "Entries: %s\n" entries)
+ (while entries
+ (let ((entry (first entries)))
+ (if (listp entry)
+ (let ((id (first entry))
+ (type (nth 1 entry))
+ (label (nth 2 entry))
+ (task (nth 3 entry))
+ (dependencies (nth 4 entry))
+ (start (nth 5 entry))
+ (duration (nth 6 entry))
+ (end (nth 7 entry))
+ (alignment (nth 8 entry)))
+ (if (> start projecttime) (setq projecttime start))
+ (if (string= type "task")
+ (let ((end (+ start duration))
+ (textposition (+ start (/ duration 2)))
+ (flush ""))
+ (if (string= alignment "left")
+ (progn
+ (setq textposition start)
+ (setq flush "[left]"))
+ (if (string= alignment "right")
+ (progn
+ (setq textposition end)
+ (setq flush "[right]"))))
+ (setq tasks
+ (format "%s \\gantttask{%s}{%s}{%d}{%d}{%d}{%s}\n"
+ tasks label task start end textposition flush))
+ (setq ntasks (+ 1 ntasks))
+ (if (> end projecttime)
+ (setq projecttime end)))
+ (if (string= type "milestone")
+ (progn
+ (setq milestones
+ (format
+ "%s \\ganttmilestone{$\\begin{array}{c}\\mbox{%s}\\\\ \\mbox{%s}\\end{array}$}{%d}\n"
+ milestones label task start))
+ (setq nmilestones (+ 1 nmilestones)))
+ (if (string= type "date")
+ (setq dates (format "%s \\ganttdateline{%s}{%d}\n"
+ dates label start))
+ (message "Ignoring entry with type %s\n" type)))))
+ (message "Ignoring non-list entry %s\n" entry)) ; end if list entry
+ (setq entries (cdr entries)))) ; end while entries left
+ (format "\\pgfdeclarelayer{background}
+ \\pgfdeclarelayer{foreground}
+ \\pgfsetlayers{background,foreground}
+ \\renewcommand{\\ganttprojecttime}{%d}
+ \\renewcommand{\\ganttntasks}{%d}
+ \\noindent
+ \\begin{tikzpicture}[y=-0.75cm,x=0.75\\textwidth]
+ \\begin{pgfonlayer}{background}
+ \\draw[very thin, red!10!white] (0,1+\\ganttntasks) grid [ystep=0.75cm,xstep=1/\\ganttprojecttime] (1,0);
+ \\draw[\\ganttdatelinecolour] (0,0) -- (1,0);
+ \\draw[\\ganttdatelinecolour] (0,1+\\ganttntasks) -- (1,1+\\ganttntasks);
+ \\end{pgfonlayer}
+ %s
+ %s
+ %s
+ \\end{tikzpicture}" projecttime ntasks tasks milestones dates))
+#+end_src
+
+* Available languages
+ :PROPERTIES:
+ :AUTHOR: Bastien
+ :END:
+
+** From Org's core
+
+| Language | Identifier | Language | Identifier |
+|------------+------------+----------------+------------|
+| Asymptote | asymptote | Awk | awk |
+| Emacs Calc | calc | C | C |
+| C++ | C++ | Clojure | clojure |
+| CSS | css | ditaa | ditaa |
+| Graphviz | dot | Emacs Lisp | emacs-lisp |
+| gnuplot | gnuplot | Haskell | haskell |
+| Javascript | js | LaTeX | latex |
+| Ledger | ledger | Lisp | lisp |
+| Lilypond | lilypond | MATLAB | matlab |
+| Mscgen | mscgen | Objective Caml | ocaml |
+| Octave | octave | Org-mode | org |
+| | | Perl | perl |
+| Plantuml | plantuml | Python | python |
+| R | R | Ruby | ruby |
+| Sass | sass | Scheme | scheme |
+| GNU Screen | screen | shell | sh |
+| SQL | sql | SQLite | sqlite |
+
+** From Org's contrib/babel/langs
+
+- ob-oz.el, by Torsten Anders and Eric Schulte
+- ob-fomus.el, by Torsten Anders
diff --git a/contrib/lisp/htmlize.el b/contrib/lisp/htmlize.el
new file mode 100644
index 0000000..516fb1d
--- /dev/null
+++ b/contrib/lisp/htmlize.el
@@ -0,0 +1,1769 @@
+;; htmlize.el -- Convert buffer text and decorations to HTML.
+
+;; Copyright (C) 1997-2012 Hrvoje Niksic
+
+;; Author: Hrvoje Niksic <hniksic@xemacs.org>
+;; Keywords: hypermedia, 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 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package converts the buffer text and the associated
+;; decorations to HTML. Mail to <hniksic@xemacs.org> to discuss
+;; features and additions. All suggestions are more than welcome.
+
+;; To use this, just switch to the buffer you want HTML-ized and type
+;; `M-x htmlize-buffer'. You will be switched to a new buffer that
+;; contains the resulting HTML code. You can edit and inspect this
+;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file'
+;; will find a file, fontify it, and save the HTML version in
+;; FILE.html, without any additional intervention. `M-x
+;; htmlize-many-files' allows you to htmlize any number of files in
+;; the same manner. `M-x htmlize-many-files-dired' does the same for
+;; files marked in a dired buffer.
+
+;; htmlize supports three types of HTML output, selected by setting
+;; `htmlize-output-type': `css', `inline-css', and `font'. In `css'
+;; mode, htmlize uses cascading style sheets to specify colors; it
+;; generates classes that correspond to Emacs faces and uses <span
+;; class=FACE>...</span> to color parts of text. In this mode, the
+;; produced HTML is valid under the 4.01 strict DTD, as confirmed by
+;; the W3C validator. `inline-css' is like `css', except the CSS is
+;; put directly in the STYLE attribute of the SPAN element, making it
+;; possible to paste the generated HTML to other documents. In `font'
+;; mode, htmlize uses <font color="...">...</font> to colorize HTML,
+;; which is not standard-compliant, but works better in older
+;; browsers. `css' mode is the default.
+
+;; You can also use htmlize from your Emacs Lisp code. When called
+;; non-interactively, `htmlize-buffer' and `htmlize-region' will
+;; return the resulting HTML buffer, but will not change current
+;; buffer or move the point.
+
+;; I tried to make the package elisp-compatible with multiple Emacsen,
+;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please
+;; let me know if it doesn't work on some of those, and I'll try to
+;; fix it. I relied heavily on the presence of CL extensions,
+;; especially for cross-emacs compatibility; please don't try to
+;; remove that particular dependency. When byte-compiling under GNU
+;; Emacs, you're likely to get some warnings; just ignore them.
+
+;; The latest version should be available at:
+;;
+;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el>
+;;
+;; You can find a sample of htmlize's output (possibly generated with
+;; an older version) at:
+;;
+;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html>
+
+;; Thanks go to the multitudes of people who have sent reports and
+;; contributed comments, suggestions, and fixes. They include Ron
+;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri
+;; Linkov, Maciek Pasternacki, and many others.
+
+;; User quotes: "You sir, are a sick, sick, _sick_ person. :)"
+;; -- Bill Perry, author of Emacs/W3
+
+
+;;; Code:
+
+(require 'cl)
+(eval-when-compile
+ (if (string-match "XEmacs" emacs-version)
+ (byte-compiler-options
+ (warnings (- unresolved))))
+ (defvar font-lock-auto-fontify)
+ (defvar font-lock-support-mode)
+ (defvar global-font-lock-mode)
+ (when (and (eq emacs-major-version 19)
+ (not (string-match "XEmacs" emacs-version)))
+ ;; Older versions of GNU Emacs fail to autoload cl-extra even when
+ ;; `cl' is loaded.
+ (load "cl-extra")))
+
+(defconst htmlize-version "1.36")
+
+;; Incantations to make custom stuff work without customize, e.g. on
+;; XEmacs 19.14 or GNU Emacs 19.34.
+(eval-and-compile
+ (condition-case ()
+ (require 'custom)
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ; we've got what we needed
+ ;; No custom or obsolete custom, define surrogates. Define all
+ ;; three macros, so we don't hose another library that expects
+ ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds.
+ (defmacro defgroup (&rest ignored) nil)
+ (defmacro defcustom (var value doc &rest ignored)
+ `(defvar ,var ,value ,doc))
+ (defmacro defface (face value doc &rest stuff)
+ `(make-face ,face))))
+
+(defgroup htmlize nil
+ "Convert buffer text and faces to HTML."
+ :group 'hypermedia)
+
+(defcustom htmlize-head-tags ""
+ "*Additional tags to insert within HEAD of the generated document."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-output-type 'css
+ "*Output type of generated HTML, one of `css', `inline-css', or `font'.
+When set to `css' (the default), htmlize will generate a style sheet
+with description of faces, and use it in the HTML document, specifying
+the faces in the actual text with <span class=\"FACE\">.
+
+When set to `inline-css', the style will be generated as above, but
+placed directly in the STYLE attribute of the span ELEMENT: <span
+style=\"STYLE\">. This makes it easier to paste the resulting HTML to
+other documents.
+
+When set to `font', the properties will be set using layout tags
+<font>, <b>, <i>, <u>, and <strike>.
+
+`css' output is normally preferred, but `font' is still useful for
+supporting old, pre-CSS browsers, and both `inline-css' and `font' for
+easier embedding of colorized text in foreign HTML documents (no style
+sheet to carry around)."
+ :type '(choice (const css) (const inline-css) (const font))
+ :group 'htmlize)
+
+(defcustom htmlize-generate-hyperlinks t
+ "*Non-nil means generate the hyperlinks for URLs and mail addresses.
+This is on by default; set it to nil if you don't want htmlize to
+insert hyperlinks in the resulting HTML. (In which case you can still
+do your own hyperlinkification from htmlize-after-hook.)"
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-hyperlink-style "
+ a {
+ color: inherit;
+ background-color: inherit;
+ font: inherit;
+ text-decoration: inherit;
+ }
+ a:hover {
+ text-decoration: underline;
+ }
+"
+ "*The CSS style used for hyperlinks when in CSS mode."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-replace-form-feeds t
+ "*Non-nil means replace form feeds in source code with HTML separators.
+Form feeds are the ^L characters at line beginnings that are sometimes
+used to separate sections of source code. If this variable is set to
+`t', form feed characters are replaced with the <hr> separator. If this
+is a string, it specifies the replacement to use. Note that <pre> is
+temporarily closed before the separator is inserted, so the default
+replacement is effectively \"</pre><hr /><pre>\". If you specify
+another replacement, don't forget to close and reopen the <pre> if you
+want the output to remain valid HTML.
+
+If you need more elaborate processing, set this to nil and use
+htmlize-after-hook."
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-html-charset nil
+ "*The charset declared by the resulting HTML documents.
+When non-nil, causes htmlize to insert the following in the HEAD section
+of the generated HTML:
+
+ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=CHARSET\">
+
+where CHARSET is the value you've set for htmlize-html-charset. Valid
+charsets are defined by MIME and include strings like \"iso-8859-1\",
+\"iso-8859-15\", \"utf-8\", etc.
+
+If you are using non-Latin-1 charsets, you might need to set this for
+your documents to render correctly. Also, the W3C validator requires
+submitted HTML documents to declare a charset. So if you care about
+validation, you can use this to prevent the validator from bitching.
+
+Needless to say, if you set this, you should actually make sure that
+the buffer is in the encoding you're claiming it is in. (Under Mule
+that is done by ensuring the correct \"file coding system\" for the
+buffer.) If you don't understand what that means, this option is
+probably not for you."
+ :type '(choice (const :tag "Unset" nil)
+ string)
+ :group 'htmlize)
+
+(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule)
+ "*Whether non-ASCII characters should be converted to HTML entities.
+
+When this is non-nil, characters with codes in the 128-255 range will be
+considered Latin 1 and rewritten as \"&#CODE;\". Characters with codes
+above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
+code point of the character. If the code point cannot be determined,
+the character will be copied unchanged, as would be the case if the
+option were nil.
+
+When the option is nil, the non-ASCII characters are copied to HTML
+without modification. In that case, the web server and/or the browser
+must be set to understand the encoding that was used when saving the
+buffer. (You might also want to specify it by setting
+`htmlize-html-charset'.)
+
+Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
+which has nothing to do with the charset the page is in. For example,
+\"&#169;\" *always* refers to the copyright symbol, regardless of charset
+specified by the META tag or the charset sent by the HTTP server. In
+other words, \"&#169;\" is exactly equivalent to \"&copy;\".
+
+By default, entity conversion is turned on for Mule-enabled Emacsen and
+turned off otherwise. This is because Mule knows the charset of
+non-ASCII characters in the buffer. A non-Mule Emacs cannot tell
+whether a character with code 0xA9 represents Latin 1 copyright symbol,
+Latin 2 \"S with caron\", or something else altogether. Setting this to
+t without Mule means asserting that 128-255 characters always mean Latin
+1.
+
+For most people htmlize will work fine with this option left at the
+default setting; don't change it unless you know what you're doing."
+ :type 'sexp
+ :group 'htmlize)
+
+(defcustom htmlize-ignore-face-size 'absolute
+ "*Whether face size should be ignored when generating HTML.
+If this is nil, face sizes are used. If set to t, sizes are ignored
+If set to `absolute', only absolute size specifications are ignored.
+Please note that font sizes only work with CSS-based output types."
+ :type '(choice (const :tag "Don't ignore" nil)
+ (const :tag "Ignore all" t)
+ (const :tag "Ignore absolute" absolute))
+ :group 'htmlize)
+
+(defcustom htmlize-css-name-prefix ""
+ "*The prefix used for CSS names.
+The CSS names that htmlize generates from face names are often too
+generic for CSS files; for example, `font-lock-type-face' is transformed
+to `type'. Use this variable to add a prefix to the generated names.
+The string \"htmlize-\" is an example of a reasonable prefix."
+ :type 'string
+ :group 'htmlize)
+
+(defcustom htmlize-use-rgb-txt t
+ "*Whether `rgb.txt' should be used to convert color names to RGB.
+
+This conversion means determining, for instance, that the color
+\"IndianRed\" corresponds to the (205, 92, 92) RGB triple. `rgb.txt'
+is the X color database that maps hundreds of color names to such RGB
+triples. When this variable is non-nil, `htmlize' uses `rgb.txt' to
+look up color names.
+
+If this variable is nil, htmlize queries Emacs for RGB components of
+colors using `color-instance-rgb-components' and `x-color-values'.
+This can yield incorrect results on non-true-color displays.
+
+If the `rgb.txt' file is not found (which will be the case if you're
+running Emacs on non-X11 systems), this option is ignored."
+ :type 'boolean
+ :group 'htmlize)
+
+(defcustom htmlize-html-major-mode nil
+ "The mode the newly created HTML buffer will be put in.
+Set this to nil if you prefer the default (fundamental) mode."
+ :type '(radio (const :tag "No mode (fundamental)" nil)
+ (function-item html-mode)
+ (function :tag "User-defined major mode"))
+ :group 'htmlize)
+
+(defvar htmlize-before-hook nil
+ "Hook run before htmlizing a buffer.
+The hook functions are run in the source buffer (not the resulting HTML
+buffer).")
+
+(defvar htmlize-after-hook nil
+ "Hook run after htmlizing a buffer.
+Unlike `htmlize-before-hook', these functions are run in the generated
+HTML buffer. You may use them to modify the outlook of the final HTML
+output.")
+
+(defvar htmlize-file-hook nil
+ "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
+
+(defvar htmlize-buffer-places)
+
+;;; Some cross-Emacs compatibility.
+
+;; I try to conditionalize on features rather than Emacs version, but
+;; in some cases checking against the version *is* necessary.
+(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))
+
+(eval-and-compile
+ ;; save-current-buffer, with-current-buffer, and with-temp-buffer
+ ;; are not available in 19.34 and in older XEmacsen. Strictly
+ ;; speaking, we should stick to our own namespace and define and use
+ ;; htmlize-save-current-buffer, etc. But non-standard special forms
+ ;; are a pain because they're not properly fontified or indented and
+ ;; because they look weird and ugly. So I'll just go ahead and
+ ;; define the real ones if they're not available. If someone
+ ;; convinces me that this breaks something, I'll switch to the
+ ;; "htmlize-" namespace.
+ (unless (fboundp 'save-current-buffer)
+ (defmacro save-current-buffer (&rest forms)
+ `(let ((__scb_current (current-buffer)))
+ (unwind-protect
+ (progn ,@forms)
+ (set-buffer __scb_current)))))
+ (unless (fboundp 'with-current-buffer)
+ (defmacro with-current-buffer (buffer &rest forms)
+ `(save-current-buffer (set-buffer ,buffer) ,@forms)))
+ (unless (fboundp 'with-temp-buffer)
+ (defmacro with-temp-buffer (&rest forms)
+ (let ((temp-buffer (gensym "tb-")))
+ `(let ((,temp-buffer
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (unwind-protect
+ (with-current-buffer ,temp-buffer
+ ,@forms)
+ (and (buffer-live-p ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))))
+
+;; We need a function that efficiently finds the next change of a
+;; property (usually `face'), preferably regardless of whether the
+;; change occurred because of a text property or an extent/overlay.
+;; As it turns out, it is not easy to do that compatibly.
+;;
+;; Under XEmacs, `next-single-property-change' does that. Under GNU
+;; Emacs beginning with version 21, `next-single-char-property-change'
+;; is available and does the same. GNU Emacs 20 had
+;; `next-char-property-change', which we can use. GNU Emacs 19 didn't
+;; provide any means for simultaneously examining overlays and text
+;; properties, so when using Emacs 19.34, we punt and fall back to
+;; `next-single-property-change', thus ignoring overlays altogether.
+
+(cond
+ (htmlize-running-xemacs
+ ;; XEmacs: good.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (next-single-property-change pos prop nil (or limit (point-max)))))
+ ((fboundp 'next-single-char-property-change)
+ ;; GNU Emacs 21: good.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (next-single-char-property-change pos prop nil limit)))
+ ((fboundp 'next-char-property-change)
+ ;; GNU Emacs 20: bad, but fixable.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (let ((done nil)
+ (current-value (get-char-property pos prop))
+ newpos next-value)
+ ;; Loop over positions returned by next-char-property-change
+ ;; until the value of PROP changes or we've hit EOB.
+ (while (not done)
+ (setq newpos (next-char-property-change pos limit)
+ next-value (get-char-property newpos prop))
+ (cond ((eq newpos pos)
+ ;; Possibly at EOB? Whatever, just don't infloop.
+ (setq done t))
+ ((eq next-value current-value)
+ ;; PROP hasn't changed -- keep looping.
+ )
+ (t
+ (setq done t)))
+ (setq pos newpos))
+ pos)))
+ (t
+ ;; GNU Emacs 19.34: hopeless, cannot properly support overlays.
+ (defun htmlize-next-change (pos prop &optional limit)
+ (unless limit
+ (setq limit (point-max)))
+ (let ((res (next-single-property-change pos prop)))
+ (if (or (null res)
+ (> res limit))
+ limit
+ res)))))
+
+;;; Transformation of buffer text: HTML escapes, untabification, etc.
+
+(defvar htmlize-basic-character-table
+ ;; Map characters in the 0-127 range to either one-character strings
+ ;; or to numeric entities.
+ (let ((table (make-vector 128 ?\0)))
+ ;; Map characters in the 32-126 range to themselves, others to
+ ;; &#CODE entities;
+ (dotimes (i 128)
+ (setf (aref table i) (if (and (>= i 32) (<= i 126))
+ (char-to-string i)
+ (format "&#%d;" i))))
+ ;; Set exceptions manually.
+ (setf
+ ;; Don't escape newline, carriage return, and TAB.
+ (aref table ?\n) "\n"
+ (aref table ?\r) "\r"
+ (aref table ?\t) "\t"
+ ;; Escape &, <, and >.
+ (aref table ?&) "&amp;"
+ (aref table ?<) "&lt;"
+ (aref table ?>) "&gt;"
+ ;; Not escaping '"' buys us a measurable speedup. It's only
+ ;; necessary to quote it for strings used in attribute values,
+ ;; which htmlize doesn't do.
+ ;(aref table ?\") "&quot;"
+ )
+ table))
+
+;; A cache of HTML representation of non-ASCII characters. Depending
+;; on availability of `encode-char' and the setting of
+;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII
+;; characters to either "&#<code>;" or "<char>" (mapconcat's mapper
+;; must always return strings). It's only filled as characters are
+;; encountered, so that in a buffer with e.g. French text, it will
+;; only ever contain French accented characters as keys. It's cleared
+;; on each entry to htmlize-buffer-1 to allow modifications of
+;; `htmlize-convert-nonascii-to-entities' to take effect.
+(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))
+
+(defun htmlize-protect-string (string)
+ "HTML-protect string, escaping HTML metacharacters and I18N chars."
+ ;; Only protecting strings that actually contain unsafe or non-ASCII
+ ;; chars removes a lot of unnecessary funcalls and consing.
+ (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
+ string
+ (mapconcat (lambda (char)
+ (cond
+ ((< char 128)
+ ;; ASCII: use htmlize-basic-character-table.
+ (aref htmlize-basic-character-table char))
+ ((gethash char htmlize-extended-character-cache)
+ ;; We've already seen this char; return the cached
+ ;; string.
+ )
+ ((not htmlize-convert-nonascii-to-entities)
+ ;; If conversion to entities is not desired, always
+ ;; copy the char literally.
+ (setf (gethash char htmlize-extended-character-cache)
+ (char-to-string char)))
+ ((< char 256)
+ ;; Latin 1: no need to call encode-char.
+ (setf (gethash char htmlize-extended-character-cache)
+ (format "&#%d;" char)))
+ ((and (fboundp 'encode-char)
+ ;; Must check if encode-char works for CHAR;
+ ;; it fails for Arabic and possibly elsewhere.
+ (encode-char char 'ucs))
+ (setf (gethash char htmlize-extended-character-cache)
+ (format "&#%d;" (encode-char char 'ucs))))
+ (t
+ ;; encode-char doesn't work for this char. Copy it
+ ;; unchanged and hope for the best.
+ (setf (gethash char htmlize-extended-character-cache)
+ (char-to-string char)))))
+ string "")))
+
+(defconst htmlize-ellipsis "...")
+(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
+
+(defun htmlize-buffer-substring-no-invisible (beg end)
+ ;; Like buffer-substring-no-properties, but don't copy invisible
+ ;; parts of the region. Where buffer-substring-no-properties
+ ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
+ (let ((pos beg)
+ visible-list invisible show next-change)
+ ;; Iterate over the changes in the `invisible' property and filter
+ ;; out the portions where it's non-nil, i.e. where the text is
+ ;; invisible.
+ (while (< pos end)
+ (setq invisible (get-char-property pos 'invisible)
+ next-change (htmlize-next-change pos 'invisible end))
+ (if (not (listp buffer-invisibility-spec))
+ ;; If buffer-invisibility-spec is not a list, then all
+ ;; characters with non-nil `invisible' property are visible.
+ (setq show (not invisible))
+ ;; Otherwise, the value of a non-nil `invisible' property can be:
+ ;; 1. a symbol -- make the text invisible if it matches
+ ;; buffer-invisibility-spec.
+ ;; 2. a list of symbols -- make the text invisible if
+ ;; any symbol in the list matches
+ ;; buffer-invisibility-spec.
+ ;; If the match of buffer-invisibility-spec has a non-nil
+ ;; CDR, replace the invisible text with an ellipsis.
+ (let (match)
+ (if (symbolp invisible)
+ (setq match (member* invisible buffer-invisibility-spec
+ :key (lambda (i)
+ (if (symbolp i) i (car i)))))
+ (setq match (block nil
+ (dolist (elem invisible)
+ (let ((m (member*
+ elem buffer-invisibility-spec
+ :key (lambda (i)
+ (if (symbolp i) i (car i))))))
+ (when m (return m))))
+ nil)))
+ (setq show (cond ((null match) t)
+ ((and (cdr-safe (car match))
+ ;; Conflate successive ellipses.
+ (not (eq show htmlize-ellipsis)))
+ htmlize-ellipsis)
+ (t nil)))))
+ (cond ((eq show t)
+ (push (buffer-substring-no-properties pos next-change) visible-list))
+ ((stringp show)
+ (push show visible-list)))
+ (setq pos next-change))
+ (if (= (length visible-list) 1)
+ ;; If VISIBLE-LIST consists of only one element, return it
+ ;; without concatenation. This avoids additional consing in
+ ;; regions without any invisible text.
+ (car visible-list)
+ (apply #'concat (nreverse visible-list)))))
+
+(defun htmlize-trim-ellipsis (text)
+ ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
+ ;; starts with it. It checks for the special property of the
+ ;; ellipsis so it doesn't work on ordinary text that begins with
+ ;; "...".
+ (if (get-text-property 0 'htmlize-ellipsis text)
+ (substring text (length htmlize-ellipsis))
+ text))
+
+(defconst htmlize-tab-spaces
+ ;; A table of strings with spaces. (aref htmlize-tab-spaces 5) is
+ ;; like (make-string 5 ?\ ), except it doesn't cons.
+ (let ((v (make-vector 32 nil)))
+ (dotimes (i (length v))
+ (setf (aref v i) (make-string i ?\ )))
+ v))
+
+(defun htmlize-untabify (text start-column)
+ "Untabify TEXT, assuming it starts at START-COLUMN."
+ (let ((column start-column)
+ (last-match 0)
+ (chunk-start 0)
+ chunks match-pos tab-size)
+ (while (string-match "[\t\n]" text last-match)
+ (setq match-pos (match-beginning 0))
+ (cond ((eq (aref text match-pos) ?\t)
+ ;; Encountered a tab: create a chunk of text followed by
+ ;; the expanded tab.
+ (push (substring text chunk-start match-pos) chunks)
+ ;; Increase COLUMN by the length of the text we've
+ ;; skipped since last tab or newline. (Encountering
+ ;; newline resets it.)
+ (incf column (- match-pos last-match))
+ ;; Calculate tab size based on tab-width and COLUMN.
+ (setq tab-size (- tab-width (% column tab-width)))
+ ;; Expand the tab.
+ (push (aref htmlize-tab-spaces tab-size) chunks)
+ (incf column tab-size)
+ (setq chunk-start (1+ match-pos)))
+ (t
+ ;; Reset COLUMN at beginning of line.
+ (setq column 0)))
+ (setq last-match (1+ match-pos)))
+ ;; If no chunks have been allocated, it means there have been no
+ ;; tabs to expand. Return TEXT unmodified.
+ (if (null chunks)
+ text
+ (when (< chunk-start (length text))
+ ;; Push the remaining chunk.
+ (push (substring text chunk-start) chunks))
+ ;; Generate the output from the available chunks.
+ (apply #'concat (nreverse chunks)))))
+
+(defun htmlize-despam-address (string)
+ "Replace every occurrence of '@' in STRING with &#64;.
+`htmlize-make-hyperlinks' uses this to spam-protect mailto links
+without modifying their meaning."
+ ;; Suggested by Ville Skytta.
+ (while (string-match "@" string)
+ (setq string (replace-match "&#64;" nil t string)))
+ string)
+
+(defun htmlize-make-hyperlinks ()
+ "Make hyperlinks in HTML."
+ ;; Function originally submitted by Ville Skytta. Rewritten by
+ ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "&lt;\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)&gt;"
+ nil t)
+ (let ((address (match-string 3))
+ (link-text (match-string 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert "&lt;<a href=\"mailto:"
+ (htmlize-despam-address address)
+ "\">"
+ (htmlize-despam-address link-text)
+ "</a>&gt;")))
+ (goto-char (point-min))
+ (while (re-search-forward "&lt;\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)&gt;"
+ nil t)
+ (let ((url (match-string 3))
+ (link-text (match-string 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert "&lt;<a href=\"" url "\">" link-text "</a>&gt;"))))
+
+;; Tests for htmlize-make-hyperlinks:
+
+;; <mailto:hniksic@xemacs.org>
+;; <http://fly.srk.fer.hr>
+;; <URL:http://www.xemacs.org>
+;; <http://www.mail-archive.com/bbdb-info@xemacs.org/>
+;; <hniksic@xemacs.org>
+;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org>
+
+(defun htmlize-defang-local-variables ()
+ ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
+ ;; visiting the HTML to fail with "Local variables list is not
+ ;; properly terminated". He suggested changing the phrase to
+ ;; syntactically equivalent HTML that Emacs doesn't recognize.
+ (goto-char (point-min))
+ (while (search-forward "Local Variables:" nil t)
+ (replace-match "Local Variables&#58;" nil t)))
+
+
+;;; Color handling.
+
+(if (fboundp 'locate-file)
+ (defalias 'htmlize-locate-file 'locate-file)
+ (defun htmlize-locate-file (file path)
+ (dolist (dir path nil)
+ (when (file-exists-p (expand-file-name file dir))
+ (return (expand-file-name file dir))))))
+
+(defvar htmlize-x-library-search-path
+ '("/usr/X11R6/lib/X11/"
+ "/usr/X11R5/lib/X11/"
+ "/usr/lib/X11R6/X11/"
+ "/usr/lib/X11R5/X11/"
+ "/usr/local/X11R6/lib/X11/"
+ "/usr/local/X11R5/lib/X11/"
+ "/usr/local/lib/X11R6/X11/"
+ "/usr/local/lib/X11R5/X11/"
+ "/usr/X11/lib/X11/"
+ "/usr/lib/X11/"
+ "/usr/local/lib/X11/"
+ "/usr/X386/lib/X11/"
+ "/usr/x386/lib/X11/"
+ "/usr/XFree86/lib/X11/"
+ "/usr/unsupported/lib/X11/"
+ "/usr/athena/lib/X11/"
+ "/usr/local/x11r5/lib/X11/"
+ "/usr/lpp/Xamples/lib/X11/"
+ "/usr/openwin/lib/X11/"
+ "/usr/openwin/share/lib/X11/"))
+
+(defun htmlize-get-color-rgb-hash (&optional rgb-file)
+ "Return a hash table mapping X color names to RGB values.
+The keys in the hash table are X11 color names, and the values are the
+#rrggbb RGB specifications, extracted from `rgb.txt'.
+
+If RGB-FILE is nil, the function will try hard to find a suitable file
+in the system directories.
+
+If no rgb.txt file is found, return nil."
+ (let ((rgb-file (or rgb-file (htmlize-locate-file
+ "rgb.txt"
+ htmlize-x-library-search-path)))
+ (hash nil))
+ (when rgb-file
+ (with-temp-buffer
+ (insert-file-contents rgb-file)
+ (setq hash (make-hash-table :test 'equal))
+ (while (not (eobp))
+ (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
+ ;; Skip comments and empty lines.
+ )
+ ((looking-at
+ "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
+ (setf (gethash (downcase (match-string 4)) hash)
+ (format "#%02x%02x%02x"
+ (string-to-number (match-string 1))
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 3)))))
+ (t
+ (error
+ "Unrecognized line in %s: %s"
+ rgb-file
+ (buffer-substring (point) (progn (end-of-line) (point))))))
+ (forward-line 1))))
+ hash))
+
+;; Compile the RGB map when loaded. On systems where rgb.txt is
+;; missing, the value of the variable will be nil, and rgb.txt will
+;; not be used.
+(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))
+
+;;; Face handling.
+
+(defun htmlize-face-specifies-property (face prop)
+ ;; Return t if face specifies PROP, as opposed to it being inherited
+ ;; from the default face. The problem with e.g.
+ ;; `face-foreground-instance' is that it returns an instance for
+ ;; EVERY face because every face inherits from the default face.
+ ;; However, we'd like htmlize-face-{fore,back}ground to return nil
+ ;; when called with a face that doesn't specify its own foreground
+ ;; or background.
+ (or (eq face 'default)
+ (assq 'global (specifier-spec-list (face-property face prop)))))
+
+(defun htmlize-face-color-internal (face fg)
+ ;; Used only under GNU Emacs. Return the color of FACE, but don't
+ ;; return "unspecified-fg" or "unspecified-bg". If the face is
+ ;; `default' and the color is unspecified, look up the color in
+ ;; frame parameters.
+ (let* ((function (if fg #'face-foreground #'face-background))
+ color)
+ (if (>= emacs-major-version 22)
+ ;; For GNU Emacs 22+ set INHERIT to get the inherited values.
+ (setq color (funcall function face nil t))
+ (setq color (funcall function face))
+ ;; For GNU Emacs 21 (which has `face-attribute'): if the color
+ ;; is nil, recursively check for the face's parent.
+ (when (and (null color)
+ (fboundp 'face-attribute)
+ (face-attribute face :inherit)
+ (not (eq (face-attribute face :inherit) 'unspecified)))
+ (setq color (htmlize-face-color-internal
+ (face-attribute face :inherit) fg))))
+ (when (and (eq face 'default) (null color))
+ (setq color (cdr (assq (if fg 'foreground-color 'background-color)
+ (frame-parameters)))))
+ (when (or (eq color 'unspecified)
+ (equal color "unspecified-fg")
+ (equal color "unspecified-bg"))
+ (setq color nil))
+ (when (and (eq face 'default)
+ (null color))
+ ;; Assuming black on white doesn't seem right, but I can't think
+ ;; of anything better to do.
+ (setq color (if fg "black" "white")))
+ color))
+
+(defun htmlize-face-foreground (face)
+ ;; Return the name of the foreground color of FACE. If FACE does
+ ;; not specify a foreground color, return nil.
+ (cond (htmlize-running-xemacs
+ ;; XEmacs.
+ (and (htmlize-face-specifies-property face 'foreground)
+ (color-instance-name (face-foreground-instance face))))
+ (t
+ ;; GNU Emacs.
+ (htmlize-face-color-internal face t))))
+
+(defun htmlize-face-background (face)
+ ;; Return the name of the background color of FACE. If FACE does
+ ;; not specify a background color, return nil.
+ (cond (htmlize-running-xemacs
+ ;; XEmacs.
+ (and (htmlize-face-specifies-property face 'background)
+ (color-instance-name (face-background-instance face))))
+ (t
+ ;; GNU Emacs.
+ (htmlize-face-color-internal face nil))))
+
+;; Convert COLOR to the #RRGGBB string. If COLOR is already in that
+;; format, it's left unchanged.
+
+(defun htmlize-color-to-rgb (color)
+ (let ((rgb-string nil))
+ (cond ((null color)
+ ;; Ignore nil COLOR because it means that the face is not
+ ;; specifying any color. Hence (htmlize-color-to-rgb nil)
+ ;; returns nil.
+ )
+ ((string-match "\\`#" color)
+ ;; The color is already in #rrggbb format.
+ (setq rgb-string color))
+ ((and htmlize-use-rgb-txt
+ htmlize-color-rgb-hash)
+ ;; Use of rgb.txt is requested, and it's available on the
+ ;; system. Use it.
+ (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
+ (t
+ ;; We're getting the RGB components from Emacs.
+ (let ((rgb
+ ;; Here I cannot conditionalize on (fboundp ...)
+ ;; because ps-print under some versions of GNU Emacs
+ ;; defines its own dummy version of
+ ;; `color-instance-rgb-components'.
+ (if htmlize-running-xemacs
+ (mapcar (lambda (arg)
+ (/ arg 256))
+ (color-instance-rgb-components
+ (make-color-instance color)))
+ (mapcar (lambda (arg)
+ (/ arg 256))
+ (x-color-values color)))))
+ (when rgb
+ (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
+ ;; If RGB-STRING is still nil, it means the color cannot be found,
+ ;; for whatever reason. In that case just punt and return COLOR.
+ ;; Most browsers support a decent set of color names anyway.
+ (or rgb-string color)))
+
+;; We store the face properties we care about into an
+;; `htmlize-fstruct' type. That way we only have to analyze face
+;; properties, which can be time consuming, once per each face. The
+;; mapping between Emacs faces and htmlize-fstructs is established by
+;; htmlize-make-face-map. The name "fstruct" refers to variables of
+;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
+;; faces.
+
+(defstruct htmlize-fstruct
+ foreground ; foreground color, #rrggbb
+ background ; background color, #rrggbb
+ size ; size
+ boldp ; whether face is bold
+ italicp ; whether face is italic
+ underlinep ; whether face is underlined
+ overlinep ; whether face is overlined
+ strikep ; whether face is struck through
+ css-name ; CSS name of face
+ )
+
+(defun htmlize-face-emacs21-attr (fstruct attr value)
+ ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
+ (case attr
+ (:foreground
+ (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
+ (:background
+ (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
+ (:height
+ (setf (htmlize-fstruct-size fstruct) value))
+ (:weight
+ (when (string-match (symbol-name value) "bold")
+ (setf (htmlize-fstruct-boldp fstruct) t)))
+ (:slant
+ (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
+ (eq value 'oblique))))
+ (:bold
+ (setf (htmlize-fstruct-boldp fstruct) value))
+ (:italic
+ (setf (htmlize-fstruct-italicp fstruct) value))
+ (:underline
+ (setf (htmlize-fstruct-underlinep fstruct) value))
+ (:overline
+ (setf (htmlize-fstruct-overlinep fstruct) value))
+ (:strike-through
+ (setf (htmlize-fstruct-strikep fstruct) value))))
+
+(defun htmlize-face-size (face)
+ ;; The size (height) of FACE, taking inheritance into account.
+ ;; Only works in Emacs 21 and later.
+ (let ((size-list
+ (loop
+ for f = face then (ignore-errors (face-attribute f :inherit)) ;?????
+ until (or (not f) (eq f 'unspecified))
+ for h = (ignore-errors (face-attribute f :height)) ;???????
+ collect (if (eq h 'unspecified) nil h))))
+ (reduce 'htmlize-merge-size (cons nil size-list))))
+
+(defun htmlize-face-to-fstruct (face)
+ "Convert Emacs face FACE to fstruct."
+ (let ((fstruct (make-htmlize-fstruct
+ :foreground (htmlize-color-to-rgb
+ (htmlize-face-foreground face))
+ :background (htmlize-color-to-rgb
+ (htmlize-face-background face)))))
+ (cond (htmlize-running-xemacs
+ ;; XEmacs doesn't provide a way to detect whether a face is
+ ;; bold or italic, so we need to examine the font instance.
+ ;; #### This probably doesn't work under MS Windows and/or
+ ;; GTK devices. I'll need help with those.
+ (let* ((font-instance (face-font-instance face))
+ (props (font-instance-properties font-instance)))
+ (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
+ (setf (htmlize-fstruct-boldp fstruct) t))
+ (when (or (equalp (cdr (assq 'SLANT props)) "i")
+ (equalp (cdr (assq 'SLANT props)) "o"))
+ (setf (htmlize-fstruct-italicp fstruct) t))
+ (setf (htmlize-fstruct-strikep fstruct)
+ (face-strikethru-p face))
+ (setf (htmlize-fstruct-underlinep fstruct)
+ (face-underline-p face))))
+ ((fboundp 'face-attribute)
+ ;; GNU Emacs 21 and further.
+ (dolist (attr '(:weight :slant :underline :overline :strike-through))
+ (let ((value (if (>= emacs-major-version 22)
+ ;; Use the INHERIT arg in GNU Emacs 22.
+ (face-attribute face attr nil t)
+ ;; Otherwise, fake it.
+ (let ((face face))
+ (while (and (eq (face-attribute face attr)
+ 'unspecified)
+ (not (eq (face-attribute face :inherit)
+ 'unspecified)))
+ (setq face (face-attribute face :inherit)))
+ (face-attribute face attr)))))
+ (when (and value (not (eq value 'unspecified)))
+ (htmlize-face-emacs21-attr fstruct attr value))))
+ (let ((size (htmlize-face-size face)))
+ (unless (eql size 1.0) ; ignore non-spec
+ (setf (htmlize-fstruct-size fstruct) size))))
+ (t
+ ;; Older GNU Emacs. Some of these functions are only
+ ;; available under Emacs 20+, hence the guards.
+ (when (fboundp 'face-bold-p)
+ (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face)))
+ (when (fboundp 'face-italic-p)
+ (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face)))
+ (setf (htmlize-fstruct-underlinep fstruct)
+ (face-underline-p face))))
+ ;; Generate the css-name property. Emacs places no restrictions
+ ;; on the names of symbols that represent faces -- any characters
+ ;; may be in the name, even ^@. We try hard to beat the face name
+ ;; into shape, both esthetically and according to CSS1 specs.
+ (setf (htmlize-fstruct-css-name fstruct)
+ (let ((name (downcase (symbol-name face))))
+ (when (string-match "\\`font-lock-" name)
+ ;; Change font-lock-FOO-face to FOO.
+ (setq name (replace-match "" t t name)))
+ (when (string-match "-face\\'" name)
+ ;; Drop the redundant "-face" suffix.
+ (setq name (replace-match "" t t name)))
+ (while (string-match "[^-a-zA-Z0-9]" name)
+ ;; Drop the non-alphanumerics.
+ (setq name (replace-match "X" t t name)))
+ (when (string-match "\\`[-0-9]" name)
+ ;; CSS identifiers may not start with a digit.
+ (setq name (concat "X" name)))
+ ;; After these transformations, the face could come
+ ;; out empty.
+ (when (equal name "")
+ (setq name "face"))
+ ;; Apply the prefix.
+ (setq name (concat htmlize-css-name-prefix name))
+ name))
+ fstruct))
+
+(defmacro htmlize-copy-attr-if-set (attr-list dest source)
+ ;; Expand the code of the type
+ ;; (and (htmlize-fstruct-ATTR source)
+ ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
+ ;; for the given list of boolean attributes.
+ (cons 'progn
+ (loop for attr in attr-list
+ for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
+ collect `(and (,attr-sym ,source)
+ (setf (,attr-sym ,dest) (,attr-sym ,source))))))
+
+(defun htmlize-merge-size (merged next)
+ ;; Calculate the size of the merge of MERGED and NEXT.
+ (cond ((null merged) next)
+ ((integerp next) next)
+ ((null next) merged)
+ ((floatp merged) (* merged next))
+ ((integerp merged) (round (* merged next)))))
+
+(defun htmlize-merge-two-faces (merged next)
+ (htmlize-copy-attr-if-set
+ (foreground background boldp italicp underlinep overlinep strikep)
+ merged next)
+ (setf (htmlize-fstruct-size merged)
+ (htmlize-merge-size (htmlize-fstruct-size merged)
+ (htmlize-fstruct-size next)))
+ merged)
+
+(defun htmlize-merge-faces (fstruct-list)
+ (cond ((null fstruct-list)
+ ;; Nothing to do, return a dummy face.
+ (make-htmlize-fstruct))
+ ((null (cdr fstruct-list))
+ ;; Optimize for the common case of a single face, simply
+ ;; return it.
+ (car fstruct-list))
+ (t
+ (reduce #'htmlize-merge-two-faces
+ (cons (make-htmlize-fstruct) fstruct-list)))))
+
+;; GNU Emacs 20+ supports attribute lists in `face' properties. For
+;; example, you can use `(:foreground "red" :weight bold)' as an
+;; overlay's "face", or you can even use a list of such lists, etc.
+;; We call those "attrlists".
+;;
+;; htmlize supports attrlist by converting them to fstructs, the same
+;; as with regular faces.
+
+(defun htmlize-attrlist-to-fstruct (attrlist)
+ ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
+ (let ((fstruct (make-htmlize-fstruct)))
+ (cond ((eq (car attrlist) 'foreground-color)
+ ;; ATTRLIST is (foreground-color . COLOR)
+ (setf (htmlize-fstruct-foreground fstruct)
+ (htmlize-color-to-rgb (cdr attrlist))))
+ ((eq (car attrlist) 'background-color)
+ ;; ATTRLIST is (background-color . COLOR)
+ (setf (htmlize-fstruct-background fstruct)
+ (htmlize-color-to-rgb (cdr attrlist))))
+ (t
+ ;; ATTRLIST is a plist.
+ (while attrlist
+ (let ((attr (pop attrlist))
+ (value (pop attrlist)))
+ (when (and value (not (eq value 'unspecified)))
+ (htmlize-face-emacs21-attr fstruct attr value))))))
+ (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
+ fstruct))
+
+(defun htmlize-face-list-p (face-prop)
+ "Return non-nil if FACE-PROP is a list of faces, nil otherwise."
+ ;; If not for attrlists, this would return (listp face-prop). This
+ ;; way we have to be more careful because attrlist is also a list!
+ (cond
+ ((eq face-prop nil)
+ ;; FACE-PROP being nil means empty list (no face), so return t.
+ t)
+ ((symbolp face-prop)
+ ;; A symbol other than nil means that it's only one face, so return
+ ;; nil.
+ nil)
+ ((not (consp face-prop))
+ ;; Huh? Not a symbol or cons -- treat it as a single element.
+ nil)
+ (t
+ ;; We know that FACE-PROP is a cons: check whether it looks like an
+ ;; ATTRLIST.
+ (let* ((car (car face-prop))
+ (attrlist-p (and (symbolp car)
+ (or (eq car 'foreground-color)
+ (eq car 'background-color)
+ (eq (aref (symbol-name car) 0) ?:)))))
+ ;; If FACE-PROP is not an ATTRLIST, it means it's a list of
+ ;; faces.
+ (not attrlist-p)))))
+
+(defun htmlize-make-face-map (faces)
+ ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
+ ;; The keys are either face symbols or attrlists, so the test
+ ;; function must be `equal'.
+ (let ((face-map (make-hash-table :test 'equal))
+ css-names)
+ (dolist (face faces)
+ (unless (gethash face face-map)
+ ;; Haven't seen FACE yet; convert it to an fstruct and cache
+ ;; it.
+ (let ((fstruct (if (symbolp face)
+ (htmlize-face-to-fstruct face)
+ (htmlize-attrlist-to-fstruct face))))
+ (setf (gethash face face-map) fstruct)
+ (let* ((css-name (htmlize-fstruct-css-name fstruct))
+ (new-name css-name)
+ (i 0))
+ ;; Uniquify the face's css-name by using NAME-1, NAME-2,
+ ;; etc.
+ (while (member new-name css-names)
+ (setq new-name (format "%s-%s" css-name (incf i))))
+ (unless (equal new-name css-name)
+ (setf (htmlize-fstruct-css-name fstruct) new-name))
+ (push new-name css-names)))))
+ face-map))
+
+(defun htmlize-unstringify-face (face)
+ "If FACE is a string, return it interned, otherwise return it unchanged."
+ (if (stringp face)
+ (intern face)
+ face))
+
+(defun htmlize-faces-in-buffer ()
+ "Return a list of faces used in the current buffer.
+Under XEmacs, this returns the set of faces specified by the extents
+with the `face' property. (This covers text properties as well.) Under
+GNU Emacs, it returns the set of faces specified by the `face' text
+property and by buffer overlays that specify `face'."
+ (let (faces)
+ ;; Testing for (fboundp 'map-extents) doesn't work because W3
+ ;; defines `map-extents' under FSF.
+ (if htmlize-running-xemacs
+ (let (face-prop)
+ (map-extents (lambda (extent ignored)
+ (setq face-prop (extent-face extent)
+ ;; FACE-PROP can be a face or a list of
+ ;; faces.
+ faces (if (listp face-prop)
+ (union face-prop faces)
+ (adjoin face-prop faces)))
+ nil)
+ nil
+ ;; Specify endpoints explicitly to respect
+ ;; narrowing.
+ (point-min) (point-max) nil nil 'face))
+ ;; FSF Emacs code.
+ ;; Faces used by text properties.
+ (let ((pos (point-min)) face-prop next)
+ (while (< pos (point-max))
+ (setq face-prop (get-text-property pos 'face)
+ next (or (next-single-property-change pos 'face) (point-max)))
+ ;; FACE-PROP can be a face/attrlist or a list thereof.
+ (setq faces (if (htmlize-face-list-p face-prop)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
+ (adjoin (htmlize-unstringify-face face-prop)
+ faces :test 'equal)))
+ (setq pos next)))
+ ;; Faces used by overlays.
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (let ((face-prop (overlay-get overlay 'face)))
+ ;; FACE-PROP can be a face/attrlist or a list thereof.
+ (setq faces (if (htmlize-face-list-p face-prop)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
+ (adjoin (htmlize-unstringify-face face-prop)
+ faces :test 'equal))))))
+ faces))
+
+;; htmlize-faces-at-point returns the faces in use at point. The
+;; faces are sorted by increasing priority, i.e. the last face takes
+;; precedence.
+;;
+;; Under XEmacs, this returns all the faces in all the extents at
+;; point. Under GNU Emacs, this returns all the faces in the `face'
+;; property and all the faces in the overlays at point.
+
+(cond (htmlize-running-xemacs
+ (defun htmlize-faces-at-point ()
+ (let (extent extent-list face-list face-prop)
+ (while (setq extent (extent-at (point) nil 'face extent))
+ (push extent extent-list))
+ ;; extent-list is in reverse display order, meaning that
+ ;; smallest ones come last. That is the order we want,
+ ;; except it can be overridden by the `priority' property.
+ (setq extent-list (stable-sort extent-list #'<
+ :key #'extent-priority))
+ (dolist (extent extent-list)
+ (setq face-prop (extent-face extent))
+ ;; extent's face-list is in reverse order from what we
+ ;; want, but the `nreverse' below will take care of it.
+ (setq face-list (if (listp face-prop)
+ (append face-prop face-list)
+ (cons face-prop face-list))))
+ (nreverse face-list))))
+ (t
+ (defun htmlize-faces-at-point ()
+ (let (all-faces)
+ ;; Faces from text properties.
+ (let ((face-prop (get-text-property (point) 'face)))
+ (setq all-faces (if (htmlize-face-list-p face-prop)
+ (nreverse (mapcar #'htmlize-unstringify-face
+ face-prop))
+ (list (htmlize-unstringify-face face-prop)))))
+ ;; Faces from overlays.
+ (let ((overlays
+ ;; Collect overlays at point that specify `face'.
+ (delete-if-not (lambda (o)
+ (overlay-get o 'face))
+ (overlays-at (point))))
+ list face-prop)
+ ;; Sort the overlays so the smaller (more specific) ones
+ ;; come later. The number of overlays at each one
+ ;; position should be very small, so the sort shouldn't
+ ;; slow things down.
+ (setq overlays (sort* overlays
+ ;; Sort by ascending...
+ #'<
+ ;; ...overlay size.
+ :key (lambda (o)
+ (- (overlay-end o)
+ (overlay-start o)))))
+ ;; Overlay priorities, if present, override the above
+ ;; established order. Larger overlay priority takes
+ ;; precedence and therefore comes later in the list.
+ (setq overlays (stable-sort
+ overlays
+ ;; Reorder (stably) by acending...
+ #'<
+ ;; ...overlay priority.
+ :key (lambda (o)
+ (or (overlay-get o 'priority) 0))))
+ (dolist (overlay overlays)
+ (setq face-prop (overlay-get overlay 'face))
+ (setq list (if (htmlize-face-list-p face-prop)
+ (nconc (nreverse (mapcar
+ #'htmlize-unstringify-face
+ face-prop))
+ list)
+ (cons (htmlize-unstringify-face face-prop) list))))
+ ;; Under "Merging Faces" the manual explicitly states
+ ;; that faces specified by overlays take precedence over
+ ;; faces specified by text properties.
+ (setq all-faces (nconc all-faces list)))
+ all-faces))))
+
+;; htmlize supports generating HTML in two several fundamentally
+;; different ways, one with the use of CSS and nested <span> tags, and
+;; the other with the use of the old <font> tags. Rather than adding
+;; a bunch of ifs to many places, we take a semi-OO approach.
+;; `htmlize-buffer-1' calls a number of "methods", which indirect to
+;; the functions that depend on `htmlize-output-type'. The currently
+;; used methods are `doctype', `insert-head', `body-tag', and
+;; `insert-text'. Not all output types define all methods.
+;;
+;; Methods are called either with (htmlize-method METHOD ARGS...)
+;; special form, or by accessing the function with
+;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
+;; The latter form is useful in tight loops because `htmlize-method'
+;; conses.
+;;
+;; Currently defined output types are `css' and `font'.
+
+(defmacro htmlize-method (method &rest args)
+ ;; Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of
+ ;; `htmlize-output-type' at run time.
+ `(funcall (htmlize-method-function ',method) ,@args))
+
+(defun htmlize-method-function (method)
+ ;; Return METHOD's function definition for the current output type.
+ ;; The returned object can be safely funcalled.
+ (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
+ (indirect-function (if (fboundp sym)
+ sym
+ (let ((default (intern (concat "htmlize-default-"
+ (symbol-name method)))))
+ (if (fboundp default)
+ default
+ 'ignore))))))
+
+(defvar htmlize-memoization-table (make-hash-table :test 'equal))
+
+(defmacro htmlize-memoize (key generator)
+ "Return the value of GENERATOR, memoized as KEY.
+That means that GENERATOR will be evaluated and returned the first time
+it's called with the same value of KEY. All other times, the cached
+\(memoized) value will be returned."
+ (let ((value (gensym)))
+ `(let ((,value (gethash ,key htmlize-memoization-table)))
+ (unless ,value
+ (setq ,value ,generator)
+ (setf (gethash ,key htmlize-memoization-table) ,value))
+ ,value)))
+
+;;; Default methods.
+
+(defun htmlize-default-doctype ()
+ nil ; no doc-string
+ ;; According to DTDs published by the W3C, it is illegal to embed
+ ;; <font> in <pre>. This makes sense in general, but is bad for
+ ;; htmlize's intended usage of <font> to specify the document color.
+
+ ;; To make generated HTML legal, htmlize's `font' mode used to
+ ;; specify the SGML declaration of "HTML Pro" DTD here. HTML Pro
+ ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
+ ;; DTD that would encompass all the incompatible HTML extensions
+ ;; procured by Netscape, MSIE, and other players in the field.
+ ;; Apparently the project got abandoned, the last available version
+ ;; being "Draft 0 Revision 11" from January 1997, as documented at
+ ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
+
+ ;; Since by now HTML Pro is remembered by none but the most die-hard
+ ;; early-web-days nostalgics and used by not even them, there is no
+ ;; use in specifying it. So we return the standard HTML 4.0
+ ;; declaration, which makes generated HTML technically illegal. If
+ ;; you have a problem with that, use the `css' engine designed to
+ ;; create fully conforming HTML.
+
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
+
+ ;; Now-abandoned HTML Pro declaration.
+ ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
+ )
+
+(defun htmlize-default-body-tag (face-map)
+ nil ; no doc-string
+ "<body>")
+
+;;; CSS based output support.
+
+;; Internal function; not a method.
+(defun htmlize-css-specs (fstruct)
+ (let (result)
+ (when (htmlize-fstruct-foreground fstruct)
+ (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
+ result))
+ (when (htmlize-fstruct-background fstruct)
+ (push (format "background-color: %s;"
+ (htmlize-fstruct-background fstruct))
+ result))
+ (let ((size (htmlize-fstruct-size fstruct)))
+ (when (and size (not (eq htmlize-ignore-face-size t)))
+ (cond ((floatp size)
+ (push (format "font-size: %d%%;" (* 100 size)) result))
+ ((not (eq htmlize-ignore-face-size 'absolute))
+ (push (format "font-size: %spt;" (/ size 10.0)) result)))))
+ (when (htmlize-fstruct-boldp fstruct)
+ (push "font-weight: bold;" result))
+ (when (htmlize-fstruct-italicp fstruct)
+ (push "font-style: italic;" result))
+ (when (htmlize-fstruct-underlinep fstruct)
+ (push "text-decoration: underline;" result))
+ (when (htmlize-fstruct-overlinep fstruct)
+ (push "text-decoration: overline;" result))
+ (when (htmlize-fstruct-strikep fstruct)
+ (push "text-decoration: line-through;" result))
+ (nreverse result)))
+
+(defun htmlize-css-insert-head (buffer-faces face-map)
+ (insert " <style type=\"text/css\">\n <!--\n")
+ (insert " body {\n "
+ (mapconcat #'identity
+ (htmlize-css-specs (gethash 'default face-map))
+ "\n ")
+ "\n }\n")
+ (dolist (face (sort* (copy-list buffer-faces) #'string-lessp
+ :key (lambda (f)
+ (htmlize-fstruct-css-name (gethash f face-map)))))
+ (let* ((fstruct (gethash face face-map))
+ (cleaned-up-face-name
+ (let ((s
+ ;; Use `prin1-to-string' rather than `symbol-name'
+ ;; to get the face name because the "face" can also
+ ;; be an attrlist, which is not a symbol.
+ (prin1-to-string face)))
+ ;; If the name contains `--' or `*/', remove them.
+ (while (string-match "--" s)
+ (setq s (replace-match "-" t t s)))
+ (while (string-match "\\*/" s)
+ (setq s (replace-match "XX" t t s)))
+ s))
+ (specs (htmlize-css-specs fstruct)))
+ (insert " ." (htmlize-fstruct-css-name fstruct))
+ (if (null specs)
+ (insert " {")
+ (insert " {\n /* " cleaned-up-face-name " */\n "
+ (mapconcat #'identity specs "\n ")))
+ (insert "\n }\n")))
+ (insert htmlize-hyperlink-style
+ " -->\n </style>\n"))
+
+(defun htmlize-css-insert-text (text fstruct-list buffer)
+ ;; Insert TEXT colored with FACES into BUFFER. In CSS mode, this is
+ ;; easy: just nest the text in one <span class=...> tag for each
+ ;; face in FSTRUCT-LIST.
+ (dolist (fstruct fstruct-list)
+ (princ "<span class=\"" buffer)
+ (princ (htmlize-fstruct-css-name fstruct) buffer)
+ (princ "\">" buffer))
+ (princ text buffer)
+ (dolist (fstruct fstruct-list)
+ (ignore fstruct) ; shut up the byte-compiler
+ (princ "</span>" buffer)))
+
+;; `inline-css' output support.
+
+(defun htmlize-inline-css-body-tag (face-map)
+ (format "<body style=\"%s\">"
+ (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
+ " ")))
+
+(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (style (htmlize-memoize
+ merged
+ (let ((specs (htmlize-css-specs merged)))
+ (and specs
+ (mapconcat #'identity (htmlize-css-specs merged) " "))))))
+ (when style
+ (princ "<span style=\"" buffer)
+ (princ style buffer)
+ (princ "\">" buffer))
+ (princ text buffer)
+ (when style
+ (princ "</span>" buffer))))
+
+;;; `font' tag based output support.
+
+(defun htmlize-font-body-tag (face-map)
+ (let ((fstruct (gethash 'default face-map)))
+ (format "<body text=\"%s\" bgcolor=\"%s\">"
+ (htmlize-fstruct-foreground fstruct)
+ (htmlize-fstruct-background fstruct))))
+
+(defun htmlize-font-insert-text (text fstruct-list buffer)
+ ;; In `font' mode, we use the traditional HTML means of altering
+ ;; presentation: <font> tag for colors, <b> for bold, <u> for
+ ;; underline, and <strike> for strike-through.
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (markup (htmlize-memoize
+ merged
+ (cons (concat
+ (and (htmlize-fstruct-foreground merged)
+ (format "<font color=\"%s\">" (htmlize-fstruct-foreground merged)))
+ (and (htmlize-fstruct-boldp merged) "<b>")
+ (and (htmlize-fstruct-italicp merged) "<i>")
+ (and (htmlize-fstruct-underlinep merged) "<u>")
+ (and (htmlize-fstruct-strikep merged) "<strike>"))
+ (concat
+ (and (htmlize-fstruct-strikep merged) "</strike>")
+ (and (htmlize-fstruct-underlinep merged) "</u>")
+ (and (htmlize-fstruct-italicp merged) "</i>")
+ (and (htmlize-fstruct-boldp merged) "</b>")
+ (and (htmlize-fstruct-foreground merged) "</font>"))))))
+ (princ (car markup) buffer)
+ (princ text buffer)
+ (princ (cdr markup) buffer)))
+
+(defun htmlize-buffer-1 ()
+ ;; Internal function; don't call it from outside this file. Htmlize
+ ;; current buffer, writing the resulting HTML to a new buffer, and
+ ;; return it. Unlike htmlize-buffer, this doesn't change current
+ ;; buffer or use switch-to-buffer.
+ (save-excursion
+ ;; Protect against the hook changing the current buffer.
+ (save-excursion
+ (run-hooks 'htmlize-before-hook))
+ ;; Convince font-lock support modes to fontify the entire buffer
+ ;; in advance.
+ (htmlize-ensure-fontified)
+ (clrhash htmlize-extended-character-cache)
+ (clrhash htmlize-memoization-table)
+ (let* ((buffer-faces (htmlize-faces-in-buffer))
+ (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
+ ;; Generate the new buffer. It's important that it inherits
+ ;; default-directory from the current buffer.
+ (htmlbuf (generate-new-buffer (if (buffer-file-name)
+ (htmlize-make-file-name
+ (file-name-nondirectory
+ (buffer-file-name)))
+ "*html*")))
+ ;; Having a dummy value in the plist allows writing simply
+ ;; (plist-put places foo bar).
+ (places '(nil nil))
+ (title (if (buffer-file-name)
+ (file-name-nondirectory (buffer-file-name))
+ (buffer-name))))
+ ;; Initialize HTMLBUF and insert the HTML prolog.
+ (with-current-buffer htmlbuf
+ (buffer-disable-undo)
+ (insert (htmlize-method doctype) ?\n
+ (format "<!-- Created by htmlize-%s in %s mode. -->\n"
+ htmlize-version htmlize-output-type)
+ "<html>\n ")
+ (plist-put places 'head-start (point-marker))
+ (insert "<head>\n"
+ " <title>" (htmlize-protect-string title) "</title>\n"
+ (if htmlize-html-charset
+ (format (concat " <meta http-equiv=\"Content-Type\" "
+ "content=\"text/html; charset=%s\">\n")
+ htmlize-html-charset)
+ "")
+ htmlize-head-tags)
+ (htmlize-method insert-head buffer-faces face-map)
+ (insert " </head>")
+ (plist-put places 'head-end (point-marker))
+ (insert "\n ")
+ (plist-put places 'body-start (point-marker))
+ (insert (htmlize-method body-tag face-map)
+ "\n ")
+ (plist-put places 'content-start (point-marker))
+ (insert "<pre>\n"))
+ (let ((insert-text-method
+ ;; Get the inserter method, so we can funcall it inside
+ ;; the loop. Not calling `htmlize-method' in the loop
+ ;; body yields a measurable speed increase.
+ (htmlize-method-function 'insert-text))
+ ;; Declare variables used in loop body outside the loop
+ ;; because it's faster to establish `let' bindings only
+ ;; once.
+ next-change text face-list fstruct-list trailing-ellipsis)
+ ;; This loop traverses and reads the source buffer, appending
+ ;; the resulting HTML to HTMLBUF with `princ'. This method is
+ ;; fast because: 1) it doesn't require examining the text
+ ;; properties char by char (htmlize-next-change is used to
+ ;; move between runs with the same face), and 2) it doesn't
+ ;; require buffer switches, which are slow in Emacs.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq next-change (htmlize-next-change (point) 'face))
+ ;; Get faces in use between (point) and NEXT-CHANGE, and
+ ;; convert them to fstructs.
+ (setq face-list (htmlize-faces-at-point)
+ fstruct-list (delq nil (mapcar (lambda (f)
+ (gethash f face-map))
+ face-list)))
+ ;; Extract buffer text, sans the invisible parts. Then
+ ;; untabify it and escape the HTML metacharacters.
+ (setq text (htmlize-buffer-substring-no-invisible
+ (point) next-change))
+ (when trailing-ellipsis
+ (setq text (htmlize-trim-ellipsis text)))
+ ;; If TEXT ends up empty, don't change trailing-ellipsis.
+ (when (> (length text) 0)
+ (setq trailing-ellipsis
+ (get-text-property (1- (length text))
+ 'htmlize-ellipsis text)))
+ (setq text (htmlize-untabify text (current-column)))
+ (setq text (htmlize-protect-string text))
+ ;; Don't bother writing anything if there's no text (this
+ ;; happens in invisible regions).
+ (when (> (length text) 0)
+ ;; Insert the text, along with the necessary markup to
+ ;; represent faces in FSTRUCT-LIST.
+ (funcall insert-text-method text fstruct-list htmlbuf))
+ (goto-char next-change)))
+
+ ;; Insert the epilog and post-process the buffer.
+ (with-current-buffer htmlbuf
+ (insert "</pre>")
+ (plist-put places 'content-end (point-marker))
+ (insert "\n </body>")
+ (plist-put places 'body-end (point-marker))
+ (insert "\n</html>\n")
+ (when htmlize-generate-hyperlinks
+ (htmlize-make-hyperlinks))
+ (htmlize-defang-local-variables)
+ (when htmlize-replace-form-feeds
+ ;; Change each "\n^L" to "<hr />".
+ (goto-char (point-min))
+ (let ((source
+ ;; ^L has already been escaped, so search for that.
+ (htmlize-protect-string "\n\^L"))
+ (replacement
+ (if (stringp htmlize-replace-form-feeds)
+ htmlize-replace-form-feeds
+ "</pre><hr /><pre>")))
+ (while (search-forward source nil t)
+ (replace-match replacement t t))))
+ (goto-char (point-min))
+ (when htmlize-html-major-mode
+ ;; What sucks about this is that the minor modes, most notably
+ ;; font-lock-mode, won't be initialized. Oh well.
+ (funcall htmlize-html-major-mode))
+ (set (make-local-variable 'htmlize-buffer-places) places)
+ (run-hooks 'htmlize-after-hook)
+ (buffer-enable-undo))
+ htmlbuf)))
+
+;; Utility functions.
+
+(defmacro htmlize-with-fontify-message (&rest body)
+ ;; When forcing fontification of large buffers in
+ ;; htmlize-ensure-fontified, inform the user that he is waiting for
+ ;; font-lock, not for htmlize to finish.
+ `(progn
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s..."
+ (buffer-name (current-buffer))))
+ ,@body
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s...done"
+ (buffer-name (current-buffer))))))
+
+(defun htmlize-ensure-fontified ()
+ ;; If font-lock is being used, ensure that the "support" modes
+ ;; actually fontify the buffer. If font-lock is not in use, we
+ ;; don't care because, except in htmlize-file, we don't force
+ ;; font-lock on the user.
+ (when (and (boundp 'font-lock-mode)
+ font-lock-mode)
+ ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
+ (cond
+ ((and (boundp 'jit-lock-mode)
+ (symbol-value 'jit-lock-mode))
+ (htmlize-with-fontify-message
+ (jit-lock-fontify-now (point-min) (point-max))))
+ ((and (boundp 'lazy-lock-mode)
+ (symbol-value 'lazy-lock-mode))
+ (htmlize-with-fontify-message
+ (lazy-lock-fontify-region (point-min) (point-max))))
+ ((and (boundp 'lazy-shot-mode)
+ (symbol-value 'lazy-shot-mode))
+ (htmlize-with-fontify-message
+ ;; lazy-shot is amazing in that it must *refontify* the region,
+ ;; even if the whole buffer has already been fontified. <sigh>
+ (lazy-shot-fontify-region (point-min) (point-max))))
+ ;; There's also fast-lock, but we don't need to handle specially,
+ ;; I think. fast-lock doesn't really defer fontification, it
+ ;; just saves it to an external cache so it's not done twice.
+ )))
+
+
+;;;###autoload
+(defun htmlize-buffer (&optional buffer)
+ "Convert BUFFER to HTML, preserving colors and decorations.
+
+The generated HTML is available in a new buffer, which is returned.
+When invoked interactively, the new buffer is selected in the current
+window. The title of the generated document will be set to the buffer's
+file name or, if that's not available, to the buffer's name.
+
+Note that htmlize doesn't fontify your buffers, it only uses the
+decorations that are already present. If you don't set up font-lock or
+something else to fontify your buffers, the resulting HTML will be
+plain. Likewise, if you don't like the choice of colors, fix the mode
+that created them, or simply alter the faces it uses."
+ (interactive)
+ (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
+ (htmlize-buffer-1))))
+ (when (interactive-p)
+ (switch-to-buffer htmlbuf))
+ htmlbuf))
+
+;;;###autoload
+(defun htmlize-region (beg end)
+ "Convert the region to HTML, preserving colors and decorations.
+See `htmlize-buffer' for details."
+ (interactive "r")
+ ;; Don't let zmacs region highlighting end up in HTML.
+ (when (fboundp 'zmacs-deactivate-region)
+ (zmacs-deactivate-region))
+ (let ((htmlbuf (save-restriction
+ (narrow-to-region beg end)
+ (htmlize-buffer-1))))
+ (when (interactive-p)
+ (switch-to-buffer htmlbuf))
+ htmlbuf))
+
+(defun htmlize-region-for-paste (beg end)
+ "Htmlize the region and return just the HTML as a string.
+This forces the `inline-css' style and only returns the HTML body,
+but without the BODY tag. This should make it useful for inserting
+the text to another HTML buffer."
+ (let* ((htmlize-output-type 'inline-css)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+(defun htmlize-make-file-name (file)
+ "Make an HTML file name from FILE.
+
+In its default implementation, this simply appends `.html' to FILE.
+This function is called by htmlize to create the buffer file name, and
+by `htmlize-file' to create the target file name.
+
+More elaborate transformations are conceivable, such as changing FILE's
+extension to `.html' (\"file.c\" -> \"file.html\"). If you want them,
+overload this function to do it and htmlize will comply."
+ (concat file ".html"))
+
+;; Older implementation of htmlize-make-file-name that changes FILE's
+;; extension to ".html".
+;(defun htmlize-make-file-name (file)
+; (let ((extension (file-name-extension file))
+; (sans-extension (file-name-sans-extension file)))
+; (if (or (equal extension "html")
+; (equal extension "htm")
+; (equal sans-extension ""))
+; (concat file ".html")
+; (concat sans-extension ".html"))))
+
+;;;###autoload
+(defun htmlize-file (file &optional target)
+ "Load FILE, fontify it, convert it to HTML, and save the result.
+
+Contents of FILE are inserted into a temporary buffer, whose major mode
+is set with `normal-mode' as appropriate for the file type. The buffer
+is subsequently fontified with `font-lock' and converted to HTML. Note
+that, unlike `htmlize-buffer', this function explicitly turns on
+font-lock. If a form of highlighting other than font-lock is desired,
+please use `htmlize-buffer' directly on buffers so highlighted.
+
+Buffers currently visiting FILE are unaffected by this function. The
+function does not change current buffer or move the point.
+
+If TARGET is specified and names a directory, the resulting file will be
+saved there instead of to FILE's directory. If TARGET is specified and
+does not name a directory, it will be used as output file name."
+ (interactive (list (read-file-name
+ "HTML-ize file: "
+ nil nil nil (and (buffer-file-name)
+ (file-name-nondirectory
+ (buffer-file-name))))))
+ (let ((output-file (if (and target (not (file-directory-p target)))
+ target
+ (expand-file-name
+ (htmlize-make-file-name (file-name-nondirectory file))
+ (or target (file-name-directory file)))))
+ ;; Try to prevent `find-file-noselect' from triggering
+ ;; font-lock because we'll fontify explicitly below.
+ (font-lock-mode nil)
+ (font-lock-auto-fontify nil)
+ (global-font-lock-mode nil)
+ ;; Ignore the size limit for the purposes of htmlization.
+ (font-lock-maximum-size nil)
+ ;; Disable font-lock support modes. This will only work in
+ ;; more recent Emacs versions, so htmlize-buffer-1 still needs
+ ;; to call htmlize-ensure-fontified.
+ (font-lock-support-mode nil))
+ (with-temp-buffer
+ ;; Insert FILE into the temporary buffer.
+ (insert-file-contents file)
+ ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
+ ;; up. Restore it afterwards so with-temp-buffer's kill-buffer
+ ;; doesn't complain about killing a modified buffer.
+ (let ((buffer-file-name file))
+ ;; Set the major mode for the sake of font-lock.
+ (normal-mode)
+ (font-lock-mode 1)
+ (unless font-lock-mode
+ ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
+ ;; contrary to the documentation. This seems to work.
+ (font-lock-fontify-buffer))
+ ;; htmlize the buffer and save the HTML.
+ (with-current-buffer (htmlize-buffer-1)
+ (unwind-protect
+ (progn
+ (run-hooks 'htmlize-file-hook)
+ (write-region (point-min) (point-max) output-file))
+ (kill-buffer (current-buffer)))))))
+ ;; I haven't decided on a useful return value yet, so just return
+ ;; nil.
+ nil)
+
+;;;###autoload
+(defun htmlize-many-files (files &optional target-directory)
+ "Convert FILES to HTML and save the corresponding HTML versions.
+
+FILES should be a list of file names to convert. This function calls
+`htmlize-file' on each file; see that function for details. When
+invoked interactively, you are prompted for a list of files to convert,
+terminated with RET.
+
+If TARGET-DIRECTORY is specified, the HTML files will be saved to that
+directory. Normally, each HTML file is saved to the directory of the
+corresponding source file."
+ (interactive
+ (list
+ (let (list file)
+ ;; Use empty string as DEFAULT because setting DEFAULT to nil
+ ;; defaults to the directory name, which is not what we want.
+ (while (not (equal (setq file (read-file-name
+ "HTML-ize file (RET to finish): "
+ (and list (file-name-directory
+ (car list)))
+ "" t))
+ ""))
+ (push file list))
+ (nreverse list))))
+ ;; Verify that TARGET-DIRECTORY is indeed a directory. If it's a
+ ;; file, htmlize-file will use it as target, and that doesn't make
+ ;; sense.
+ (and target-directory
+ (not (file-directory-p target-directory))
+ (error "target-directory must name a directory: %s" target-directory))
+ (dolist (file files)
+ (htmlize-file file target-directory)))
+
+;;;###autoload
+(defun htmlize-many-files-dired (arg &optional target-directory)
+ "HTMLize dired-marked files."
+ (interactive "P")
+ (htmlize-many-files (dired-get-marked-files nil arg) target-directory))
+
+(provide 'htmlize)
+
+;;; htmlize.el ends here
diff --git a/contrib/lisp/org-annotate-file.el b/contrib/lisp/org-annotate-file.el
new file mode 100644
index 0000000..55e5a32
--- /dev/null
+++ b/contrib/lisp/org-annotate-file.el
@@ -0,0 +1,131 @@
+;;; org-annotate-file.el --- Annotate a file with org syntax
+
+;; Copyright (C) 2008-2012 Philip Jackson
+
+;; Author: Philip Jackson <phil@shellarchive.co.uk>
+;; Version: 0.2
+
+;; This file is not currently 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, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program ; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This is yet another implementation to allow the annotation of a
+;; file without modification of the file itself. The annotation is in
+;; org syntax so you can use all of the org features you are used to.
+
+;; To use you might put the following in your .emacs:
+;;
+;; (require 'org-annotate-file)
+;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
+;;
+;; To change the location of the annotation file:
+;;
+;; (setq org-annotate-file-storage-file "~/annotated.org")
+;;
+;; Then when you visit any file and hit C-c C-l you will find yourself
+;; in an org buffer on a headline which links to the file you were
+;; visiting, e.g:
+
+;; * ~/org-annotate-file.el
+
+;; Under here you can put anything you like, save the file
+;; and next time you hit C-c C-l you will hit those notes again.
+;;
+;; To put a subheading with a text search for the current line set
+;; `org-annotate-file-add-search` to non-nil value. Then when you hit
+;; C-c C-l (on the above line for example) you will get:
+
+;; * ~/org-annotate-file.el
+;; ** `org-annotate-file-add-search` to non-nil value. Then whe...
+
+;; Note that both of the above will be links.
+
+(require 'org)
+
+(defvar org-annotate-file-storage-file "~/.org-annotate-file.org"
+ "File in which to keep annotations.")
+
+(defvar org-annotate-file-add-search nil
+ "If non-nil then add a link as a second level to the actual
+location in the file")
+
+(defvar org-annotate-file-always-open t
+ "non-nil means always expand the full tree when you visit
+`org-annotate-file-storage-file'.")
+
+(defun org-annotate-file-elipsify-desc (string &optional after)
+ "Strip starting and ending whitespace and replace any chars
+that appear after the value in `after' with '...'"
+ (let* ((after (number-to-string (or after 30)))
+ (replace-map (list (cons "^[ \t]*" "")
+ (cons "[ \t]*$" "")
+ (cons (concat "^\\(.\\{" after
+ "\\}\\).*") "\\1..."))))
+ (mapc (lambda (x)
+ (when (string-match (car x) string)
+ (setq string (replace-match (cdr x) nil nil string))))
+ replace-map)
+ string))
+
+(defun org-annotate-file ()
+ "Put a section for the current file into your annotation file"
+ (interactive)
+ (unless (buffer-file-name)
+ (error "This buffer has no associated file"))
+ (org-annotate-file-show-section))
+
+(defun org-annotate-file-show-section (&optional buffer)
+ "Visit the buffer named `org-annotate-file-storage-file' and
+show the relevant section"
+ (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name))))
+ (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
+ (link (org-make-link-string (concat "file:" filename) filename))
+ (search-link (org-make-link-string
+ (concat "file:" filename "::" line)
+ (org-annotate-file-elipsify-desc line))))
+ (with-current-buffer (find-file org-annotate-file-storage-file)
+ (unless (eq major-mode 'org-mode)
+ (org-mode))
+ (goto-char (point-min))
+ (widen)
+ (when org-annotate-file-always-open
+ (show-all))
+ (unless (search-forward-regexp
+ (concat "^* " (regexp-quote link)) nil t)
+ (org-annotate-file-add-upper-level link))
+ (beginning-of-line)
+ (org-narrow-to-subtree)
+ ;; deal with a '::' search if need be
+ (when org-annotate-file-add-search
+ (unless (search-forward-regexp
+ (concat "^** " (regexp-quote search-link)) nil t)
+ (org-annotate-file-add-second-level search-link))))))
+
+(defun org-annotate-file-add-upper-level (link)
+ (goto-char (point-min))
+ (call-interactively 'org-insert-heading)
+ (insert link))
+
+(defun org-annotate-file-add-second-level (link)
+ (goto-char (point-at-eol))
+ (call-interactively 'org-insert-subheading)
+ (insert link))
+
+(provide 'org-annotate-file)
+
+;;; org-annotate-file.el ends here
diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el
new file mode 100644
index 0000000..8424e62
--- /dev/null
+++ b/contrib/lisp/org-bibtex-extras.el
@@ -0,0 +1,155 @@
+;;; org-bibtex-extras --- extras for working with org-bibtex entries
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte <eric dot schulte at gmx dot com>
+;; Keywords: outlines, hypermedia, bibtex, d3
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+
+;; This file is not yet 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, 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:
+
+;; Warning: This should certainly be considered EXPERIMENTAL and still
+;; in development, feedback is welcome, but don't expect it
+;; to work.
+
+;; This file add some extra functionality to your bibtex entries which
+;; are stored as Org-mode headlines using org-bibtex.el. Most
+;; features expect that you keep all of your reading notes in a single
+;; file, set the `obe-bibtex-file' variable to the path to this file.
+;;
+;; - d3 view :: d3 is a Javascript library which supports interactive
+;; display of graphs. To view your citations as a d3
+;; graph, execute the following which will create a .json
+;; export of your references file, then grab a copy of
+;; d3, edit examples/force/force.js to replace
+;;
+;; var source`"miserables.json";
+;;
+;; with
+;;
+;; var source`"your-references.json";
+;;
+;; then view examples/force/force.html in your browser.
+;;
+;; - HTML export :: Customize the `obe-html-link-base' variable so
+;; that it points to an html export of your
+;; references, then add the following to your html
+;; export hook, and citations will be resolved during
+;; html export.
+;;
+;; (add-hook 'org-export-first-hook
+;; (lambda ()
+;; (when (equal org-export-current-backend 'html)
+;; (obe-html-export-citations))))
+
+;;; Code:
+(require 'org-bibtex)
+
+(defcustom obe-bibtex-file nil "File holding bibtex entries.")
+
+(defcustom obe-html-link-base nil
+ "Base of citation links.
+For example, to point to your `obe-bibtex-file' use the following.
+
+ (setq obe-html-link-base (format \"file:%s\" obe-bibtex-file))
+")
+
+(defvar obe-citations nil)
+(defun obe-citations ()
+ "Return all citations from `obe-bibtex-file'."
+ (or obe-citations
+ (save-window-excursion
+ (find-file obe-bibtex-file)
+ (goto-char (point-min))
+ (while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
+ (push (org-babel-clean-text-properties (match-string 1))
+ obe-citations))
+ obe-citations)))
+
+(defun obe-goto-citation (&optional citation)
+ "Visit a citation given its ID."
+ (interactive)
+ (let ((citation (or citation
+ (org-icompleting-read "Citation: "
+ (obe-citations)))))
+ (find-file obe-bibtex-file)
+ (goto-char (point-min))
+ (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
+ (outline-previous-visible-heading 1)
+ t)))
+
+(defun obe-html-export-citations ()
+ "Convert all \\cite{...} citations in the current file into HTML links."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\cite{\\([^\000}]+\\)}" nil t)
+ (replace-match
+ (save-match-data
+ (mapconcat (lambda (c) (format "[[%s#%s][%s]]" obe-html-link-base c c))
+ (mapcar #'org-babel-trim
+ (split-string (match-string 1) ",")) ", "))))))
+
+(defun obe-get-meta-data (citation)
+ "Collect meta-data for CITATION."
+ (save-excursion
+ (when (obe-goto-citation citation)
+ (let ((pt (point)))
+ `((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t))
+ (:title . ,(org-babel-clean-text-properties (org-get-heading 1 1)))
+ (:journal . ,(org-entry-get pt "JOURNAL")))))))
+
+(defun obe-meta-to-json (meta &optional fields)
+ "Turn a list of META data from citations into a string of json."
+ (let ((counter 1) nodes links)
+ (flet ((id (it) (position it nodes :test #'string= :key #'car))
+ (col (k) (mapcar (lambda (r) (cdr (assoc k r))) meta))
+ (add (lst)
+ (dolist (el lst) (push (cons el counter) nodes))
+ (incf counter)))
+ ;; build the nodes of the graph
+ (add (col :title))
+ (add (remove-if (lambda (author) (string-match "others" author))
+ (remove-duplicates (apply #'append (col :authors))
+ :test #'string=)))
+ (dolist (field fields)
+ (add (remove-duplicates (col field) :test #'string=)))
+ ;; build the links in the graph
+ (dolist (citation meta)
+ (let ((dest (id (cdr (assoc :title citation)))))
+ (dolist (author (mapcar #'id (cdr (assoc :authors citation))))
+ (when author (push (cons author dest) links)))
+ (let ((jid (id (cdr (assoc :journal citation)))))
+ (when jid (push (cons jid dest) links)))
+ (let ((cid (id (cdr (assoc :category citation)))))
+ (when cid (push (cons cid dest) links)))))
+ ;; build the json string
+ (format "{\"nodes\":[%s],\"links\":[%s]}"
+ (mapconcat
+ (lambda (pair)
+ (format "{\"name\":%S,\"group\":%d}"
+ (car pair) (cdr pair)))
+ nodes ",")
+ (mapconcat
+ (lambda (link)
+ (format "{\"source\":%d,\"target\":%d,\"value\":1}"
+ (car link) (cdr link)))
+ (meta-to-links meta nodes) ",")))))
+
+(provide 'org-bibtex-extras)
+;;; org-bibtex-extras ends here
diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el
new file mode 100644
index 0000000..56129d2
--- /dev/null
+++ b/contrib/lisp/org-bookmark.el
@@ -0,0 +1,88 @@
+;;; org-bookmark.el - Support for links to bookmark
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
+;; Version: 1.0
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'org)
+(require 'bookmark)
+
+(defgroup org-bookmark nil
+ "Options concerning the bookmark link."
+ :tag "Org Startup"
+ :group 'org-link)
+
+(defcustom org-bookmark-in-dired nil
+ "Use org-bookmark in dired."
+ :group 'org-bookmark
+ :type 'boolean)
+
+(defcustom org-bookmark-when-visiting-a-file nil
+ "Use org-bookmark in any buffer visiting a file."
+ :group 'org-bookmark
+ :type 'boolean)
+
+(defcustom org-bookmark-use-first-bookmark nil
+ "If several bookmarks links to the buffer, take the first one.
+Otherwise prompt the user for the right bookmark to use."
+ :group 'org-bookmark
+ :type 'boolean)
+
+(org-add-link-type "bookmark" 'org-bookmark-open)
+(add-hook 'org-store-link-functions 'org-bookmark-store-link)
+
+(defun org-bookmark-open (bookmark)
+ "Visit the bookmark BOOKMARK."
+ (bookmark-jump bookmark))
+
+(defun org-bookmark-store-link ()
+ "Store a link to the current line's bookmark in bookmark list."
+ (let (file bookmark bmks)
+ (cond ((and org-bookmark-in-dired
+ (eq major-mode 'dired-mode))
+ (setq file (abbreviate-file-name (dired-get-filename))))
+ ((and org-bookmark-when-visiting-a-file
+ (buffer-file-name (buffer-base-buffer)))
+ (setq file (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))))
+ (if (not file)
+ (when (eq major-mode 'bookmark-bmenu-mode)
+ (setq bookmark (bookmark-bmenu-bookmark)))
+ (when (and (setq bmks
+ (mapcar (lambda (name)
+ (if (equal file
+ (abbreviate-file-name
+ (bookmark-location name)))
+ name))
+ (bookmark-all-names)))
+ (setq bmks (delete nil bmks)))
+ (setq bookmark
+ (if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark)
+ (car bmks)
+ (completing-read "Bookmark: " bmks nil t nil nil (car bmks))))))
+ (if bookmark
+ (org-store-link-props :link (contact "bookmark:" bookmark)
+ :description bookmark))))
+
+(provide 'org-bookmark)
+
+;;; org-bookmark.el ends here
diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el
new file mode 100644
index 0000000..1345a55
--- /dev/null
+++ b/contrib/lisp/org-checklist.el
@@ -0,0 +1,140 @@
+;;; org-checklist.el --- org functions for checklist handling
+
+;; Copyright (C) 2008-2012 James TD Smith
+
+;; Author: James TD Smith (@ ahktenzero (. mohorovi cc))
+;; Version: 1.0
+;; Keywords: org, checklists
+;;
+;; 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 file provides some functions for handing repeated tasks which involve
+;; checking off a list of items. By setting the RESET_CHECK_BOXES property in an
+;; item, when the TODO state is set to done all checkboxes under that item are
+;; cleared. If the LIST_EXPORT_BASENAME property is set, a file will be created
+;; using the value of that property plus a timestamp, containing all the items
+;; in the list which are not checked. Additionally the user will be prompted to
+;; print the list.
+;;
+;; I use this for to keep track of stores of various things (food stores,
+;; components etc) which I check periodically and use the exported list of items
+;; which are not present as a shopping list.
+;;
+;;; Usage:
+;; (require 'org-checklist)
+;;
+;; Set the RESET_CHECK_BOXES and LIST_EXPORT_BASENAME properties in items as
+;; needed.
+;;
+;;; Code:
+(require 'org)
+(load "a2ps-print" 'no-error)
+
+(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons "LIST_EXPORT_BASENAME" org-default-properties)))
+
+(defgroup org-checklist nil
+ "Extended checklist handling for org"
+ :tag "Org-checklist"
+ :group 'org)
+
+(defcustom org-checklist-export-time-format "%Y%m%d%H%M"
+ "The format of timestamp appended to LIST_EXPORT_BASENAME to
+ make the name of the export file."
+ :link '(function-link format-time-string)
+ :group 'org-checklist
+ :type 'string)
+
+(defcustom org-checklist-export-function 'org-export-as-ascii
+ "function used to prepare the export file for printing"
+ :group 'org-checklist
+ :type '(radio (function-item :tag "ascii text" org-export-as-ascii)
+ (function-item :tag "HTML" org-export-as-html)
+ (function-item :tag "LaTeX" :value org-export-as-latex)
+ (function-item :tag "XOXO" :value org-export-as-xoxo)))
+
+(defcustom org-checklist-export-params nil
+ "options for the export function file for printing"
+ :group 'org-checklist
+ :type '(repeat string))
+
+(defcustom org-checklist-a2ps-params nil
+ "options for a2ps for printing"
+ :group 'org-checklist
+ :type '(repeat string))
+
+(defun org-reset-checkbox-state-maybe ()
+ "Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set"
+ (interactive "*")
+ (if (org-entry-get (point) "RESET_CHECK_BOXES")
+ (org-reset-checkbox-state-subtree)))
+
+
+(defun org-make-checklist-export ()
+ "Produce a checklist containing all unchecked items from a list
+of checkbox items"
+ (interactive "*")
+ (if (org-entry-get (point) "LIST_EXPORT_BASENAME")
+ (let* ((export-file (concat (org-entry-get (point) "LIST_EXPORT_BASENAME" nil)
+ "-" (format-time-string
+ org-checklist-export-time-format)
+ ".org"))
+ (print (case (org-entry-get (point) "PRINT_EXPORT" nil)
+ (("" "nil" nil) nil)
+ (t t)
+ (nil (y-or-n-p "Print list? "))))
+ exported-lines
+ (title "Checklist export"))
+ (save-restriction
+ (save-excursion
+ (org-narrow-to-subtree)
+ (org-update-checkbox-count-maybe)
+ (org-show-subtree)
+ (goto-char (point-min))
+ (when (looking-at org-complex-heading-regexp)
+ (setq title (match-string 4)))
+ (goto-char (point-min))
+ (let ((end (point-max)))
+ (while (< (point) end)
+ (when (and (org-at-item-checkbox-p)
+ (or (string= (match-string 0) "[ ]")
+ (string= (match-string 0) "[-]")))
+ (add-to-list 'exported-lines (thing-at-point 'line) t))
+ (beginning-of-line 2)))
+ (set-buffer (get-buffer-create export-file))
+ (org-insert-heading)
+ (insert (or title export-file) "\n")
+ (dolist (entry exported-lines) (insert entry))
+ (org-update-checkbox-count-maybe)
+ (write-file export-file)
+ (if (print)
+ (progn (funcall org-checklist-export-function
+ org-checklist-export-params)
+ (let* ((current-a2ps-switches a2ps-switches)
+ (a2ps-switches (append current-a2ps-switches
+ org-checklist-a2ps-params)))
+ (a2ps-buffer)))))))))
+
+(defun org-checklist ()
+ (when (member org-state org-done-keywords) ;; org-state dynamically bound in org.el/org-todo
+ (org-make-checklist-export)
+ (org-reset-checkbox-state-maybe)))
+
+(add-hook 'org-after-todo-state-change-hook 'org-checklist)
+
+(provide 'org-checklist)
+
+;;; org-checklist.el ends here
diff --git a/contrib/lisp/org-choose.el b/contrib/lisp/org-choose.el
new file mode 100644
index 0000000..3513fe9
--- /dev/null
+++ b/contrib/lisp/org-choose.el
@@ -0,0 +1,542 @@
+;;;_ org-choose.el --- decision management for org-mode
+
+;;;_. Headers
+;;;_ , License
+;; Copyright (C) 2009-2012 Tom Breton (Tehom)
+
+;; This file is not part of GNU Emacs.
+
+;; Author: Tom Breton (Tehom)
+;; Keywords: outlines, 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 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;_ , Commentary:
+
+; This is code to support decision management. It lets you treat a
+; group of sibling items in org-mode as alternatives in a decision.
+
+; There are no user commands in this file. You use it by:
+; * Loading it (manually or by M-x customize-apropos org-modules)
+
+;; * Setting up at least one set of TODO keywords with the
+;; interpretation "choose" by either:
+
+;; * Using the file directive #+CHOOSE_TODO:
+
+;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES"
+
+;; * Or by M-x customize-apropos org-todo-keywords
+
+;; * Operating on single items with the TODO commands.
+
+;; * Use C-S-right to change the keyword set. Use this to change to
+;; the "choose" keyword set that you just defined.
+
+;; * Use S-right to advance the TODO mark to the next setting.
+
+;; For "choose", that means you like this alternative more than
+;; before. Other alternatives will be automatically demoted to
+;; keep your settings consistent.
+
+;; * Use S-left to demote TODO to the previous setting.
+
+;; For "choose", that means you don't like this alternative as much
+;; as before. Other alternatives will be automatically promoted,
+;; if this item was all that was keeping them down.
+
+;; * All the other TODO commands are available and behave essentially
+;; the normal way.
+
+
+;;;_ , Requires
+
+(require 'org)
+;(eval-when-compile
+; (require 'cl))
+(require 'cl)
+
+;;;_. Body
+;;;_ , The variables
+
+(defstruct (org-choose-mark-data. (:type list))
+ "The format of an entry in org-choose-mark-data.
+Indexes are 0-based or `nil'.
+"
+ keyword
+ bot-lower-range
+ top-upper-range
+ range-length
+ static-default
+ all-keywords)
+
+(defvar org-choose-mark-data
+ ()
+ "Alist of information for choose marks.
+
+Each entry is an `org-choose-mark-data.'" )
+(make-variable-buffer-local 'org-choose-mark-data)
+;;;_ , For setup
+;;;_ . org-choose-filter-one
+
+(defun org-choose-filter-one (i)
+ "Return a list of
+ * a canonized version of the string
+ * optionally one symbol"
+
+ (if
+ (not
+ (string-match "(.*)" i))
+ (list i i)
+ (let*
+ (
+ (end-text (match-beginning 0))
+ (vanilla-text (substring i 0 end-text))
+ ;;Get the parenthesized part.
+ (match (match-string 0 i))
+ ;;Remove the parentheses.
+ (args (substring match 1 -1))
+ ;;Split it
+ (arglist
+ (let
+ ((arglist-x (org-split-string args ",")))
+ ;;When string starts with "," `split-string' doesn't
+ ;;make a first arg, so in that case make one
+ ;;manually.
+ (if
+ (string-match "^," args)
+ (cons nil arglist-x)
+ arglist-x)))
+ (decision-arg (second arglist))
+ (type
+ (cond
+ ((string= decision-arg "0")
+ 'default-mark)
+ ((string= decision-arg "+")
+ 'top-upper-range)
+ ((string= decision-arg "-")
+ 'bot-lower-range)
+ (t nil)))
+ (vanilla-arg (first arglist))
+ (vanilla-mark
+ (if vanilla-arg
+ (concat vanilla-text "("vanilla-arg")")
+ vanilla-text)))
+ (if type
+ (list vanilla-text vanilla-mark type)
+ (list vanilla-text vanilla-mark)))))
+
+;;;_ . org-choose-setup-vars
+(defun org-choose-setup-vars (bot-lower-range top-upper-range
+ static-default num-items all-mark-texts)
+ "Add to org-choose-mark-data according to arguments"
+
+ (let*
+ (
+ (tail
+ ;;If there's no bot-lower-range or no default, we don't
+ ;;have ranges.
+ (cdr
+ (if (and static-default bot-lower-range)
+ (let*
+ (
+ ;;If there's no top-upper-range, use the last
+ ;;item.
+ (top-upper-range
+ (or top-upper-range (1- num-items)))
+ (lower-range-length
+ (1+ (- static-default bot-lower-range)))
+ (upper-range-length
+ (- top-upper-range static-default))
+ (range-length
+ (min upper-range-length lower-range-length)))
+
+
+ (make-org-choose-mark-data.
+ :keyword nil
+ :bot-lower-range bot-lower-range
+ :top-upper-range top-upper-range
+ :range-length range-length
+ :static-default static-default
+ :all-keywords all-mark-texts))
+
+ (make-org-choose-mark-data.
+ :keyword nil
+ :bot-lower-range nil
+ :top-upper-range nil
+ :range-length nil
+ :static-default (or static-default 0)
+ :all-keywords all-mark-texts)))))
+
+ (dolist (text all-mark-texts)
+ (pushnew (cons text tail)
+ org-choose-mark-data
+ :test
+ #'(lambda (a b)
+ (equal (car a) (car b)))))))
+
+
+
+
+;;;_ . org-choose-filter-tail
+(defun org-choose-filter-tail (raw)
+ "Return a translation of RAW to vanilla and set appropriate
+buffer-local variables.
+
+RAW is a list of strings representing the input text of a choose
+interpretation."
+ (let
+ ((vanilla-list nil)
+ (all-mark-texts nil)
+ (index 0)
+ bot-lower-range top-upper-range range-length static-default)
+ (dolist (i raw)
+ (destructuring-bind
+ (vanilla-text vanilla-mark &optional type)
+ (org-choose-filter-one i)
+ (cond
+ ((eq type 'bot-lower-range)
+ (setq bot-lower-range index))
+ ((eq type 'top-upper-range)
+ (setq top-upper-range index))
+ ((eq type 'default-mark)
+ (setq static-default index)))
+ (incf index)
+ (push vanilla-text all-mark-texts)
+ (push vanilla-mark vanilla-list)))
+
+ (org-choose-setup-vars bot-lower-range top-upper-range
+ static-default index (reverse all-mark-texts))
+ (nreverse vanilla-list)))
+
+;;;_ . org-choose-setup-filter
+
+(defun org-choose-setup-filter (raw)
+ "A setup filter for choose interpretations."
+ (when (eq (car raw) 'choose)
+ (cons
+ 'choose
+ (org-choose-filter-tail (cdr raw)))))
+
+;;;_ . org-choose-conform-after-promotion
+(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix)
+ "Conform the current item after another item was promoted"
+
+ (unless
+ ;;Skip the entry that triggered this by skipping any entry with
+ ;;the same starting position. plist uses the start of the
+ ;;header line as the position, but map no longer does, so we
+ ;;have to go back to the heading.
+ (=
+ (save-excursion
+ (org-back-to-heading)
+ (point))
+ entry-pos)
+ (let
+ ((ix
+ (org-choose-get-entry-index keywords)))
+ ;;If the index of the entry exceeds the highest allowable
+ ;;index, change it to that.
+ (when (and ix
+ (> ix highest-ok-ix))
+ (org-todo
+ (nth highest-ok-ix keywords))))))
+;;;_ . org-choose-conform-after-demotion
+(defun org-choose-conform-after-demotion (entry-pos keywords
+ raise-to-ix
+ old-highest-ok-ix)
+ "Conform the current item after another item was demoted."
+
+ (unless
+ ;;Skip the entry that triggered this.
+ (=
+ (save-excursion
+ (org-back-to-heading)
+ (point))
+ entry-pos)
+ (let
+ ((ix
+ (org-choose-get-entry-index keywords)))
+ ;;If the index of the entry was at or above the old allowable
+ ;;position, change it to the new mirror position if there is
+ ;;one.
+ (when (and
+ ix
+ raise-to-ix
+ (>= ix old-highest-ok-ix))
+ (org-todo
+ (nth raise-to-ix keywords))))))
+
+;;;_ , org-choose-keep-sensible (the org-trigger-hook function)
+(defun org-choose-keep-sensible (change-plist)
+ "Bring the other items back into a sensible state after an item's
+setting was changed."
+ (let*
+ ( (from (plist-get change-plist :from))
+ (to (plist-get change-plist :to))
+ (entry-pos
+ (set-marker
+ (make-marker)
+ (plist-get change-plist :position)))
+ (kwd-data
+ (assoc to org-todo-kwd-alist)))
+ (when
+ (eq (nth 1 kwd-data) 'choose)
+ (let*
+ (
+ (data
+ (assoc to org-choose-mark-data))
+ (keywords
+ (org-choose-mark-data.-all-keywords data))
+ (old-index
+ (org-choose-get-index-in-keywords
+ from
+ keywords))
+ (new-index
+ (org-choose-get-index-in-keywords
+ to
+ keywords))
+ (highest-ok-ix
+ (org-choose-highest-other-ok
+ new-index
+ data))
+ (funcdata
+ (cond
+ ;;The entry doesn't participate in conformance,
+ ;;so give `nil' which does nothing.
+ ((not highest-ok-ix) nil)
+ ;;The entry was created or promoted
+ ((or
+ (not old-index)
+ (> new-index old-index))
+ (list
+ #'org-choose-conform-after-promotion
+ entry-pos keywords
+ highest-ok-ix))
+ (t ;;Otherwise the entry was demoted.
+ (let
+ (
+ (raise-to-ix
+ (min
+ highest-ok-ix
+ (org-choose-mark-data.-static-default
+ data)))
+ (old-highest-ok-ix
+ (org-choose-highest-other-ok
+ old-index
+ data)))
+
+ (list
+ #'org-choose-conform-after-demotion
+ entry-pos
+ keywords
+ raise-to-ix
+ old-highest-ok-ix))))))
+
+ (if funcdata
+ ;;The funny-looking names are to make variable capture
+ ;;unlikely. (Poor-man's lexical bindings).
+ (destructuring-bind (func-d473 . args-46k) funcdata
+ (let
+ ((map-over-entries
+ (org-choose-get-fn-map-group))
+ ;;We may call `org-todo', so let various hooks
+ ;;`nil' so we don't cause loops.
+ org-after-todo-state-change-hook
+ org-trigger-hook
+ org-blocker-hook
+ org-todo-get-default-hook
+ ;;Also let this alist `nil' so we don't log
+ ;;secondary transitions.
+ org-todo-log-states)
+ ;;Map over group
+ (funcall map-over-entries
+ #'(lambda ()
+ (apply func-d473 args-46k))))))))
+
+ ;;Remove the marker
+ (set-marker entry-pos nil)))
+
+
+
+;;;_ , Getting the default mark
+;;;_ . org-choose-get-index-in-keywords
+(defun org-choose-get-index-in-keywords (ix all-keywords)
+ "Return the index of the current entry."
+
+ (if ix
+ (position ix all-keywords
+ :test #'equal)))
+
+;;;_ . org-choose-get-entry-index
+(defun org-choose-get-entry-index (all-keywords)
+ "Return index of current entry."
+
+ (let*
+ ((state (org-entry-get (point) "TODO")))
+ (org-choose-get-index-in-keywords state all-keywords)))
+
+;;;_ . org-choose-get-fn-map-group
+
+(defun org-choose-get-fn-map-group ()
+ "Return a function to map over the group"
+
+ #'(lambda (fn)
+ (require 'org-agenda) ;; `org-map-entries' seems to need it.
+ (save-excursion
+ (unless (org-up-heading-safe)
+ (error "Choosing is only supported between siblings in a tree, not on top level"))
+ (let
+ ((level (org-reduced-level (org-outline-level))))
+ (save-restriction
+ (org-map-entries
+ fn
+ (format "LEVEL=%d" level)
+ 'tree))))))
+
+;;;_ . org-choose-get-highest-mark-index
+
+(defun org-choose-get-highest-mark-index (keywords)
+ "Get the index of the highest current mark in the group.
+If there is none, return 0"
+
+ (let*
+ (
+ ;;Func maps over applicable entries.
+ (map-over-entries
+ (org-choose-get-fn-map-group))
+
+ (indexes-list
+ (remove nil
+ (funcall map-over-entries
+ #'(lambda ()
+ (org-choose-get-entry-index keywords))))))
+ (if
+ indexes-list
+ (apply #'max indexes-list)
+ 0)))
+
+
+;;;_ . org-choose-highest-ok
+
+(defun org-choose-highest-other-ok (ix data)
+ "Return the highest index that any choose mark can sensibly have,
+given that another mark has index IX.
+DATA must be a `org-choose-mark-data.'."
+
+ (let
+ (
+ (bot-lower-range
+ (org-choose-mark-data.-bot-lower-range data))
+ (top-upper-range
+ (org-choose-mark-data.-top-upper-range data))
+ (range-length
+ (org-choose-mark-data.-range-length data)))
+ (when (and ix bot-lower-range)
+ (let*
+ ((delta
+ (- top-upper-range ix)))
+ (unless
+ (< range-length delta)
+ (+ bot-lower-range delta))))))
+
+;;;_ . org-choose-get-default-mark-index
+
+(defun org-choose-get-default-mark-index (data)
+ "Return the index of the default mark in a choose interpretation.
+
+DATA must be a `org-choose-mark-data.'."
+
+
+ (or
+ (let
+ ((highest-mark-index
+ (org-choose-get-highest-mark-index
+ (org-choose-mark-data.-all-keywords data))))
+ (org-choose-highest-other-ok
+ highest-mark-index data))
+ (org-choose-mark-data.-static-default data)))
+
+
+
+;;;_ . org-choose-get-mark-N
+(defun org-choose-get-mark-N (n data)
+ "Get the text of the nth mark in a choose interpretation."
+
+ (let*
+ ((l (org-choose-mark-data.-all-keywords data)))
+ (nth n l)))
+
+;;;_ . org-choose-get-default-mark
+
+(defun org-choose-get-default-mark (new-mark old-mark)
+ "Get the default mark IFF in a choose interpretation.
+NEW-MARK and OLD-MARK are the text of the new and old marks."
+
+ (let*
+ (
+ (old-kwd-data
+ (assoc old-mark org-todo-kwd-alist))
+ (new-kwd-data
+ (assoc new-mark org-todo-kwd-alist))
+ (becomes-choose
+ (and
+ (or
+ (not old-kwd-data)
+ (not
+ (eq (nth 1 old-kwd-data) 'choose)))
+ (eq (nth 1 new-kwd-data) 'choose))))
+ (when
+ becomes-choose
+ (let
+ ((new-mark-data
+ (assoc new-mark org-choose-mark-data)))
+ (if
+ new-mark
+ (org-choose-get-mark-N
+ (org-choose-get-default-mark-index
+ new-mark-data)
+ new-mark-data)
+ (error "Somehow got an unrecognizable mark"))))))
+
+;;;_ , Setting it all up
+
+(eval-after-load "org"
+ '(progn
+ (add-to-list 'org-todo-setup-filter-hook
+ #'org-choose-setup-filter)
+ (add-to-list 'org-todo-get-default-hook
+ #'org-choose-get-default-mark)
+ (add-to-list 'org-trigger-hook
+ #'org-choose-keep-sensible)
+ (add-to-list 'org-todo-interpretation-widgets
+ '(:tag "Choose (to record decisions)" choose)
+ 'append)
+ ))
+
+
+;;;_. Footers
+;;;_ , Provides
+
+(provide 'org-choose)
+
+;;;_ * Local emacs vars.
+;;;_ + Local variables:
+;;;_ + End:
+
+;;;_ , End
+
+;;; org-choose.el ends here
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
new file mode 100644
index 0000000..089e8ad
--- /dev/null
+++ b/contrib/lisp/org-collector.el
@@ -0,0 +1,229 @@
+;;; org-collector --- collect properties into tables
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte <schulte dot eric at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
+;; organization, properties
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+
+;; This file is not yet 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, 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:
+
+;; Pass in an alist of columns, each column can be either a single
+;; property or a function which takes column names as arguments.
+;;
+;; For example the following propview block would collect the value of
+;; the 'amount' property from each header in the current buffer
+;;
+;; #+BEGIN: propview :cols (ITEM amount)
+;; | "ITEM" | "amount" |
+;; |---------------------+----------|
+;; | "December Spending" | 0 |
+;; | "Grocery Store" | 56.77 |
+;; | "Athletic club" | 75.0 |
+;; | "Restaurant" | 30.67 |
+;; | "January Spending" | 0 |
+;; | "Athletic club" | 75.0 |
+;; | "Restaurant" | 50.00 |
+;; |---------------------+----------|
+;; | | |
+;; #+END:
+;;
+;; This slightly more selective propview block will limit those
+;; headers included to those in the subtree with the id 'december'
+;; in which the spendtype property is equal to "food"
+;;
+;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount)
+;; | "ITEM" | "amount" |
+;; |-----------------+----------|
+;; | "Grocery Store" | 56.77 |
+;; | "Restaurant" | 30.67 |
+;; |-----------------+----------|
+;; | | |
+;; #+END:
+;;
+;; Org Collector allows arbitrary processing of the property values
+;; through elisp in the cols: property. This allows for both simple
+;; computations as in the following example
+;;
+;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d))
+;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" | "(+ f d)" |
+;; |--------+-----+-----+-------------------------+--------------------------+-----------|
+;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 | 35 |
+;; | "run2" | 2 | 34 | :na | :na | 36 |
+;; | "run3" | 2 | 35 | :na | :na | 37 |
+;; | "run4" | 2 | 36 | :na | :na | 38 |
+;; | | | | | | |
+;; #+END:
+;;
+;; or more complex computations as in the following example taken from
+;; an org file where each header in "results" subtree contained a
+;; property "sorted_hits" which was passed through the
+;; "average-precision" elisp function
+;;
+;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
+;; | "ITEM" | "(average-precision sorted_hits)" |
+;; |-----------+-----------------------------------|
+;; | run (80) | 0.105092 |
+;; | run (70) | 0.108142 |
+;; | run (10) | 0.111348 |
+;; | run (60) | 0.113593 |
+;; | run (50) | 0.116446 |
+;; | run (100) | 0.118863 |
+;; #+END:
+;;
+
+;;; Code:
+(require 'org)
+(require 'org-table)
+
+(defvar org-propview-default-value 0
+ "Default value to insert into the propview table when the no
+value is calculated either through lack of required variables for
+a column, or through the generation of an error.")
+
+(defun and-rest (list)
+ (if (listp list)
+ (if (> (length list) 1)
+ (and (car list) (and-rest (cdr list)))
+ (car list))
+ list))
+
+(put 'org-collector-error
+ 'error-conditions
+ '(error column-prop-error org-collector-error))
+
+(defun org-dblock-write:propview (params)
+ "collect the column specification from the #+cols line
+preceeding the dblock, then update the contents of the dblock."
+ (interactive)
+ (condition-case er
+ (let ((cols (plist-get params :cols))
+ (inherit (plist-get params :inherit))
+ (conds (plist-get params :conds))
+ (match (plist-get params :match))
+ (scope (plist-get params :scope))
+ (noquote (plist-get params :noquote))
+ (colnames (plist-get params :colnames))
+ (content-lines (org-split-string (plist-get params :content) "\n"))
+ id table line pos)
+ (save-excursion
+ (when (setq id (plist-get params :id))
+ (cond ((not id) nil)
+ ((eq id 'global) (goto-char (point-min)))
+ ((eq id 'local) nil)
+ ((setq idpos (org-find-entry-with-id id))
+ (goto-char idpos))
+ (t (error "Cannot find entry with :ID: %s" id))))
+ (unless (eq id 'global) (org-narrow-to-subtree))
+ (setq stringformat (if noquote "%s" "%S"))
+ (setq table (org-propview-to-table
+ (org-propview-collect cols stringformat conds match scope inherit
+ (if colnames colnames cols)) stringformat))
+ (widen))
+ (setq pos (point))
+ (when content-lines
+ (while (string-match "^#" (car content-lines))
+ (insert (pop content-lines) "\n")))
+ (insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1)
+ (message (format "point-%d" pos))
+ (while (setq line (pop content-lines))
+ (when (string-match "^#" line)
+ (insert "\n" line)))
+ (goto-char pos)
+ (org-table-recalculate 'all))
+ (org-collector-error (widen) (error "%s" er))
+ (error (widen) (error "%s" er))))
+
+(defun org-propview-eval-w-props (props body)
+ "evaluate the BODY-FORMS binding the variables using the
+variables and values specified in props"
+ (condition-case nil ;; catch any errors
+ (eval `(let ,(mapcar
+ (lambda (pair) (list (intern (car pair)) (cdr pair)))
+ props)
+ ,body))
+ (error nil)))
+
+(defun org-propview-get-with-inherited (&optional inherit)
+ (append
+ (org-entry-properties)
+ (delq nil
+ (mapcar (lambda (i)
+ (let* ((n (symbol-name i))
+ (p (org-entry-get (point) n 'do-inherit)))
+ (when p (cons n p))))
+ inherit))))
+
+(defun org-propview-collect (cols stringformat &optional conds match scope inherit colnames)
+ (interactive)
+ ;; collect the properties from every header
+ (let* ((header-props
+ (let ((org-trust-scanner-tags t) alst)
+ (org-map-entries
+ (quote (cons (cons "ITEM" (org-get-heading t))
+ (org-propview-get-with-inherited inherit)))
+ match scope)))
+ ;; read property values
+ (header-props
+ (mapcar (lambda (props)
+ (mapcar (lambda (pair)
+ (cons (car pair) (org-babel-read (cdr pair))))
+ props))
+ header-props))
+ ;; collect all property names
+ (prop-names
+ (mapcar 'intern (delete-dups
+ (apply 'append (mapcar (lambda (header)
+ (mapcar 'car header))
+ header-props))))))
+ (append
+ (list
+ (if colnames colnames (mapcar (lambda (el) (format stringformat el)) cols))
+ 'hline) ;; ------------------------------------------------
+ (mapcar ;; calculate the value of the column for each header
+ (lambda (props) (mapcar (lambda (col)
+ (let ((result (org-propview-eval-w-props props col)))
+ (if result result org-propview-default-value)))
+ cols))
+ (if conds
+ ;; eliminate the headers which don't satisfy the property
+ (delq nil
+ (mapcar
+ (lambda (props)
+ (if (and-rest (mapcar
+ (lambda (col)
+ (org-propview-eval-w-props props col))
+ conds))
+ props))
+ header-props))
+ header-props)))))
+
+(defun org-propview-to-table (results stringformat)
+ ;; (message (format "cols:%S" cols))
+ (orgtbl-to-orgtbl
+ (mapcar
+ (lambda (row)
+ (if (equal row 'hline)
+ 'hline
+ (mapcar (lambda (el) (format stringformat el)) row)))
+ (delq nil results)) '()))
+
+(provide 'org-collector)
+;;; org-collector ends here
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
new file mode 100644
index 0000000..bc52648
--- /dev/null
+++ b/contrib/lisp/org-contacts.el
@@ -0,0 +1,621 @@
+;;; org-contacts.el --- Contacts management
+
+;; Copyright (C) 2010-2012 Julien Danjou <julien@danjou.info>
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: outlines, hypermedia, calendar
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code for managing your contacts into Org-mode.
+
+;; To enter new contacts, you can use `org-capture' and a template just like
+;; this:
+
+;; ("c" "Contacts" entry (file "~/Org/contacts.org")
+;; "* %(org-contacts-template-name)
+;; :PROPERTIES:
+;; :EMAIL: %(org-contacts-template-email)
+;; :END:")))
+;;
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(eval-and-compile
+ (require 'org))
+(require 'gnus-util)
+
+(defgroup org-contacts nil
+ "Options concerning contacts management."
+ :group 'org)
+
+(defcustom org-contacts-files nil
+ "List of Org files to use as contacts source.
+If set to nil, all your Org files will be used."
+ :type '(repeat file)
+ :group 'org-contacts)
+
+(defcustom org-contacts-email-property "EMAIL"
+ "Name of the property for contact email address."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-address-property "ADDRESS"
+ "Name of the property for contact address."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-birthday-property "BIRTHDAY"
+ "Name of the property for contact birthday date."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
+ "Format of the anniversary agenda entry. The following replacements are available:
+
+ %h - Heading name
+ %l - Link to the heading
+ %y - Number of year
+ %Y - Number of year (ordinal)"
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL"
+ "Name of the property for contact last read email link storage."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-icon-property "ICON"
+ "Name of the property for contact icon."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-nickname-property "NICKNAME"
+ "Name of the property for IRC nickname match."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-icon-size 32
+ "Size of the contacts icons."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve)
+ "Whether use Gravatar to fetch contact icons."
+ :type 'boolean
+ :group 'org-contacts)
+
+(defcustom org-contacts-completion-ignore-case t
+ "Ignore case when completing contacts."
+ :type 'boolean
+ :group 'org-contacts)
+
+(defcustom org-contacts-group-prefix "+"
+ "Group prefix."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-matcher (concat org-contacts-email-property "<>\"\"")
+ "Matching rule for finding heading that are contacts.
+This can be a tag name, or a property check."
+ :type 'string
+ :group 'org-contacts)
+
+(defcustom org-contacts-email-link-description-format "%s (%d)"
+ "Format used to store links to email.
+This overrides `org-email-link-description-format' if set."
+ :group 'org-contacts
+ :type 'string)
+
+(defcustom org-contacts-vcard-file "contacts.vcf"
+ "Default file for vcard export."
+ :group 'org-contacts
+ :type 'file)
+
+(defvar org-contacts-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "M" 'org-contacts-view-send-email)
+ (define-key map "i" 'org-contacts-view-switch-to-irc-buffer)
+ map)
+ "The keymap used in `org-contacts' result list.")
+
+(defun org-contacts-files ()
+ "Return list of Org files to use for contact management."
+ (or org-contacts-files (org-agenda-files t 'ifmode)))
+
+(defun org-contacts-filter (&optional name-match tags-match)
+ "Search for a contact maching NAME-MATCH and TAGS-MATCH.
+If both match values are nil, return all contacts."
+ (let* (todo-only
+ (tags-matcher
+ (if tags-match
+ (cdr (org-make-tags-matcher tags-match))
+ t))
+ (name-matcher
+ (if name-match
+ '(org-string-match-p name-match (org-get-heading t))
+ t))
+ (contacts-matcher
+ (cdr (org-make-tags-matcher org-contacts-matcher)))
+ markers result)
+ (dolist (file (org-contacts-files))
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (unless (eq major-mode 'org-mode)
+ (error "File %s is no in `org-mode'" file))
+ (org-scan-tags
+ '(add-to-list 'markers (set-marker (make-marker) (point)))
+ `(and ,contacts-matcher ,tags-matcher ,name-matcher)
+ todo-only)))
+ (dolist (marker markers result)
+ (org-with-point-at marker
+ (add-to-list 'result
+ (list (org-get-heading t) marker (org-entry-properties marker 'all)))))))
+
+(when (not (fboundp 'completion-table-case-fold))
+ ;; That function is new in Emacs 24...
+ (defun completion-table-case-fold (table &optional dont-fold)
+ (lambda (string pred action)
+ (let ((completion-ignore-case (not dont-fold)))
+ (complete-with-action action table string pred)))))
+
+(defun org-contacts-complete-name (&optional start)
+ "Complete text at START with a user name and email."
+ (let* ((end (point))
+ (start (or start
+ (save-excursion
+ (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
+ (goto-char (match-end 0))
+ (point))))
+ (orig (buffer-substring start end))
+ (completion-ignore-case org-contacts-completion-ignore-case)
+ (group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig))
+ (completion-list
+ (if group-completion-p
+ (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group))
+ (org-uniquify
+ (loop for contact in (org-contacts-filter)
+ with group-list
+ nconc (org-split-string
+ (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
+ (loop for contact in (org-contacts-filter)
+ ;; The contact name is always the car of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+ ;; Build the list of the user email addresses.
+ for email-list = (split-string (or
+ (cdr (assoc-string org-contacts-email-property (caddr contact)))
+ ""))
+ ;; If the user has email addresses…
+ if email-list
+ ;; … append a list of USER <EMAIL>.
+ nconc (loop for email in email-list
+ collect (org-contacts-format-email contact-name email)))))
+ (completion-list (all-completions orig completion-list)))
+ ;; If we are completing a group, and that's the only group, just return
+ ;; the real result.
+ (when (and group-completion-p
+ (= (length completion-list) 1))
+ (setq completion-list
+ (list (concat (car completion-list) ";: "
+ (mapconcat 'identity
+ (loop for contact in (org-contacts-filter
+ nil
+ (get-text-property 0 'org-contacts-group (car completion-list)))
+ ;; The contact name is always the car of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+ ;; Grab the first email of the contact
+ for email = (car (split-string (or
+ (cdr (assoc-string org-contacts-email-property (caddr contact)))
+ "")))
+ ;; If the user has an email address, append USER <EMAIL>.
+ if email collect (org-contacts-format-email contact-name email))
+ ", ")))))
+ (list start end (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case)))))
+
+(defun org-contacts-message-complete-function ()
+ "Function used in `completion-at-point-functions' in `message-mode'."
+ (let ((mail-abbrev-mode-regexp
+ "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
+ (when (mail-abbrev-in-expansion-header-p)
+ (org-contacts-complete-name))))
+
+(defun org-contacts-gnus-get-name-email ()
+ "Get name and email address from Gnus message."
+ (if (gnus-alive-p)
+ (gnus-with-article-headers
+ (mail-extract-address-components
+ (or (mail-fetch-field "From") "")))))
+
+(defun org-contacts-gnus-article-from-get-marker ()
+ "Return a marker for a contact based on From."
+ (let* ((address (org-contacts-gnus-get-name-email))
+ (name (car address))
+ (email (cadr address)))
+ (cadar (or (org-contacts-filter
+ nil
+ (concat org-contacts-email-property "={\\b" (regexp-quote email) "\\b}"))
+ (when name
+ (org-contacts-filter
+ (concat "^" name "$")))))))
+
+(defun org-contacts-gnus-article-from-goto ()
+ "Go to contact in the From address of current Gnus message."
+ (interactive)
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
+ (when marker
+ (switch-to-buffer-other-window (marker-buffer marker))
+ (goto-char marker)
+ (when (eq major-mode 'org-mode)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ ;; show the next heading
+ (org-flag-heading nil)))))))
+
+(defun org-contacts-anniversaries (&optional field format)
+ "Compute FIELD anniversary for each contact, returning FORMAT.
+Default FIELD value is \"BIRTHDAY\".
+
+Format is a string matching the following format specification:
+
+ %h - Heading name
+ %l - Link to the heading
+ %y - Number of year
+ %Y - Number of year (ordinal)"
+ (let ((calendar-date-style 'american)
+ (entry ""))
+ (unless format (setq format org-contacts-birthday-format))
+ (loop for contact in (org-contacts-filter)
+ for anniv = (let ((anniv (cdr (assoc-string
+ (or field org-contacts-birthday-property)
+ (caddr contact)))))
+ (when anniv
+ (calendar-gregorian-from-absolute
+ (org-time-string-to-absolute anniv))))
+ ;; Use `diary-anniversary' to compute anniversary.
+ if (and anniv (apply 'diary-anniversary anniv))
+ collect (format-spec format
+ `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil)))
+ (?h . ,(car contact))
+ (?y . ,(- (calendar-extract-year date)
+ (calendar-extract-year anniv)))
+ (?Y . ,(let ((years (- (calendar-extract-year date)
+ (calendar-extract-year anniv))))
+ (format "%d%s" years (diary-ordinal-suffix years)))))))))
+
+(defun org-completing-read-date (prompt collection
+ &optional predicate require-match initial-input
+ hist def inherit-input-method)
+ "Like `completing-read' but reads a date.
+Only PROMPT and DEF are really used."
+ (org-read-date nil nil nil prompt nil def))
+
+(add-to-list 'org-property-set-functions-alist
+ `(,org-contacts-birthday-property . org-completing-read-date))
+
+(defun org-contacts-template-name (&optional return-value)
+ "Try to return the contact name for a template.
+If not found return RETURN-VALUE or something that would ask the user."
+ (or (car (org-contacts-gnus-get-name-email))
+ return-value
+ "%^{Name}"))
+
+(defun org-contacts-template-email (&optional return-value)
+ "Try to return the contact email for a template.
+If not found return RETURN-VALUE or something that would ask the user."
+ (or (cadr (org-contacts-gnus-get-name-email))
+ return-value
+ (concat "%^{" org-contacts-email-property "}p")))
+
+(defun org-contacts-gnus-store-last-mail ()
+ "Store a link between mails and contacts.
+
+This function should be called from `gnus-article-prepare-hook'."
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
+ (when marker
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (let* ((org-email-link-description-format (or org-contacts-email-link-description-format
+ org-email-link-description-format))
+ (link (gnus-with-article-buffer (org-store-link nil))))
+ (org-set-property org-contacts-last-read-mail-property link)))))))
+
+(defun org-contacts-icon-as-string ()
+ (let ((image (org-contacts-get-icon)))
+ (concat
+ (propertize "-" 'display
+ (append
+ (if image
+ image
+ `'(space :width (,org-contacts-icon-size)))
+ '(:ascent center)))
+ " ")))
+
+;;;###autoload
+(defun org-contacts (name)
+ "Create agenda view for contacts matching NAME."
+ (interactive (list (read-string "Name: ")))
+ (let ((org-agenda-files (org-contacts-files))
+ (org-agenda-skip-function
+ (lambda () (org-agenda-skip-if nil `(notregexp ,name))))
+ (org-agenda-format (propertize
+ "%(org-contacts-icon-as-string)% p% s%(org-contacts-irc-number-of-unread-messages)%+T"
+ 'keymap org-contacts-keymap))
+ (org-agenda-overriding-header
+ (or org-agenda-overriding-header
+ (concat "List of contacts matching `" name "':"))))
+ (setq org-agenda-skip-regexp name)
+ (org-tags-view nil org-contacts-matcher)
+ (with-current-buffer org-agenda-buffer-name
+ (setq org-agenda-redo-command
+ (list 'org-contacts name)))))
+
+(defun org-contacts-completing-read (prompt
+ &optional predicate
+ initial-input hist def inherit-input-method)
+ "Call `completing-read' with contacts name as collection."
+ (org-completing-read
+ prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method))
+
+(defun org-contacts-format-email (name email)
+ "Format a mail address."
+ (unless email
+ (error "`email' cannot be nul"))
+ (if name
+ (concat name " <" email ">")
+ email))
+
+(defun org-contacts-check-mail-address (mail)
+ "Add MAIL address to contact at point if it does not have it."
+ (let ((mails (org-entry-get (point) org-contacts-email-property)))
+ (unless (member mail (split-string mails))
+ (when (yes-or-no-p
+ (format "Do you want to add this address to %s?" (org-get-heading t)))
+ (org-set-property org-contacts-email-property (concat mails " " mail))))))
+
+(defun org-contacts-gnus-check-mail-address ()
+ "Check that contact has the current address recorded.
+This function should be called from `gnus-article-prepare-hook'."
+ (let ((marker (org-contacts-gnus-article-from-get-marker)))
+ (when marker
+ (org-with-point-at marker
+ (org-contacts-check-mail-address (cadr (org-contacts-gnus-get-name-email)))))))
+
+(defun org-contacts-gnus-insinuate ()
+ "Add some hooks for Gnus user.
+This adds `org-contacts-gnus-check-mail-address' and
+`org-contacts-gnus-store-last-mail' to
+`gnus-article-prepare-hook'. It also adds a binding on `;' in
+`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'"
+ (require 'gnus)
+ (require 'gnus-art)
+ (define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto)
+ (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
+ (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail))
+
+(when (boundp 'completion-at-point-functions)
+ (add-hook 'message-mode-hook
+ (lambda ()
+ (add-to-list 'completion-at-point-functions
+ 'org-contacts-message-complete-function))))
+
+(defun org-contacts-wl-get-from-header-content ()
+ "Retrieve the content of the `From' header of an email.
+Works from wl-summary-mode and mime-view-mode - that is while viewing email.
+Depends on Wanderlust been loaded."
+ (with-current-buffer (org-capture-get :original-buffer)
+ (cond
+ ((eq major-mode 'wl-summary-mode) (when wl-summary-buffer-elmo-folder
+ (elmo-message-field
+ wl-summary-buffer-elmo-folder
+ (wl-summary-message-number)
+ 'from)))
+ ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
+ (prog1
+ (std11-fetch-field "From")
+ (widen))))))
+
+(defun org-contacts-wl-get-name-email ()
+ "Get name and email address from wanderlust email.
+See `org-contacts-wl-get-from-header-content' for limitations."
+ (let ((from (org-contacts-wl-get-from-header-content)))
+ (when from
+ (list (wl-address-header-extract-realname from)
+ (wl-address-header-extract-address from)))))
+
+(defun org-contacts-template-wl-name (&optional return-value)
+ "Try to return the contact name for a template from wl.
+If not found return RETURN-VALUE or something that would ask the user."
+ (or (car (org-contacts-wl-get-name-email))
+ return-value
+ "%^{Name}"))
+
+(defun org-contacts-template-wl-email (&optional return-value)
+ "Try to return the contact email for a template from wl.
+If not found return RETURN-VALUE or something that would ask the user."
+ (or (cadr (org-contacts-wl-get-name-email))
+ return-value
+ (concat "%^{" org-contacts-email-property "}p")))
+
+(defun org-contacts-view-send-email (&optional ask)
+ "Send email to the contact at point.
+If ASK is set, ask for the email address even if there's only one address."
+ (interactive "P")
+ (let ((marker (org-get-at-bol 'org-hd-marker)))
+ (org-with-point-at marker
+ (let ((emails (org-entry-get (point) org-contacts-email-property)))
+ (if emails
+ (let ((email-list (split-string emails)))
+ (if (and (= (length email-list) 1) (not ask))
+ (compose-mail (org-contacts-format-email
+ (org-get-heading t) emails))
+ (let ((email (completing-read "Send mail to which address: " email-list)))
+ (org-contacts-check-mail-address email)
+ (compose-mail (org-contacts-format-email (org-get-heading t) email)))))
+ (error (format "This contact has no mail address set (no %s property)."
+ org-contacts-email-property)))))))
+
+(defun org-contacts-get-icon (&optional pom)
+ "Get icon for contact at POM."
+ (setq pom (or pom (point)))
+ (catch 'icon
+ ;; Use `org-contacts-icon-property'
+ (let ((image-data (org-entry-get pom org-contacts-icon-property)))
+ (when image-data
+ (throw 'icon
+ (if (fboundp 'gnus-rescale-image)
+ (gnus-rescale-image (create-image image-data)
+ (cons org-contacts-icon-size org-contacts-icon-size))
+ (create-image image-data)))))
+ ;; Next, try Gravatar
+ (when org-contacts-icon-use-gravatar
+ (let* ((gravatar-size org-contacts-icon-size)
+ (email-list (org-entry-get pom org-contacts-email-property))
+ (gravatar
+ (when email-list
+ (loop for email in (split-string email-list)
+ for gravatar = (gravatar-retrieve-synchronously email)
+ if (and gravatar
+ (not (eq gravatar 'error)))
+ return gravatar))))
+ (when gravatar (throw 'icon gravatar))))))
+
+(defun org-contacts-irc-buffer (&optional pom)
+ "Get the IRC buffer associated with the entry at POM."
+ (setq pom (or pom (point)))
+ (let ((nick (org-entry-get pom org-contacts-nickname-property)))
+ (when nick
+ (let ((buffer (get-buffer nick)))
+ (when buffer
+ (with-current-buffer buffer
+ (when (eq major-mode 'erc-mode)
+ buffer)))))))
+
+(defun org-contacts-irc-number-of-unread-messages (&optional pom)
+ "Return the number of unread messages for contact at POM."
+ (when (boundp 'erc-modified-channels-alist)
+ (let ((number (cadr (assoc (org-contacts-irc-buffer pom) erc-modified-channels-alist))))
+ (if number
+ (format (concat "%3d unread message" (if (> number 1) "s" " ") " ") number)
+ (make-string 21 ? )))))
+
+(defun org-contacts-view-switch-to-irc-buffer ()
+ "Switch to the IRC buffer of the current contact if it has one."
+ (interactive)
+ (let ((marker (org-get-at-bol 'org-hd-marker)))
+ (org-with-point-at marker
+ (switch-to-buffer-other-window (org-contacts-irc-buffer)))))
+
+(defun org-contacts-completing-read-nickname (prompt collection
+ &optional predicate require-match initial-input
+ hist def inherit-input-method)
+ "Like `completing-read' but reads a nickname."
+ (org-completing-read prompt (append collection (erc-nicknames-list)) predicate require-match
+ initial-input hist def inherit-input-method))
+
+(defun erc-nicknames-list ()
+ "Return all nicknames of all ERC buffers."
+ (if (fboundp 'erc-buffer-list)
+ (loop for buffer in (erc-buffer-list)
+ nconc (with-current-buffer buffer
+ (loop for user-entry in (mapcar 'car (erc-get-channel-user-list))
+ collect (elt user-entry 1))))))
+
+(add-to-list 'org-property-set-functions-alist
+ `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
+
+(defun org-contacts-vcard-escape (str)
+ "Escape ; , and \n in STR for use in the VCard format.
+Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp."
+ (when str
+ (replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
+
+(defun org-contacts-vcard-encode-name (name)
+ "Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
+Org-contacts does not specify how to encode the name. So we try to do our best."
+ (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
+
+(defun org-contacts-vcard-format (contact)
+ "Formats CONTACT in VCard 3.0 format."
+ (let* ((properties (caddr contact))
+ (name (org-contacts-vcard-escape (car contact)))
+ (n (org-contacts-vcard-encode-name name))
+ (email (org-contacts-vcard-escape (cdr (assoc-string org-contacts-email-property properties))))
+ (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
+ (addr (cdr (assoc-string org-contacts-address-property properties)))
+ (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
+
+ (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
+ (concat head
+ (when email (format "EMAIL:%s\n" email))
+ (when addr
+ (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
+ (when bday
+ (let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday))))
+ (format "BDAY:%04d-%02d-%02d\n"
+ (calendar-extract-year cal-bday)
+ (calendar-extract-month cal-bday)
+ (calendar-extract-day cal-bday))))
+ (when nick (format "NICKNAME:%s\n" nick))
+ "END:VCARD\n\n")))
+
+(defun org-contacts-export-as-vcard (&optional name file to-buffer)
+ "Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer."
+ (interactive) ; TODO ask for name?
+ (let* ((filename (or file org-contacts-vcard-file))
+ (buffer (if to-buffer
+ (get-buffer-create to-buffer)
+ (find-file-noselect filename))))
+
+ (message "Exporting...")
+
+ (set-buffer buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (when (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ (loop for contact in (org-contacts-filter name)
+ do (insert (org-contacts-vcard-format contact)))
+
+ (if to-buffer
+ (current-buffer)
+ (progn (save-buffer) (kill-buffer)))))
+
+(defun org-contacts-show-map (&optional name)
+ "Show contacts on a map. Requires google-maps-el."
+ (interactive)
+ (unless (fboundp 'google-maps-static-show)
+ (error "`org-contacts-show-map' requires `google-maps-el'"))
+ (google-maps-static-show
+ :markers
+ (loop
+ for contact in (org-contacts-filter name)
+ for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
+ if addr
+ collect (cons (list addr) (list :label (string-to-char (car contact)))))))
+
+(provide 'org-contacts)
diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el
new file mode 100644
index 0000000..37b06a4
--- /dev/null
+++ b/contrib/lisp/org-contribdir.el
@@ -0,0 +1,38 @@
+;;; org-contribdir.el --- Mark the location of the contrib directory
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+;;
+;; This file is not yet 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+
+;; The sole purpose of this file is to be located in the same place
+;; as where the contributed Org files are located, typically in the
+;; contrib/lisp directory of the Org-mode distribution. This is to
+;; make sure that the command `org-reload' can reliably locate
+;; contributed org files.
+
+(provide 'org-contribdir)
+
+;;; org-contribdir.el ends here
diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
new file mode 100644
index 0000000..d741dbe
--- /dev/null
+++ b/contrib/lisp/org-depend.el
@@ -0,0 +1,420 @@
+;;; org-depend.el --- TODO dependencies for Org-mode
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.08
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part
+;; of Org-mode.
+;;
+;; This is an example implementation of TODO dependencies in Org-mode.
+;; It uses the new hooks in version 5.13 of Org-mode,
+;; `org-trigger-hook' and `org-blocker-hook'.
+;;
+;; It implements the following:
+;;
+;; Triggering
+;; ----------
+;;
+;; 1) If an entry contains a TRIGGER property that contains the string
+;; "chain-siblings(KEYWORD)", then switching that entry to DONE does
+;; do the following:
+;; - The sibling following this entry switched to todo-state KEYWORD.
+;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)",
+;; property, to make sure that, when *it* is DONE, the chain will
+;; continue.
+;;
+;; 2) If an entry contains a TRIGGER property that contains the string
+;; "chain-siblings-scheduled", then switching that entry to DONE does
+;; the following actions, similarly to "chain-siblings(KEYWORD)":
+;; - The sibling receives the same scheduled time as the entry
+;; marked as DONE (or, in the case, in which there is no scheduled
+;; time, the sibling does not get any either).
+;; - The sibling also gets the same TRIGGER property
+;; "chain-siblings-scheduled", so the chain can continue.
+;;
+;; 3) If the TRIGGER property contains the string
+;; "chain-find-next(KEYWORD[,OPTIONS])", then switching that entry
+;; to DONE do the following:
+;; - All siblings are of the entry are collected into a temporary
+;; list and then filtered and sorted according to OPTIONS
+;; - The first sibling on the list is changed into KEYWORD state
+;; - The sibling also gets the same TRIGGER property
+;; "chain-find-next", so the chain can continue.
+;;
+;; OPTIONS should be a comma separated string without spaces, and
+;; can contain following options:
+;;
+;; - from-top the candidate list is all of the siblings in
+;; the current subtree
+;;
+;; - from-bottom candidate list are all siblings from bottom up
+;;
+;; - from-current candidate list are all siblings from current item
+;; until end of subtree, then wrapped around from
+;; first sibling
+;;
+;; - no-wrap candidate list are siblings from current one down
+;;
+;; - todo-only Only consider siblings that have a todo keyword
+;; -
+;; - todo-and-done-only
+;; Same as above but also include done items.
+;;
+;; - priority-up sort by highest priority
+;; - priority-down sort by lowest priority
+;; - effort-up sort by highest effort
+;; - effort-down sort by lowest effort
+;;
+;; Default OPTIONS are from-top
+;;
+;;
+;; 4) If the TRIGGER property contains any other words like
+;; XYZ(KEYWORD), these are treated as entry id's with keywords. That
+;; means Org-mode will search for an entry with the ID property XYZ
+;; and switch that entry to KEYWORD as well.
+;;
+;; Blocking
+;; --------
+;;
+;; 1) If an entry contains a BLOCKER property that contains the word
+;; "previous-sibling", the sibling above the current entry is
+;; checked when you try to mark it DONE. If it is still in a TODO
+;; state, the current state change is blocked.
+;;
+;; 2) If the BLOCKER property contains any other words, these are
+;; treated as entry id's. That means Org-mode will search for an
+;; entry with the ID property exactly equal to this word. If any
+;; of these entries is not yet marked DONE, the current state change
+;; will be blocked.
+;;
+;; 3) Whenever a state change is blocked, an org-mark is pushed, so that
+;; you can find the offending entry with `C-c &'.
+;;
+;;; Example:
+;;
+;; When trying this example, make sure that the settings for TODO keywords
+;; have been activated, i.e. include the following line and press C-c C-c
+;; on the line before working with the example:
+;;
+;; #+TYP_TODO: TODO NEXT | DONE
+;;
+;; * TODO Win a million in Las Vegas
+;; The "third" TODO (see above) cannot become a TODO without this money.
+;;
+;; :PROPERTIES:
+;; :ID: I-cannot-do-it-without-money
+;; :END:
+;;
+;; * Do this by doing a chain of TODO's
+;; ** NEXT This is the first in this chain
+;; :PROPERTIES:
+;; :TRIGGER: chain-siblings(NEXT)
+;; :END:
+;;
+;; ** This is the second in this chain
+;;
+;; ** This is the third in this chain
+;; :PROPERTIES:
+;; :BLOCKER: I-cannot-do-it-without-money
+;; :END:
+;;
+;; ** This is the forth in this chain
+;; When this is DONE, we will also trigger entry XYZ-is-my-id
+;; :PROPERTIES:
+;; :TRIGGER: XYZ-is-my-id(TODO)
+;; :END:
+;;
+;; ** This is the fifth in this chain
+;;
+;; * Start writing report
+;; :PROPERTIES:
+;; :ID: XYZ-is-my-id
+;; :END:
+;;
+;;
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(defcustom org-depend-tag-blocked t
+ "Whether to indicate blocked TODO items by a special tag."
+ :group 'org
+ :type 'boolean)
+
+(defcustom org-depend-find-next-options
+ "from-current,todo-only,priority-up"
+ "Default options for chain-find-next trigger"
+ :group 'org
+ :type 'string)
+
+(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
+ "Perform a set of actions on the next sibling, if it exists,
+copying the sibling spec TRIGGER-VAL to the next sibling."
+ `(catch 'exit
+ (save-excursion
+ (goto-char pos)
+ ;; find the sibling, exit if no more siblings
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error (throw 'exit t)))
+ ;; mark the sibling TODO
+ ,@rest
+ ;; make sure the sibling will continue the chain
+ (org-entry-add-to-multivalued-property
+ nil "TRIGGER" ,trigger-val))))
+
+(defvar org-depend-doing-chain-find-next nil)
+
+(defun org-depend-trigger-todo (change-plist)
+ "Trigger new TODO entries after the current is switched to DONE.
+This does two different kinds of triggers:
+
+- If the current entry contains a TRIGGER property that contains
+ \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it
+ KEYWORD and also installs the \"chain-sibling\" trigger to continue
+ the chain.
+- If the current entry contains a TRIGGER property that contains
+ \"chain-siblings-scheduled\", we go to the next sibling and copy
+ the scheduled time from the current task, also installing the property
+ in the sibling.
+- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER
+ property is seen as an entry id. Org-mode finds the entry with the
+ corresponding ID property and switches it to the state TODO as well."
+
+ ;; Get information from the plist
+ (let* ((type (plist-get change-plist :type))
+ (pos (plist-get change-plist :position))
+ (from (plist-get change-plist :from))
+ (to (plist-get change-plist :to))
+ (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger!
+ trigger triggers tr p1 kwd)
+ (catch 'return
+ (unless (eq type 'todo-state-change)
+ ;; We are only handling todo-state-change....
+ (throw 'return t))
+ (unless (and (member from org-not-done-keywords)
+ (member to org-done-keywords))
+ ;; This is not a change from TODO to DONE, ignore it
+ (throw 'return t))
+
+ ;; OK, we just switched from a TODO state to a DONE state
+ ;; Lets see if this entry has a TRIGGER property.
+ ;; If yes, split it up on whitespace.
+ (setq trigger (org-entry-get pos "TRIGGER")
+ triggers (and trigger (org-split-string trigger "[ \t]+")))
+
+ ;; Go through all the triggers
+ (while (setq tr (pop triggers))
+ (cond
+ ((and (not org-depend-doing-chain-find-next)
+ (string-match "\\`chain-find-next(\\b\\(.+?\\)\\b\\(.*\\))\\'" tr))
+ ;; smarter sibling selection
+ (let* ((org-depend-doing-chain-find-next t)
+ (kwd (match-string 1 tr))
+ (options (match-string 2 tr))
+ (options (if (or (null options)
+ (equal options ""))
+ org-depend-find-next-options
+ options))
+ (todo-only (string-match "todo-only" options))
+ (todo-and-done-only (string-match "todo-and-done-only"
+ options))
+ (from-top (string-match "from-top" options))
+ (from-bottom (string-match "from-bottom" options))
+ (from-current (string-match "from-current" options))
+ (no-wrap (string-match "no-wrap" options))
+ (priority-up (string-match "priority-up" options))
+ (priority-down (string-match "priority-down" options))
+ (effort-up (string-match "effort-up" options))
+ (effort-down (string-match "effort-down" options)))
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((this-item (point)))
+ ;; go up to the parent headline, then advance to next child
+ (org-up-heading-safe)
+ (let ((end (save-excursion (org-end-of-subtree t)
+ (point)))
+ (done nil)
+ (items '()))
+ (outline-next-heading)
+ (while (not done)
+ (if (not (looking-at org-complex-heading-regexp))
+ (setq done t)
+ (let ((todo-kwd (match-string 2))
+ (tags (match-string 5))
+ (priority (org-get-priority (or (match-string 3) "")))
+ (effort (when (or effort-up effort-down)
+ (let ((effort (org-get-effort)))
+ (when effort
+ (org-duration-string-to-minutes effort))))))
+ (push (list (point) todo-kwd priority tags effort)
+ items))
+ (unless (org-goto-sibling)
+ (setq done t))))
+ ;; massage the list according to options
+ (setq items
+ (cond (from-top (nreverse items))
+ (from-bottom items)
+ ((or from-current no-wrap)
+ (let* ((items (nreverse items))
+ (pos (position this-item items :key #'first))
+ (items-before (subseq items 0 pos))
+ (items-after (subseq items pos)))
+ (if no-wrap items-after
+ (append items-after items-before))))
+ (t (nreverse items))))
+ (setq items (remove-if
+ (lambda (item)
+ (or (equal (first item) this-item)
+ (and (not todo-and-done-only)
+ (member (second item) org-done-keywords))
+ (and (or todo-only
+ todo-and-done-only)
+ (null (second item)))))
+ items))
+ (setq items
+ (sort
+ items
+ (lambda (item1 item2)
+ (let* ((p1 (third item1))
+ (p2 (third item2))
+ (e1 (fifth item1))
+ (e2 (fifth item2))
+ (p1-lt (< p1 p2))
+ (p1-gt (> p1 p2))
+ (e1-lt (and e1 (or (not e2) (< e1 e2))))
+ (e2-gt (and e2 (or (not e1) (> e1 e2)))))
+ (cond (priority-up
+ (or p1-gt
+ (and (equal p1 p2)
+ (or (and effort-up e1-gt)
+ (and effort-down e1-lt)))))
+ (priority-down
+ (or p1-lt
+ (and (equal p1 p2)
+ (or (and effort-up e1-gt)
+ (and effort-down e1-lt)))))
+ (effort-up
+ (or e1-gt (and (equal e1 e2) p1-gt)))
+ (effort-down
+ (or e1-lt (and (equal e1 e2) p1-gt))))))))
+ (when items
+ (goto-char (first (first items)))
+ (org-entry-add-to-multivalued-property nil "TRIGGER" tr)
+ (org-todo kwd)))))))
+ ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
+ ;; This is a TODO chain of siblings
+ (setq kwd (match-string 1 tr))
+ (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
+ (org-todo kwd)))
+ ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
+ ;; This seems to be ENTRY_ID(KEYWORD)
+ (setq id (match-string 1 tr)
+ kwd (match-string 2 tr)
+ p1 (org-find-entry-with-id id))
+ (when p1
+ ;; there is an entry with this ID, mark it TODO
+ (save-excursion
+ (goto-char p1)
+ (org-todo kwd))))
+ ((string-match "\\`chain-siblings-scheduled\\'" tr)
+ (let ((time (org-get-scheduled-time pos)))
+ (when time
+ (org-depend-act-on-sibling
+ "chain-siblings-scheduled"
+ (org-schedule nil time))))))))))
+
+(defun org-depend-block-todo (change-plist)
+ "Block turning an entry into a TODO.
+This checks for a BLOCKER property in an entry and checks
+all the entries listed there. If any of them is not done,
+block changing the current entry into a TODO entry. If the property contains
+the word \"previous-sibling\", the sibling above the current entry is checked.
+Any other words are treated as entry id's. If an entry exists with the
+this ID property, that entry is also checked."
+ ;; Get information from the plist
+ (let* ((type (plist-get change-plist :type))
+ (pos (plist-get change-plist :position))
+ (from (plist-get change-plist :from))
+ (to (plist-get change-plist :to))
+ (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger
+ blocker blockers bl p1
+ (proceed-p
+ (catch 'return
+ ;; If this is not a todo state change, or if this entry is
+ ;; DONE, do not block
+ (when (or (not (eq type 'todo-state-change))
+ (member from (cons 'done org-done-keywords))
+ (member to (cons 'todo org-not-done-keywords))
+ (not to))
+ (throw 'return t))
+
+ ;; OK, the plan is to switch from nothing to TODO
+ ;; Lets see if we will allow it. Find the BLOCKER property
+ ;; and split it on whitespace.
+ (setq blocker (org-entry-get pos "BLOCKER")
+ blockers (and blocker (org-split-string blocker "[ \t]+")))
+
+ ;; go through all the blockers
+ (while (setq bl (pop blockers))
+ (cond
+ ((equal bl "previous-sibling")
+ ;; the sibling is required to be DONE.
+ (catch 'ignore
+ (save-excursion
+ (goto-char pos)
+ ;; find the older sibling, exit if no more siblings
+ (condition-case nil
+ (outline-backward-same-level 1)
+ (error (throw 'ignore t)))
+ ;; Check if this entry is not yet done and block
+ (unless (org-entry-is-done-p)
+ ;; return nil, to indicate that we block the change!
+ (org-mark-ring-push)
+ (throw 'return nil)))))
+
+ ((setq p1 (org-find-entry-with-id bl))
+ ;; there is an entry with this ID, check it out
+ (save-excursion
+ (goto-char p1)
+ (unless (org-entry-is-done-p)
+ ;; return nil, to indicate that we block the change!
+ (org-mark-ring-push)
+ (throw 'return nil))))))
+ t ; return t to indicate that we are not blocking
+ )))
+ (when org-depend-tag-blocked
+ (org-toggle-tag "blocked" (if proceed-p 'off 'on)))
+
+ proceed-p))
+
+(add-hook 'org-trigger-hook 'org-depend-trigger-todo)
+(add-hook 'org-blocker-hook 'org-depend-block-todo)
+
+(provide 'org-depend)
+
+;;; org-depend.el ends here
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
new file mode 100644
index 0000000..2ffc201
--- /dev/null
+++ b/contrib/lisp/org-drill.el
@@ -0,0 +1,3001 @@
+;;; -*- coding: utf-8-unix -*-
+;;; org-drill.el - Self-testing using spaced repetition
+;;;
+;;; Author: Paul Sexton <eeeickythump@gmail.com>
+;;; Version: 2.3.6
+;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
+;;;
+;;;
+;;; Synopsis
+;;; ========
+;;;
+;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
+;;; "drill sessions", where the material to be remembered is presented to the
+;;; student in random order. The student rates his or her recall of each item,
+;;; and this information is used to schedule the item for later revision.
+;;;
+;;; Each drill session can be restricted to topics in the current buffer
+;;; (default), one or several files, all agenda files, or a subtree. A single
+;;; topic can also be drilled.
+;;;
+;;; Different "card types" can be defined, which present their information to
+;;; the student in different ways.
+;;;
+;;; See the file README.org for more detailed documentation.
+
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'hi-lock))
+(require 'org)
+(require 'org-id)
+(require 'org-learn)
+
+
+(defgroup org-drill nil
+ "Options concerning interactive drill sessions in Org mode (org-drill)."
+ :tag "Org-Drill"
+ :group 'org-link)
+
+
+
+(defcustom org-drill-question-tag
+ "drill"
+ "Tag which topics must possess in order to be identified as review topics
+by `org-drill'."
+ :group 'org-drill
+ :type 'string)
+
+
+(defcustom org-drill-maximum-items-per-session
+ 30
+ "Each drill session will present at most this many topics for review.
+Nil means unlimited."
+ :group 'org-drill
+ :type '(choice integer (const nil)))
+
+
+
+(defcustom org-drill-maximum-duration
+ 20
+ "Maximum duration of a drill session, in minutes.
+Nil means unlimited."
+ :group 'org-drill
+ :type '(choice integer (const nil)))
+
+
+(defcustom org-drill-failure-quality
+ 2
+ "If the quality of recall for an item is this number or lower,
+it is regarded as an unambiguous failure, and the repetition
+interval for the card is reset to 0 days. If the quality is higher
+than this number, it is regarded as successfully recalled, but the
+time interval to the next repetition will be lowered if the quality
+was near to a fail.
+
+By default this is 2, for SuperMemo-like behaviour. For
+Mnemosyne-like behaviour, set it to 1. Other values are not
+really sensible."
+ :group 'org-drill
+ :type '(choice (const 2) (const 1)))
+
+
+(defcustom org-drill-forgetting-index
+ 10
+ "What percentage of items do you consider it is 'acceptable' to
+forget each drill session? The default is 10%. A warning message
+is displayed at the end of the session if the percentage forgotten
+climbs above this number."
+ :group 'org-drill
+ :type 'integer)
+
+
+(defcustom org-drill-leech-failure-threshold
+ 15
+ "If an item is forgotten more than this many times, it is tagged
+as a 'leech' item."
+ :group 'org-drill
+ :type '(choice integer (const nil)))
+
+
+(defcustom org-drill-leech-method
+ 'skip
+ "How should 'leech items' be handled during drill sessions?
+Possible values:
+- nil :: Leech items are treated the same as normal items.
+- skip :: Leech items are not included in drill sessions.
+- warn :: Leech items are still included in drill sessions,
+ but a warning message is printed when each leech item is
+ presented."
+ :group 'org-drill
+ :type '(choice (const 'warn) (const 'skip) (const nil)))
+
+
+(defface org-drill-visible-cloze-face
+ '((t (:foreground "darkseagreen")))
+ "The face used to hide the contents of cloze phrases."
+ :group 'org-drill)
+
+
+(defface org-drill-visible-cloze-hint-face
+ '((t (:foreground "dark slate blue")))
+ "The face used to hide the contents of cloze phrases."
+ :group 'org-drill)
+
+
+(defface org-drill-hidden-cloze-face
+ '((t (:foreground "deep sky blue" :background "blue")))
+ "The face used to hide the contents of cloze phrases."
+ :group 'org-drill)
+
+
+(defcustom org-drill-use-visible-cloze-face-p
+ nil
+ "Use a special face to highlight cloze-deleted text in org mode
+buffers?"
+ :group 'org-drill
+ :type 'boolean)
+
+
+(defcustom org-drill-hide-item-headings-p
+ nil
+ "Conceal the contents of the main heading of each item during drill
+sessions? You may want to enable this behaviour if item headings or tags
+contain information that could 'give away' the answer."
+ :group 'org-drill
+ :type 'boolean)
+
+
+(defcustom org-drill-new-count-color
+ "royal blue"
+ "Foreground colour used to display the count of remaining new items
+during a drill session."
+ :group 'org-drill
+ :type 'color)
+
+(defcustom org-drill-mature-count-color
+ "green"
+ "Foreground colour used to display the count of remaining mature items
+during a drill session. Mature items are due for review, but are not new."
+ :group 'org-drill
+ :type 'color)
+
+(defcustom org-drill-failed-count-color
+ "red"
+ "Foreground colour used to display the count of remaining failed items
+during a drill session."
+ :group 'org-drill
+ :type 'color)
+
+(defcustom org-drill-done-count-color
+ "sienna"
+ "Foreground colour used to display the count of reviewed items
+during a drill session."
+ :group 'org-drill
+ :type 'color)
+
+
+(setplist 'org-drill-cloze-overlay-defaults
+ '(display "[...]"
+ face org-drill-hidden-cloze-face
+ window t))
+
+(setplist 'org-drill-hidden-text-overlay
+ '(invisible t))
+
+(setplist 'org-drill-replaced-text-overlay
+ '(display "Replaced text"
+ face default
+ window t))
+
+
+(defvar org-drill-cloze-regexp
+ ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
+ ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
+ ;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
+ "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
+
+
+(defvar org-drill-cloze-keywords
+ `((,org-drill-cloze-regexp
+ (1 'org-drill-visible-cloze-face nil)
+ (2 'org-drill-visible-cloze-hint-face t)
+ (3 'org-drill-visible-cloze-face nil)
+ )))
+
+
+(defcustom org-drill-card-type-alist
+ '((nil . org-drill-present-simple-card)
+ ("simple" . org-drill-present-simple-card)
+ ("twosided" . org-drill-present-two-sided-card)
+ ("multisided" . org-drill-present-multi-sided-card)
+ ("hide1cloze" . org-drill-present-multicloze-hide1)
+ ("hide2cloze" . org-drill-present-multicloze-hide2)
+ ("show1cloze" . org-drill-present-multicloze-show1)
+ ("show2cloze" . org-drill-present-multicloze-show2)
+ ("multicloze" . org-drill-present-multicloze-hide1)
+ ("hidefirst" . org-drill-present-multicloze-hide-first)
+ ("hidelast" . org-drill-present-multicloze-hide-last)
+ ("hide1_firstmore" . org-drill-present-multicloze-hide1-firstmore)
+ ("show1_lastmore" . org-drill-present-multicloze-show1-lastmore)
+ ("show1_firstless" . org-drill-present-multicloze-show1-firstless)
+ ("conjugate" org-drill-present-verb-conjugation
+ org-drill-show-answer-verb-conjugation)
+ ("spanish_verb" . org-drill-present-spanish-verb)
+ ("translate_number" org-drill-present-translate-number
+ org-drill-show-answer-translate-number))
+ "Alist associating card types with presentation functions. Each entry in the
+alist takes one of two forms:
+1. (CARDTYPE . QUESTION-FN), where CARDTYPE is a string or nil (for default),
+ and QUESTION-FN is a function which takes no arguments and returns a boolean
+ value.
+2. (CARDTYPE QUESTION-FN ANSWER-FN), where ANSWER-FN is a function that takes
+ one argument -- the argument is a function that itself takes no arguments.
+ ANSWER-FN is called with the point on the active item's
+ heading, just prior to displaying the item's 'answer'. It can therefore be
+ used to modify the appearance of the answer. ANSWER-FN must call its argument
+ before returning. (Its argument is a function that prompts the user and
+ performs rescheduling)."
+ :group 'org-drill
+ :type '(alist :key-type (choice string (const nil)) :value-type function))
+
+
+(defcustom org-drill-scope
+ 'file
+ "The scope in which to search for drill items when conducting a
+drill session. This can be any of:
+
+file The current buffer, respecting the restriction if any.
+ This is the default.
+tree The subtree started with the entry at point
+file-no-restriction The current buffer, without restriction
+file-with-archives The current buffer, and any archives associated with it.
+agenda All agenda files
+agenda-with-archives All agenda files with any archive files associated
+ with them.
+directory All files with the extension '.org' in the same
+ directory as the current file (includes the current
+ file if it is an .org file.)
+ (FILE1 FILE2 ...) If this is a list, all files in the list will be scanned.
+"
+ ;; Note -- meanings differ slightly from the argument to org-map-entries:
+ ;; 'file' means current file/buffer, respecting any restriction
+ ;; 'file-no-restriction' means current file/buffer, ignoring restrictions
+ ;; 'directory' means all *.org files in current directory
+ :group 'org-drill
+ :type '(choice (const 'file) (const 'tree) (const 'file-no-restriction)
+ (const 'file-with-archives) (const 'agenda)
+ (const 'agenda-with-archives) (const 'directory)
+ list))
+
+
+(defcustom org-drill-save-buffers-after-drill-sessions-p
+ t
+ "If non-nil, prompt to save all modified buffers after a drill session
+finishes."
+ :group 'org-drill
+ :type 'boolean)
+
+
+(defcustom org-drill-spaced-repetition-algorithm
+ 'sm5
+ "Which SuperMemo spaced repetition algorithm to use for scheduling items.
+Available choices are:
+- SM2 :: the SM2 algorithm, used in SuperMemo 2.0
+- SM5 :: the SM5 algorithm, used in SuperMemo 5.0
+- Simple8 :: a modified version of the SM8 algorithm. SM8 is used in
+ SuperMemo 98. The version implemented here is simplified in that while it
+ 'learns' the difficulty of each item using quality grades and number of
+ failures, it does not modify the matrix of values that
+ governs how fast the inter-repetition intervals increase. A method for
+ adjusting intervals when items are reviewed early or late has been taken
+ from SM11, a later version of the algorithm, and included in Simple8."
+ :group 'org-drill
+ :type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
+
+
+(defcustom org-drill-optimal-factor-matrix
+ nil
+ "DO NOT CHANGE THE VALUE OF THIS VARIABLE.
+
+Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm.
+The matrix is saved (using the 'customize' facility) at the end of each
+drill session.
+
+Over time, values in the matrix will adapt to the individual user's
+pace of learning."
+ :group 'org-drill
+ :type 'sexp)
+
+
+(defcustom org-drill-sm5-initial-interval
+ 4.0
+ "In the SM5 algorithm, the initial interval after the first
+successful presentation of an item is always 4 days. If you wish to change
+this, you can do so here."
+ :group 'org-drill
+ :type 'float)
+
+
+(defcustom org-drill-add-random-noise-to-intervals-p
+ nil
+ "If true, the number of days until an item's next repetition
+will vary slightly from the interval calculated by the SM2
+algorithm. The variation is very small when the interval is
+small, but scales up with the interval."
+ :group 'org-drill
+ :type 'boolean)
+
+
+(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ nil
+ "If true, when the student successfully reviews an item 1 or more days
+before or after the scheduled review date, this will affect that date of
+the item's next scheduled review, according to the algorithm presented at
+ [[http://www.supermemo.com/english/algsm11.htm#Advanced%20repetitions]].
+
+Items that were reviewed early will have their next review date brought
+forward. Those that were reviewed late will have their next review
+date postponed further.
+
+Note that this option currently has no effect if the SM2 algorithm
+is used."
+ :group 'org-drill
+ :type 'boolean)
+
+
+(defcustom org-drill-cloze-text-weight
+ 4
+ "For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless',
+this number determines how often the 'less favoured' situation
+should arise. It will occur 1 in every N trials, where N is the
+value of the variable.
+
+For example, with the hide1_firstmore card type, the first piece
+of clozed text should be hidden more often than the other
+pieces. If this variable is set to 4 (default), the first item
+will only be shown 25% of the time (1 in 4 trials). Similarly for
+show1_lastmore, the last item will be shown 75% of the time, and
+for show1_firstless, the first item would only be shown 25% of the
+time.
+
+If the value of this variable is NIL, then weighting is disabled, and
+all weighted card types are treated as their unweighted equivalents."
+ :group 'org-drill
+ :type '(choice integer (const nil)))
+
+
+(defcustom org-drill-cram-hours
+ 12
+ "When in cram mode, items are considered due for review if
+they were reviewed at least this many hours ago."
+ :group 'org-drill
+ :type 'integer)
+
+
+;;; NEW items have never been presented in a drill session before.
+;;; MATURE items HAVE been presented at least once before.
+;;; - YOUNG mature items were scheduled no more than
+;;; ORG-DRILL-DAYS-BEFORE-OLD days after their last
+;;; repetition. These items will have been learned 'recently' and will have a
+;;; low repetition count.
+;;; - OLD mature items have intervals greater than
+;;; ORG-DRILL-DAYS-BEFORE-OLD.
+;;; - OVERDUE items are past their scheduled review date by more than
+;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
+;;; regardless of young/old status.
+
+
+(defcustom org-drill-days-before-old
+ 10
+ "When an item's inter-repetition interval rises above this value in days,
+it is no longer considered a 'young' (recently learned) item."
+ :group 'org-drill
+ :type 'integer)
+
+
+(defcustom org-drill-overdue-interval-factor
+ 1.2
+ "An item is considered overdue if its scheduled review date is
+more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL
+days in the past. For example, a value of 1.2 means an additional
+20% of the last scheduled interval is allowed to elapse before
+the item is overdue. A value of 1.0 means no extra time is
+allowed at all - items are immediately considered overdue if
+there is even one day's delay in reviewing them. This variable
+should never be less than 1.0."
+ :group 'org-drill
+ :type 'float)
+
+
+(defcustom org-drill-learn-fraction
+ 0.5
+ "Fraction between 0 and 1 that governs how quickly the spaces
+between successive repetitions increase, for all items. The
+default value is 0.5. Higher values make spaces increase more
+quickly with each successful repetition. You should only change
+this in small increments (for example 0.05-0.1) as it has an
+exponential effect on inter-repetition spacing."
+ :group 'org-drill
+ :type 'float)
+
+
+(defvar *org-drill-session-qualities* nil)
+(defvar *org-drill-start-time* 0)
+(defvar *org-drill-new-entries* nil)
+(defvar *org-drill-dormant-entry-count* 0)
+(defvar *org-drill-due-entry-count* 0)
+(defvar *org-drill-overdue-entry-count* 0)
+(defvar *org-drill-due-tomorrow-count* 0)
+(defvar *org-drill-overdue-entries* nil
+ "List of markers for items that are considered 'overdue', based on
+the value of ORG-DRILL-OVERDUE-INTERVAL-FACTOR.")
+(defvar *org-drill-young-mature-entries* nil
+ "List of markers for mature entries whose last inter-repetition
+interval was <= ORG-DRILL-DAYS-BEFORE-OLD days.")
+(defvar *org-drill-old-mature-entries* nil
+ "List of markers for mature entries whose last inter-repetition
+interval was greater than ORG-DRILL-DAYS-BEFORE-OLD days.")
+(defvar *org-drill-failed-entries* nil)
+(defvar *org-drill-again-entries* nil)
+(defvar *org-drill-done-entries* nil)
+(defvar *org-drill-current-item* nil
+ "Set to the marker for the item currently being tested.")
+(defvar *org-drill-cram-mode* nil
+ "Are we in 'cram mode', where all items are considered due
+for review unless they were already reviewed in the recent past?")
+(defvar org-drill-scheduling-properties
+ '("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL"
+ "DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
+ "DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
+
+
+;;; Make the above settings safe as file-local variables.
+
+
+(put 'org-drill-question-tag 'safe-local-variable 'stringp)
+(put 'org-drill-maximum-items-per-session 'safe-local-variable
+ '(lambda (val) (or (integerp val) (null val))))
+(put 'org-drill-maximum-duration 'safe-local-variable
+ '(lambda (val) (or (integerp val) (null val))))
+(put 'org-drill-failure-quality 'safe-local-variable 'integerp)
+(put 'org-drill-forgetting-index 'safe-local-variable 'integerp)
+(put 'org-drill-leech-failure-threshold 'safe-local-variable 'integerp)
+(put 'org-drill-leech-method 'safe-local-variable
+ '(lambda (val) (memq val '(nil skip warn))))
+(put 'org-drill-use-visible-cloze-face-p 'safe-local-variable 'booleanp)
+(put 'org-drill-hide-item-headings-p 'safe-local-variable 'booleanp)
+(put 'org-drill-spaced-repetition-algorithm 'safe-local-variable
+ '(lambda (val) (memq val '(simple8 sm5 sm2))))
+(put 'org-drill-sm5-initial-interval 'safe-local-variable 'floatp)
+(put 'org-drill-add-random-noise-to-intervals-p 'safe-local-variable 'booleanp)
+(put 'org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ 'safe-local-variable 'booleanp)
+(put 'org-drill-cram-hours 'safe-local-variable 'integerp)
+(put 'org-drill-learn-fraction 'safe-local-variable 'floatp)
+(put 'org-drill-days-before-old 'safe-local-variable 'integerp)
+(put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp)
+(put 'org-drill-scope 'safe-local-variable
+ '(lambda (val) (or (symbolp val) (listp val))))
+(put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp)
+(put 'org-drill-cloze-text-weight 'safe-local-variable
+ '(lambda (val) (or (null val) (integerp val))))
+
+
+;;;; Utilities ================================================================
+
+
+(defun free-marker (m)
+ (set-marker m nil))
+
+
+(defmacro pop-random (place)
+ (let ((idx (gensym)))
+ `(if (null ,place)
+ nil
+ (let ((,idx (random* (length ,place))))
+ (prog1 (nth ,idx ,place)
+ (setq ,place (append (subseq ,place 0 ,idx)
+ (subseq ,place (1+ ,idx)))))))))
+
+
+(defmacro push-end (val place)
+ "Add VAL to the end of the sequence stored in PLACE. Return the new
+value."
+ `(setq ,place (append ,place (list ,val))))
+
+
+(defun shuffle-list (list)
+ "Randomly permute the elements of LIST (all permutations equally likely)."
+ ;; Adapted from 'shuffle-vector' in cookie1.el
+ (let ((i 0)
+ j
+ temp
+ (len (length list)))
+ (while (< i len)
+ (setq j (+ i (random* (- len i))))
+ (setq temp (nth i list))
+ (setf (nth i list) (nth j list))
+ (setf (nth j list) temp)
+ (setq i (1+ i))))
+ list)
+
+
+(defun round-float (floatnum fix)
+ "Round the floating point number FLOATNUM to FIX decimal places.
+Example: (round-float 3.56755765 3) -> 3.568"
+ (let ((n (expt 10 fix)))
+ (/ (float (round (* floatnum n))) n)))
+
+
+(defun command-keybinding-to-string (cmd)
+ "Return a human-readable description of the key/keys to which the command
+CMD is bound, or nil if it is not bound to a key."
+ (let ((key (where-is-internal cmd overriding-local-map t)))
+ (if key (key-description key))))
+
+
+(defun time-to-inactive-org-timestamp (time)
+ (format-time-string
+ (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
+ time))
+
+
+(defun org-map-drill-entries (func &optional scope &rest skip)
+ "Like `org-map-entries', but only drill entries are processed."
+ (let ((org-drill-scope (or scope org-drill-scope)))
+ (apply 'org-map-entries func
+ (concat "+" org-drill-question-tag)
+ (case org-drill-scope
+ (file nil)
+ (file-no-restriction 'file)
+ (directory
+ (directory-files (file-name-directory (buffer-file-name))
+ t "\\.org$"))
+ (t org-drill-scope))
+ skip)))
+
+
+(defmacro with-hidden-cloze-text (&rest body)
+ `(progn
+ (org-drill-hide-clozed-text)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unhide-clozed-text))))
+
+
+(defmacro with-hidden-cloze-hints (&rest body)
+ `(progn
+ (org-drill-hide-cloze-hints)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unhide-text))))
+
+
+(defmacro with-hidden-comments (&rest body)
+ `(progn
+ (if org-drill-hide-item-headings-p
+ (org-drill-hide-heading-at-point))
+ (org-drill-hide-comments)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unhide-text))))
+
+
+(defun org-drill-days-since-last-review ()
+ "Nil means a last review date has not yet been stored for
+the item.
+Zero means it was reviewed today.
+A positive number means it was reviewed that many days ago.
+A negative number means the date of last review is in the future --
+this should never happen."
+ (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
+ (when datestr
+ (- (time-to-days (current-time))
+ (time-to-days (apply 'encode-time
+ (org-parse-time-string datestr)))))))
+
+
+(defun org-drill-hours-since-last-review ()
+ "Like `org-drill-days-since-last-review', but return value is
+in hours rather than days."
+ (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
+ (when datestr
+ (floor
+ (/ (- (time-to-seconds (current-time))
+ (time-to-seconds (apply 'encode-time
+ (org-parse-time-string datestr))))
+ (* 60 60))))))
+
+
+(defun org-drill-entry-p (&optional marker)
+ "Is MARKER, or the point, in a 'drill item'? This will return nil if
+the point is inside a subheading of a drill item -- to handle that
+situation use `org-part-of-drill-entry-p'."
+ (save-excursion
+ (when marker
+ (org-drill-goto-entry marker))
+ (member org-drill-question-tag (org-get-local-tags))))
+
+
+(defun org-drill-goto-entry (marker)
+ (switch-to-buffer (marker-buffer marker))
+ (goto-char marker))
+
+
+(defun org-part-of-drill-entry-p ()
+ "Is the current entry either the main heading of a 'drill item',
+or a subheading within a drill item?"
+ (or (org-drill-entry-p)
+ ;; Does this heading INHERIT the drill tag
+ (member org-drill-question-tag (org-get-tags-at))))
+
+
+(defun org-drill-goto-drill-entry-heading ()
+ "Move the point to the heading which holds the :drill: tag for this
+drill entry."
+ (unless (org-at-heading-p)
+ (org-back-to-heading))
+ (unless (org-part-of-drill-entry-p)
+ (error "Point is not inside a drill entry"))
+ (while (not (org-drill-entry-p))
+ (unless (org-up-heading-safe)
+ (error "Cannot find a parent heading that is marked as a drill entry"))))
+
+
+
+(defun org-drill-entry-leech-p ()
+ "Is the current entry a 'leech item'?"
+ (and (org-drill-entry-p)
+ (member "leech" (org-get-local-tags))))
+
+
+;; (defun org-drill-entry-due-p ()
+;; (cond
+;; (*org-drill-cram-mode*
+;; (let ((hours (org-drill-hours-since-last-review)))
+;; (and (org-drill-entry-p)
+;; (or (null hours)
+;; (>= hours org-drill-cram-hours)))))
+;; (t
+;; (let ((item-time (org-get-scheduled-time (point))))
+;; (and (org-drill-entry-p)
+;; (or (not (eql 'skip org-drill-leech-method))
+;; (not (org-drill-entry-leech-p)))
+;; (or (null item-time) ; not scheduled
+;; (not (minusp ; scheduled for today/in past
+;; (- (time-to-days (current-time))
+;; (time-to-days item-time))))))))))
+
+
+(defun org-drill-entry-days-overdue ()
+ "Returns:
+- NIL if the item is not to be regarded as scheduled for review at all.
+ This is the case if it is not a drill item, or if it is a leech item
+ that we wish to skip, or if we are in cram mode and have already reviewed
+ the item within the last few hours.
+- 0 if the item is new, or if it scheduled for review today.
+- A negative integer - item is scheduled that many days in the future.
+- A positive integer - item is scheduled that many days in the past."
+ (cond
+ (*org-drill-cram-mode*
+ (let ((hours (org-drill-hours-since-last-review)))
+ (and (org-drill-entry-p)
+ (or (null hours)
+ (>= hours org-drill-cram-hours))
+ 0)))
+ (t
+ (let ((item-time (org-get-scheduled-time (point))))
+ (cond
+ ((or (not (org-drill-entry-p))
+ (and (eql 'skip org-drill-leech-method)
+ (org-drill-entry-leech-p)))
+ nil)
+ ((null item-time) ; not scheduled -> due now
+ 0)
+ (t
+ (- (time-to-days (current-time))
+ (time-to-days item-time))))))))
+
+
+(defun org-drill-entry-overdue-p (&optional days-overdue last-interval)
+ "Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past,
+and whose last inter-repetition interval was LAST-INTERVAL, should be
+considered 'overdue'. If the arguments are not given they are extracted
+from the entry at point."
+ (unless days-overdue
+ (setq days-overdue (org-drill-entry-days-overdue)))
+ (unless last-interval
+ (setq last-interval (org-drill-entry-last-interval 1)))
+ (and (numberp days-overdue)
+ (> days-overdue 1) ; enforce a sane minimum 'overdue' gap
+ ;;(> due org-drill-days-before-overdue)
+ (> (/ (+ days-overdue last-interval 1.0) last-interval)
+ org-drill-overdue-interval-factor)))
+
+
+
+(defun org-drill-entry-due-p ()
+ (let ((due (org-drill-entry-days-overdue)))
+ (and (not (null due))
+ (not (minusp due)))))
+
+
+(defun org-drill-entry-new-p ()
+ (and (org-drill-entry-p)
+ (let ((item-time (org-get-scheduled-time (point))))
+ (null item-time))))
+
+
+(defun org-drill-entry-last-quality (&optional default)
+ (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
+ (if quality
+ (string-to-number quality)
+ default)))
+
+
+(defun org-drill-entry-failure-count ()
+ (let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT")))
+ (if quality
+ (string-to-number quality)
+ 0)))
+
+
+(defun org-drill-entry-average-quality (&optional default)
+ (let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY")))
+ (if val
+ (string-to-number val)
+ (or default nil))))
+
+(defun org-drill-entry-last-interval (&optional default)
+ (let ((val (org-entry-get (point) "DRILL_LAST_INTERVAL")))
+ (if val
+ (string-to-number val)
+ (or default 0))))
+
+(defun org-drill-entry-repeats-since-fail (&optional default)
+ (let ((val (org-entry-get (point) "DRILL_REPEATS_SINCE_FAIL")))
+ (if val
+ (string-to-number val)
+ (or default 0))))
+
+(defun org-drill-entry-total-repeats (&optional default)
+ (let ((val (org-entry-get (point) "DRILL_TOTAL_REPEATS")))
+ (if val
+ (string-to-number val)
+ (or default 0))))
+
+(defun org-drill-entry-ease (&optional default)
+ (let ((val (org-entry-get (point) "DRILL_EASE")))
+ (if val
+ (string-to-number val)
+ default)))
+
+
+;;; From http://www.supermemo.com/english/ol/sm5.htm
+(defun org-drill-random-dispersal-factor ()
+ "Returns a random number between 0.5 and 1.5."
+ (let ((a 0.047)
+ (b 0.092)
+ (p (- (random* 1.0) 0.5)))
+ (flet ((sign (n)
+ (cond ((zerop n) 0)
+ ((plusp n) 1)
+ (t -1))))
+ (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
+ (sign p)))
+ 100.0))))
+
+(defun pseudonormal (mean variation)
+ "Random numbers in a pseudo-normal distribution with mean MEAN, range
+ MEAN-VARIATION to MEAN+VARIATION"
+ (+ (random* variation)
+ (random* variation)
+ (- variation)
+ mean))
+
+
+(defun org-drill-early-interval-factor (optimal-factor
+ optimal-interval
+ days-ahead)
+ "Arguments:
+- OPTIMAL-FACTOR: interval-factor if the item had been tested
+exactly when it was supposed to be.
+- OPTIMAL-INTERVAL: interval for next repetition (days) if the item had been
+tested exactly when it was supposed to be.
+- DAYS-AHEAD: how many days ahead of time the item was reviewed.
+
+Returns an adjusted optimal factor which should be used to
+calculate the next interval, instead of the optimal factor found
+in the matrix."
+ (let ((delta-ofmax (* (1- optimal-factor)
+ (/ (+ optimal-interval
+ (* 0.6 optimal-interval) -1) (1- optimal-interval)))))
+ (- optimal-factor
+ (* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval)))))))
+
+
+(defun org-drill-get-item-data ()
+ "Returns a list of 6 items, containing all the stored recall
+ data for the item at point:
+- LAST-INTERVAL is the interval in days that was used to schedule the item's
+ current review date.
+- REPEATS is the number of items the item has been successfully recalled without
+ without any failures. It is reset to 0 upon failure to recall the item.
+- FAILURES is the total number of times the user has failed to recall the item.
+- TOTAL-REPEATS includes both successful and unsuccessful repetitions.
+- AVERAGE-QUALITY is the mean quality of recall of the item over
+ all its repetitions, successful and unsuccessful.
+- EASE is a number reflecting how easy the item is to learn. Higher is easier.
+"
+ (let ((learn-str (org-entry-get (point) "LEARN_DATA"))
+ (repeats (org-drill-entry-total-repeats :missing)))
+ (cond
+ (learn-str
+ (let ((learn-data (or (and learn-str
+ (read learn-str))
+ (copy-list initial-repetition-state))))
+ (list (nth 0 learn-data) ; last interval
+ (nth 1 learn-data) ; repetitions
+ (org-drill-entry-failure-count)
+ (nth 1 learn-data)
+ (org-drill-entry-last-quality)
+ (nth 2 learn-data) ; EF
+ )))
+ ((not (eql :missing repeats))
+ (list (org-drill-entry-last-interval)
+ (org-drill-entry-repeats-since-fail)
+ (org-drill-entry-failure-count)
+ (org-drill-entry-total-repeats)
+ (org-drill-entry-average-quality)
+ (org-drill-entry-ease)))
+ (t ; virgin item
+ (list 0 0 0 0 nil nil)))))
+
+
+(defun org-drill-store-item-data (last-interval repeats failures
+ total-repeats meanq
+ ease)
+ "Stores the given data in the item at point."
+ (org-entry-delete (point) "LEARN_DATA")
+ (org-set-property "DRILL_LAST_INTERVAL"
+ (number-to-string (round-float last-interval 4)))
+ (org-set-property "DRILL_REPEATS_SINCE_FAIL" (number-to-string repeats))
+ (org-set-property "DRILL_TOTAL_REPEATS" (number-to-string total-repeats))
+ (org-set-property "DRILL_FAILURE_COUNT" (number-to-string failures))
+ (org-set-property "DRILL_AVERAGE_QUALITY"
+ (number-to-string (round-float meanq 3)))
+ (org-set-property "DRILL_EASE"
+ (number-to-string (round-float ease 3))))
+
+
+
+;;; SM2 Algorithm =============================================================
+
+
+(defun determine-next-interval-sm2 (last-interval n ef quality
+ failures meanq total-repeats)
+ "Arguments:
+- LAST-INTERVAL -- the number of days since the item was last reviewed.
+- REPEATS -- the number of times the item has been successfully reviewed
+- EF -- the 'easiness factor'
+- QUALITY -- 0 to 5
+
+Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), where:
+- INTERVAL is the number of days until the item should next be reviewed
+- REPEATS is incremented by 1.
+- EF is modified based on the recall quality for the item.
+- OF-MATRIX is not modified."
+ (assert (> n 0))
+ (assert (and (>= quality 0) (<= quality 5)))
+ (if (<= quality org-drill-failure-quality)
+ ;; When an item is failed, its interval is reset to 0,
+ ;; but its EF is unchanged
+ (list -1 1 ef (1+ failures) meanq (1+ total-repeats)
+ org-drill-optimal-factor-matrix)
+ ;; else:
+ (let* ((next-ef (modify-e-factor ef quality))
+ (interval
+ (cond
+ ((<= n 1) 1)
+ ((= n 2)
+ (cond
+ (org-drill-add-random-noise-to-intervals-p
+ (case quality
+ (5 6)
+ (4 4)
+ (3 3)
+ (2 1)
+ (t -1)))
+ (t 6)))
+ (t (* last-interval next-ef)))))
+ (list (if org-drill-add-random-noise-to-intervals-p
+ (+ last-interval (* (- interval last-interval)
+ (org-drill-random-dispersal-factor)))
+ interval)
+ (1+ n)
+ next-ef
+ failures meanq (1+ total-repeats)
+ org-drill-optimal-factor-matrix))))
+
+
+;;; SM5 Algorithm =============================================================
+
+
+
+(defun initial-optimal-factor-sm5 (n ef)
+ (if (= 1 n)
+ org-drill-sm5-initial-interval
+ ef))
+
+(defun get-optimal-factor-sm5 (n ef of-matrix)
+ (let ((factors (assoc n of-matrix)))
+ (or (and factors
+ (let ((ef-of (assoc ef (cdr factors))))
+ (and ef-of (cdr ef-of))))
+ (initial-optimal-factor-sm5 n ef))))
+
+
+(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
+ (let ((of (get-optimal-factor-sm5 n ef (or of-matrix
+ org-drill-optimal-factor-matrix))))
+ (if (= 1 n)
+ of
+ (* of last-interval))))
+
+
+(defun determine-next-interval-sm5 (last-interval n ef quality
+ failures meanq total-repeats
+ of-matrix &optional delta-days)
+ (if (zerop n) (setq n 1))
+ (if (null ef) (setq ef 2.5))
+ (assert (> n 0))
+ (assert (and (>= quality 0) (<= quality 5)))
+ (unless of-matrix
+ (setq of-matrix org-drill-optimal-factor-matrix))
+ (setq of-matrix (cl-copy-tree of-matrix))
+
+ (setq meanq (if meanq
+ (/ (+ quality (* meanq total-repeats 1.0))
+ (1+ total-repeats))
+ quality))
+
+ (let ((next-ef (modify-e-factor ef quality))
+ (old-ef ef)
+ (new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix)
+ quality org-drill-learn-fraction))
+ (interval nil))
+ (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ delta-days (minusp delta-days))
+ (setq new-of (org-drill-early-interval-factor
+ (get-optimal-factor-sm5 n ef of-matrix)
+ (inter-repetition-interval-sm5
+ last-interval n ef of-matrix)
+ delta-days)))
+
+ (setq of-matrix
+ (set-optimal-factor n next-ef of-matrix
+ (round-float new-of 3))) ; round OF to 3 d.p.
+
+ (setq ef next-ef)
+
+ (cond
+ ;; "Failed" -- reset repetitions to 0,
+ ((<= quality org-drill-failure-quality)
+ (list -1 1 old-ef (1+ failures) meanq (1+ total-repeats)
+ of-matrix)) ; Not clear if OF matrix is supposed to be
+ ; preserved
+ ;; For a zero-based quality of 4 or 5, don't repeat
+ ;; ((and (>= quality 4)
+ ;; (not org-learn-always-reschedule))
+ ;; (list 0 (1+ n) ef failures meanq
+ ;; (1+ total-repeats) of-matrix)) ; 0 interval = unschedule
+ (t
+ (setq interval (inter-repetition-interval-sm5
+ last-interval n ef of-matrix))
+ (if org-drill-add-random-noise-to-intervals-p
+ (setq interval (* interval (org-drill-random-dispersal-factor))))
+ (list interval
+ (1+ n)
+ ef
+ failures
+ meanq
+ (1+ total-repeats)
+ of-matrix)))))
+
+
+;;; Simple8 Algorithm =========================================================
+
+
+(defun org-drill-simple8-first-interval (failures)
+ "Arguments:
+- FAILURES: integer >= 0. The total number of times the item has
+ been forgotten, ever.
+
+Returns the optimal FIRST interval for an item which has previously been
+forgotten on FAILURES occasions."
+ (* 2.4849 (exp (* -0.057 failures))))
+
+
+(defun org-drill-simple8-interval-factor (ease repetition)
+ "Arguments:
+- EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm.
+- REPETITION: the number of times the item has been tested.
+1 is the first repetition (ie the second trial).
+Returns:
+The factor by which the last interval should be
+multiplied to give the next interval. Corresponds to `RF' or `OF'."
+ (+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2)))))
+
+
+(defun org-drill-simple8-quality->ease (quality)
+ "Returns the ease (`AF' in the SM8 algorithm) which corresponds
+to a mean item quality of QUALITY."
+ (+ (* 0.0542 (expt quality 4))
+ (* -0.4848 (expt quality 3))
+ (* 1.4916 (expt quality 2))
+ (* -1.2403 quality)
+ 1.4515))
+
+
+(defun determine-next-interval-simple8 (last-interval repeats quality
+ failures meanq totaln
+ &optional delta-days)
+ "Arguments:
+- LAST-INTERVAL -- the number of days since the item was last reviewed.
+- REPEATS -- the number of times the item has been successfully reviewed
+- EASE -- the 'easiness factor'
+- QUALITY -- 0 to 5
+- DELTA-DAYS -- how many days overdue was the item when it was reviewed.
+ 0 = reviewed on the scheduled day. +N = N days overdue.
+ -N = reviewed N days early.
+
+Returns the new item data, as a list of 6 values:
+- NEXT-INTERVAL
+- REPEATS
+- EASE
+- FAILURES
+- AVERAGE-QUALITY
+- TOTAL-REPEATS.
+See the documentation for `org-drill-get-item-data' for a description of these."
+ (assert (>= repeats 0))
+ (assert (and (>= quality 0) (<= quality 5)))
+ (assert (or (null meanq) (and (>= meanq 0) (<= meanq 5))))
+ (let ((next-interval nil))
+ (setf meanq (if meanq
+ (/ (+ quality (* meanq totaln 1.0)) (1+ totaln))
+ quality))
+ (cond
+ ((<= quality org-drill-failure-quality)
+ (incf failures)
+ (setf repeats 0
+ next-interval -1))
+ ((or (zerop repeats)
+ (zerop last-interval))
+ (setf next-interval (org-drill-simple8-first-interval failures))
+ (incf repeats)
+ (incf totaln))
+ (t
+ (let* ((use-n
+ (if (and
+ org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ (numberp delta-days) (plusp delta-days)
+ (plusp last-interval))
+ (+ repeats (min 1 (/ delta-days last-interval 1.0)))
+ repeats))
+ (factor (org-drill-simple8-interval-factor
+ (org-drill-simple8-quality->ease meanq) use-n))
+ (next-int (* last-interval factor)))
+ (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
+ (numberp delta-days) (minusp delta-days))
+ ;; The item was reviewed earlier than scheduled.
+ (setf factor (org-drill-early-interval-factor
+ factor next-int (abs delta-days))
+ next-int (* last-interval factor)))
+ (setf next-interval next-int)
+ (incf repeats)
+ (incf totaln))))
+ (list
+ (if (and org-drill-add-random-noise-to-intervals-p
+ (plusp next-interval))
+ (* next-interval (org-drill-random-dispersal-factor))
+ next-interval)
+ repeats
+ (org-drill-simple8-quality->ease meanq)
+ failures
+ meanq
+ totaln
+ )))
+
+
+
+
+;;; Essentially copied from `org-learn.el', but modified to
+;;; optionally call the SM2 or simple8 functions.
+(defun org-drill-smart-reschedule (quality &optional days-ahead)
+ "If DAYS-AHEAD is supplied it must be a positive integer. The
+item will be scheduled exactly this many days into the future."
+ (let ((delta-days (- (time-to-days (current-time))
+ (time-to-days (or (org-get-scheduled-time (point))
+ (current-time)))))
+ (ofmatrix org-drill-optimal-factor-matrix)
+ ;; Entries can have weights, 1 by default. Intervals are divided by the
+ ;; item's weight, so an item with a weight of 2 will have all intervals
+ ;; halved, meaning you will end up reviewing it twice as often.
+ ;; Useful for entries which randomly present any of several facts.
+ (weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
+ (if (stringp weight)
+ (setq weight (read weight)))
+ (destructuring-bind (last-interval repetitions failures
+ total-repeats meanq ease)
+ (org-drill-get-item-data)
+ (destructuring-bind (next-interval repetitions ease
+ failures meanq total-repeats
+ &optional new-ofmatrix)
+ (case org-drill-spaced-repetition-algorithm
+ (sm5 (determine-next-interval-sm5 last-interval repetitions
+ ease quality failures
+ meanq total-repeats ofmatrix))
+ (sm2 (determine-next-interval-sm2 last-interval repetitions
+ ease quality failures
+ meanq total-repeats))
+ (simple8 (determine-next-interval-simple8 last-interval repetitions
+ quality failures meanq
+ total-repeats
+ delta-days)))
+ (if (numberp days-ahead)
+ (setq next-interval days-ahead))
+
+ (if (and (null days-ahead)
+ (numberp weight) (plusp weight)
+ (not (minusp next-interval)))
+ (setq next-interval
+ (max 1.0 (+ last-interval
+ (/ (- next-interval last-interval) weight)))))
+
+ (org-drill-store-item-data next-interval repetitions failures
+ total-repeats meanq ease)
+
+ (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
+ (setq org-drill-optimal-factor-matrix new-ofmatrix))
+
+ (cond
+ ((= 0 days-ahead)
+ (org-schedule t))
+ ((minusp days-ahead)
+ (org-schedule nil (current-time)))
+ (t
+ (org-schedule nil (time-add (current-time)
+ (days-to-time
+ (round next-interval))))))))))
+
+
+(defun org-drill-hypothetical-next-review-date (quality)
+ "Returns an integer representing the number of days into the future
+that the current item would be scheduled, based on a recall quality
+of QUALITY."
+ (let ((weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
+ (destructuring-bind (last-interval repetitions failures
+ total-repeats meanq ease)
+ (org-drill-get-item-data)
+ (if (stringp weight)
+ (setq weight (read weight)))
+ (destructuring-bind (next-interval repetitions ease
+ failures meanq total-repeats
+ &optional ofmatrix)
+ (case org-drill-spaced-repetition-algorithm
+ (sm5 (determine-next-interval-sm5 last-interval repetitions
+ ease quality failures
+ meanq total-repeats
+ org-drill-optimal-factor-matrix))
+ (sm2 (determine-next-interval-sm2 last-interval repetitions
+ ease quality failures
+ meanq total-repeats))
+ (simple8 (determine-next-interval-simple8 last-interval repetitions
+ quality failures meanq
+ total-repeats)))
+ (cond
+ ((not (plusp next-interval))
+ 0)
+ ((and (numberp weight) (plusp weight))
+ (+ last-interval
+ (max 1.0 (/ (- next-interval last-interval) weight))))
+ (t
+ next-interval))))))
+
+
+(defun org-drill-hypothetical-next-review-dates ()
+ (let ((intervals nil))
+ (dotimes (q 6)
+ (push (max (or (car intervals) 0)
+ (org-drill-hypothetical-next-review-date q))
+ intervals))
+ (reverse intervals)))
+
+
+(defun org-drill-reschedule ()
+ "Returns quality rating (0-5), or nil if the user quit."
+ (let ((ch nil)
+ (input nil)
+ (next-review-dates (org-drill-hypothetical-next-review-dates)))
+ (save-excursion
+ (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
+ (setq input (read-key-sequence
+ (if (eq ch ??)
+ (format "0-2 Means you have forgotten the item.
+3-5 Means you have remembered the item.
+
+0 - Completely forgot.
+1 - Even after seeing the answer, it still took a bit to sink in.
+2 - After seeing the answer, you remembered it.
+3 - It took you awhile, but you finally remembered. (+%s days)
+4 - After a little bit of thought you remembered. (+%s days)
+5 - You remembered the item really easily. (+%s days)
+
+How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
+ (round (nth 3 next-review-dates))
+ (round (nth 4 next-review-dates))
+ (round (nth 5 next-review-dates)))
+ "How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)")))
+ (cond
+ ((stringp input)
+ (setq ch (elt input 0)))
+ ((and (vectorp input) (symbolp (elt input 0)))
+ (case (elt input 0)
+ (up (ignore-errors (forward-line -1)))
+ (down (ignore-errors (forward-line 1)))
+ (left (ignore-errors (backward-char)))
+ (right (ignore-errors (forward-char)))
+ (prior (ignore-errors (scroll-down))) ; pgup
+ (next (ignore-errors (scroll-up))))) ; pgdn
+ ((and (vectorp input) (listp (elt input 0))
+ (eventp (elt input 0)))
+ (case (car (elt input 0))
+ (wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
+ (wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
+ (if (eql ch ?t)
+ (org-set-tags-command))))
+ (cond
+ ((and (>= ch ?0) (<= ch ?5))
+ (let ((quality (- ch ?0))
+ (failures (org-drill-entry-failure-count)))
+ (save-excursion
+ (org-drill-smart-reschedule quality
+ (nth quality next-review-dates)))
+ (push quality *org-drill-session-qualities*)
+ (cond
+ ((<= quality org-drill-failure-quality)
+ (when org-drill-leech-failure-threshold
+ ;;(setq failures (if failures (string-to-number failures) 0))
+ ;; (org-set-property "DRILL_FAILURE_COUNT"
+ ;; (format "%d" (1+ failures)))
+ (if (> (1+ failures) org-drill-leech-failure-threshold)
+ (org-toggle-tag "leech" 'on))))
+ (t
+ (let ((scheduled-time (org-get-scheduled-time (point))))
+ (when scheduled-time
+ (message "Next review in %d days"
+ (- (time-to-days scheduled-time)
+ (time-to-days (current-time))))
+ (sit-for 0.5)))))
+ (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
+ (org-set-property "DRILL_LAST_REVIEWED"
+ (time-to-inactive-org-timestamp (current-time)))
+ quality))
+ ((= ch ?e)
+ 'edit)
+ (t
+ nil))))
+
+
+;; (defun org-drill-hide-all-subheadings-except (heading-list)
+;; "Returns a list containing the position of each immediate subheading of
+;; the current topic."
+;; (let ((drill-entry-level (org-current-level))
+;; (drill-sections nil)
+;; (drill-heading nil))
+;; (org-show-subtree)
+;; (save-excursion
+;; (org-map-entries
+;; (lambda ()
+;; (when (and (not (outline-invisible-p))
+;; (> (org-current-level) drill-entry-level))
+;; (setq drill-heading (org-get-heading t))
+;; (unless (and (= (org-current-level) (1+ drill-entry-level))
+;; (member drill-heading heading-list))
+;; (hide-subtree))
+;; (push (point) drill-sections)))
+;; "" 'tree))
+;; (reverse drill-sections)))
+
+
+
+(defun org-drill-hide-subheadings-if (test)
+ "TEST is a function taking no arguments. TEST will be called for each
+of the immediate subheadings of the current drill item, with the point
+on the relevant subheading. TEST should return nil if the subheading is
+to be revealed, non-nil if it is to be hidden.
+Returns a list containing the position of each immediate subheading of
+the current topic."
+ (let ((drill-entry-level (org-current-level))
+ (drill-sections nil))
+ (org-show-subtree)
+ (save-excursion
+ (org-map-entries
+ (lambda ()
+ (when (and (not (outline-invisible-p))
+ (> (org-current-level) drill-entry-level))
+ (when (or (/= (org-current-level) (1+ drill-entry-level))
+ (funcall test))
+ (hide-subtree))
+ (push (point) drill-sections)))
+ "" 'tree))
+ (reverse drill-sections)))
+
+
+(defun org-drill-hide-all-subheadings-except (heading-list)
+ (org-drill-hide-subheadings-if
+ (lambda () (let ((drill-heading (org-get-heading t)))
+ (not (member drill-heading heading-list))))))
+
+
+(defun org-drill-presentation-prompt (&rest fmt-and-args)
+ (let* ((item-start-time (current-time))
+ (input nil)
+ (ch nil)
+ (last-second 0)
+ (mature-entry-count (+ (length *org-drill-young-mature-entries*)
+ (length *org-drill-old-mature-entries*)
+ (length *org-drill-overdue-entries*)))
+ (status (first (org-drill-entry-status)))
+ (prompt
+ (if fmt-and-args
+ (apply 'format
+ (first fmt-and-args)
+ (rest fmt-and-args))
+ (concat "Press key for answer, "
+ "e=edit, t=tags, s=skip, q=quit."))))
+ (setq prompt
+ (format "%s %s %s %s %s %s"
+ (propertize
+ (char-to-string
+ (case status
+ (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
+ (:failed ?F) (t ??)))
+ 'face `(:foreground
+ ,(case status
+ (:new org-drill-new-count-color)
+ ((:young :old) org-drill-mature-count-color)
+ ((:overdue :failed) org-drill-failed-count-color)
+ (t org-drill-done-count-color))))
+ (propertize
+ (number-to-string (length *org-drill-done-entries*))
+ 'face `(:foreground ,org-drill-done-count-color)
+ 'help-echo "The number of items you have reviewed this session.")
+ (propertize
+ (number-to-string (+ (length *org-drill-again-entries*)
+ (length *org-drill-failed-entries*)))
+ 'face `(:foreground ,org-drill-failed-count-color)
+ 'help-echo (concat "The number of items that you failed, "
+ "and need to review again."))
+ (propertize
+ (number-to-string mature-entry-count)
+ 'face `(:foreground ,org-drill-mature-count-color)
+ 'help-echo "The number of old items due for review.")
+ (propertize
+ (number-to-string (length *org-drill-new-entries*))
+ 'face `(:foreground ,org-drill-new-count-color)
+ 'help-echo (concat "The number of new items that you "
+ "have never reviewed."))
+ prompt))
+ (if (and (eql 'warn org-drill-leech-method)
+ (org-drill-entry-leech-p))
+ (setq prompt (concat
+ (propertize "!!! LEECH ITEM !!!
+You seem to be having a lot of trouble memorising this item.
+Consider reformulating the item to make it easier to remember.\n"
+ 'face '(:foreground "red"))
+ prompt)))
+ (while (memq ch '(nil ?t))
+ (setq ch nil)
+ (while (not (input-pending-p))
+ (let ((elapsed (time-subtract (current-time) item-start-time)))
+ (message (concat (if (>= (time-to-seconds elapsed) (* 60 60))
+ "++:++ "
+ (format-time-string "%M:%S " elapsed))
+ prompt))
+ (sit-for 1)))
+ (setq input (read-key-sequence nil))
+ (if (stringp input) (setq ch (elt input 0)))
+ (if (eql ch ?t)
+ (org-set-tags-command)))
+ (case ch
+ (?q nil)
+ (?e 'edit)
+ (?s 'skip)
+ (otherwise t))))
+
+
+(defun org-pos-in-regexp (pos regexp &optional nlines)
+ (save-excursion
+ (goto-char pos)
+ (org-in-regexp regexp nlines)))
+
+
+(defun org-drill-hide-region (beg end &optional text)
+ "Hide the buffer region between BEG and END with an 'invisible text'
+visual overlay, or with the string TEXT if it is supplied."
+ (let ((ovl (make-overlay beg end)))
+ (overlay-put ovl 'category
+ 'org-drill-hidden-text-overlay)
+ (when (stringp text)
+ (overlay-put ovl 'invisible nil)
+ (overlay-put ovl 'face 'default)
+ (overlay-put ovl 'display text))))
+
+
+(defun org-drill-hide-heading-at-point (&optional text)
+ (unless (org-at-heading-p)
+ (error "Point is not on a heading"))
+ (save-excursion
+ (let ((beg (point)))
+ (end-of-line)
+ (org-drill-hide-region beg (point) text))))
+
+
+(defun org-drill-hide-comments ()
+ (save-excursion
+ (while (re-search-forward "^#.*$" nil t)
+ (org-drill-hide-region (match-beginning 0) (match-end 0)))))
+
+
+(defun org-drill-unhide-text ()
+ ;; This will also unhide the item's heading.
+ (save-excursion
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category))
+ (delete-overlay ovl)))))
+
+
+(defun org-drill-hide-clozed-text ()
+ (save-excursion
+ (while (re-search-forward org-drill-cloze-regexp nil t)
+ ;; Don't hide org links, partly because they might contain inline
+ ;; images which we want to keep visible
+ (unless (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))
+ (org-drill-hide-matched-cloze-text)))))
+
+
+(defun org-drill-hide-matched-cloze-text ()
+ "Hide the current match with a 'cloze' visual overlay."
+ (let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
+ (overlay-put ovl 'category
+ 'org-drill-cloze-overlay-defaults)
+ (when (find ?| (match-string 0))
+ (let ((hint (substring-no-properties
+ (match-string 0)
+ (1+ (position ?| (match-string 0)))
+ (1- (length (match-string 0))))))
+ (overlay-put
+ ovl 'display
+ ;; If hint is like `X...' then display [X...]
+ ;; otherwise display [...X]
+ (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]")
+ hint))))))
+
+
+(defun org-drill-hide-cloze-hints ()
+ (save-excursion
+ (while (re-search-forward org-drill-cloze-regexp nil t)
+ (unless (or (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))
+ (null (match-beginning 2))) ; hint subexpression matched
+ (org-drill-hide-region (match-beginning 2) (match-end 2))))))
+
+
+(defmacro with-replaced-entry-text (text &rest body)
+ "During the execution of BODY, the entire text of the current entry is
+concealed by an overlay that displays the string TEXT."
+ `(progn
+ (org-drill-replace-entry-text ,text)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unreplace-entry-text))))
+
+
+(defmacro with-replaced-entry-text-multi (replacements &rest body)
+ "During the execution of BODY, the entire text of the current entry is
+concealed by an overlay that displays the overlays in REPLACEMENTS."
+ `(progn
+ (org-drill-replace-entry-text ,replacements t)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unreplace-entry-text))))
+
+
+(defun org-drill-replace-entry-text (text &optional multi-p)
+ "Make an overlay that conceals the entire text of the item, not
+including properties or the contents of subheadings. The overlay shows
+the string TEXT.
+If MULTI-P is non-nil, TEXT must be a list of values which are legal
+for the `display' text property. The text of the item will be temporarily
+replaced by all of these items, in the order in which they appear in
+the list.
+Note: does not actually alter the item."
+ (cond
+ ((and multi-p
+ (listp text))
+ (org-drill-replace-entry-text-multi text))
+ (t
+ (let ((ovl (make-overlay (point-min)
+ (save-excursion
+ (outline-next-heading)
+ (point)))))
+ (overlay-put ovl 'category
+ 'org-drill-replaced-text-overlay)
+ (overlay-put ovl 'display text)))))
+
+
+(defun org-drill-unreplace-entry-text ()
+ (save-excursion
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category))
+ (delete-overlay ovl)))))
+
+
+(defun org-drill-replace-entry-text-multi (replacements)
+ "Make overlays that conceal the entire text of the item, not
+including properties or the contents of subheadings. The overlay shows
+the string TEXT.
+Note: does not actually alter the item."
+ (let ((ovl nil)
+ (p-min (point-min))
+ (p-max (save-excursion
+ (outline-next-heading)
+ (point))))
+ (assert (>= (- p-max p-min) (length replacements)))
+ (dotimes (i (length replacements))
+ (setq ovl (make-overlay (+ p-min (* 2 i))
+ (if (= i (1- (length replacements)))
+ p-max
+ (+ p-min (* 2 i) 1))))
+ (overlay-put ovl 'category
+ 'org-drill-replaced-text-overlay)
+ (overlay-put ovl 'display (nth i replacements)))))
+
+
+(defmacro with-replaced-entry-heading (heading &rest body)
+ `(progn
+ (org-drill-replace-entry-heading ,heading)
+ (unwind-protect
+ (progn
+ ,@body)
+ (org-drill-unhide-text))))
+
+
+(defun org-drill-replace-entry-heading (heading)
+ "Make an overlay that conceals the heading of the item. The overlay shows
+the string TEXT.
+Note: does not actually alter the item."
+ (org-drill-hide-heading-at-point heading))
+
+
+(defun org-drill-unhide-clozed-text ()
+ (save-excursion
+ (dolist (ovl (overlays-in (point-min) (point-max)))
+ (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
+ (delete-overlay ovl)))))
+
+
+(defun org-drill-get-entry-text (&optional keep-properties-p)
+ (let ((text (org-agenda-get-some-entry-text (point-marker) 100)))
+ (if keep-properties-p
+ text
+ (substring-no-properties text))))
+
+
+(defun org-drill-entry-empty-p ()
+ (zerop (length (org-drill-get-entry-text))))
+
+
+
+;;; Presentation functions ====================================================
+
+;; Each of these is called with point on topic heading. Each needs to show the
+;; topic in the form of a 'question' or with some information 'hidden', as
+;; appropriate for the card type. The user should then be prompted to press a
+;; key. The function should then reveal either the 'answer' or the entire
+;; topic, and should return t if the user chose to see the answer and rate their
+;; recall, nil if they chose to quit.
+
+(defun org-drill-present-simple-card ()
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (with-hidden-cloze-text
+ (org-drill-hide-all-subheadings-except nil)
+ (ignore-errors
+ (org-display-inline-images t))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p))))))
+
+
+(defun org-drill-present-default-answer (reschedule-fn)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)
+ (org-drill-unhide-clozed-text)
+ (ignore-errors
+ (org-display-inline-images t))
+ (with-hidden-cloze-hints
+ (funcall reschedule-fn)))
+
+
+(defun org-drill-present-two-sided-card ()
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (with-hidden-cloze-text
+ (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
+ (when drill-sections
+ (save-excursion
+ (goto-char (nth (random* (min 2 (length drill-sections)))
+ drill-sections))
+ (org-show-subtree)))
+ (ignore-errors
+ (org-display-inline-images t))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
+
+
+(defun org-drill-present-multi-sided-card ()
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (with-hidden-cloze-text
+ (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
+ (when drill-sections
+ (save-excursion
+ (goto-char (nth (random* (length drill-sections)) drill-sections))
+ (org-show-subtree)))
+ (ignore-errors
+ (org-display-inline-images t))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
+
+(defun org-drill-present-multicloze-hide-n (number-to-hide
+ &optional
+ force-show-first
+ force-show-last
+ force-hide-first)
+ "Hides NUMBER-TO-HIDE pieces of text that are marked for cloze deletion,
+chosen at random.
+If NUMBER-TO-HIDE is negative, show only (ABS NUMBER-TO-HIDE) pieces,
+hiding all the rest.
+If FORCE-HIDE-FIRST is non-nil, force the first piece of text to be one of
+the hidden items.
+If FORCE-SHOW-FIRST is non-nil, never hide the first piece of text.
+If FORCE-SHOW-LAST is non-nil, never hide the last piece of text.
+If the number of text pieces in the item is less than
+NUMBER-TO-HIDE, then all text pieces will be hidden (except the first or last
+items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (let ((item-end nil)
+ (match-count 0)
+ (body-start (or (cdr (org-get-property-block))
+ (point))))
+ (if (and force-hide-first force-show-first)
+ (error "FORCE-HIDE-FIRST and FORCE-SHOW-FIRST are mutually exclusive"))
+ (org-drill-hide-all-subheadings-except nil)
+ (save-excursion
+ (outline-next-heading)
+ (setq item-end (point)))
+ (save-excursion
+ (goto-char body-start)
+ (while (re-search-forward org-drill-cloze-regexp item-end t)
+ (let ((in-regexp? (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))))
+ (unless in-regexp?
+ (incf match-count)))))
+ (if (minusp number-to-hide)
+ (setq number-to-hide (+ match-count number-to-hide)))
+ (when (plusp match-count)
+ (let* ((positions (shuffle-list (loop for i from 1
+ to match-count
+ collect i)))
+ (match-nums nil)
+ (cnt nil))
+ (if force-hide-first
+ ;; Force '1' to be in the list, and to be the first item
+ ;; in the list.
+ (setq positions (cons 1 (remove 1 positions))))
+ (if force-show-first
+ (setq positions (remove 1 positions)))
+ (if force-show-last
+ (setq positions (remove match-count positions)))
+ (setq match-nums
+ (subseq positions
+ 0 (min number-to-hide (length positions))))
+ ;; (dolist (pos-to-hide match-nums)
+ (save-excursion
+ (goto-char body-start)
+ (setq cnt 0)
+ (while (re-search-forward org-drill-cloze-regexp item-end t)
+ (unless (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))
+ (incf cnt)
+ (if (memq cnt match-nums)
+ (org-drill-hide-matched-cloze-text)))))))
+ ;; (loop
+ ;; do (re-search-forward org-drill-cloze-regexp
+ ;; item-end t pos-to-hide)
+ ;; while (org-pos-in-regexp (match-beginning 0)
+ ;; org-bracket-link-regexp 1))
+ ;; (org-drill-hide-matched-cloze-text)))))
+ (ignore-errors
+ (org-display-inline-images t))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)
+ (org-drill-unhide-clozed-text))))))
+
+
+(defun org-drill-present-multicloze-hide-nth (to-hide)
+ "Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If
+TO-HIDE is negative, count backwards, so -1 means the last item, -2
+the second to last, etc."
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (let ((item-end nil)
+ (match-count 0)
+ (body-start (or (cdr (org-get-property-block))
+ (point)))
+ (cnt 0))
+ (org-drill-hide-all-subheadings-except nil)
+ (save-excursion
+ (outline-next-heading)
+ (setq item-end (point)))
+ (save-excursion
+ (goto-char body-start)
+ (while (re-search-forward org-drill-cloze-regexp item-end t)
+ (let ((in-regexp? (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))))
+ (unless in-regexp?
+ (incf match-count)))))
+ (if (minusp to-hide)
+ (setq to-hide (+ 1 to-hide match-count)))
+ (cond
+ ((or (not (plusp match-count))
+ (> to-hide match-count))
+ nil)
+ (t
+ (save-excursion
+ (goto-char body-start)
+ (setq cnt 0)
+ (while (re-search-forward org-drill-cloze-regexp item-end t)
+ (unless (save-match-data
+ (org-pos-in-regexp (match-beginning 0)
+ org-bracket-link-regexp 1))
+ (incf cnt)
+ (if (= cnt to-hide)
+ (org-drill-hide-matched-cloze-text)))))))
+ (ignore-errors
+ (org-display-inline-images t))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)
+ (org-drill-unhide-clozed-text))))))
+
+
+(defun org-drill-present-multicloze-hide1 ()
+ "Hides one of the pieces of text that are marked for cloze deletion,
+chosen at random."
+ (org-drill-present-multicloze-hide-n 1))
+
+
+(defun org-drill-present-multicloze-hide2 ()
+ "Hides two of the pieces of text that are marked for cloze deletion,
+chosen at random."
+ (org-drill-present-multicloze-hide-n 2))
+
+
+(defun org-drill-present-multicloze-hide-first ()
+ "Hides the first piece of text that is marked for cloze deletion."
+ (org-drill-present-multicloze-hide-nth 1))
+
+
+(defun org-drill-present-multicloze-hide-last ()
+ "Hides the last piece of text that is marked for cloze deletion."
+ (org-drill-present-multicloze-hide-nth -1))
+
+
+(defun org-drill-present-multicloze-hide1-firstmore ()
+ "Commonly, hides the FIRST piece of text that is marked for
+cloze deletion. Uncommonly, hide one of the other pieces of text,
+chosen at random.
+
+The definitions of 'commonly' and 'uncommonly' are determined by
+the value of `org-drill-cloze-text-weight'."
+ ;; The 'firstmore' and 'lastmore' functions used to randomly choose whether
+ ;; to hide the 'favoured' piece of text. However even when the chance of
+ ;; hiding it was set quite high (80%), the outcome was too unpredictable over
+ ;; the small number of repetitions where most learning takes place for each
+ ;; item. In other words, the actual frequency during the first 10 repetitions
+ ;; was often very different from 80%. Hence we use modulo instead.
+ (cond
+ ((null org-drill-cloze-text-weight)
+ ;; Behave as hide1cloze
+ (org-drill-present-multicloze-hide1))
+ ((not (and (integerp org-drill-cloze-text-weight)
+ (plusp org-drill-cloze-text-weight)))
+ (error "Illegal value for org-drill-cloze-text-weight: %S"
+ org-drill-cloze-text-weight))
+ ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
+ org-drill-cloze-text-weight))
+ ;; Uncommonly, hide any item except the first
+ (org-drill-present-multicloze-hide-n 1 t))
+ (t
+ ;; Commonly, hide first item
+ (org-drill-present-multicloze-hide-first))))
+
+
+(defun org-drill-present-multicloze-show1-lastmore ()
+ "Commonly, hides all pieces except the last. Uncommonly, shows
+any random piece. The effect is similar to 'show1cloze' except
+that the last item is much less likely to be the item that is
+visible.
+
+The definitions of 'commonly' and 'uncommonly' are determined by
+the value of `org-drill-cloze-text-weight'."
+ (cond
+ ((null org-drill-cloze-text-weight)
+ ;; Behave as show1cloze
+ (org-drill-present-multicloze-show1))
+ ((not (and (integerp org-drill-cloze-text-weight)
+ (plusp org-drill-cloze-text-weight)))
+ (error "Illegal value for org-drill-cloze-text-weight: %S"
+ org-drill-cloze-text-weight))
+ ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
+ org-drill-cloze-text-weight))
+ ;; Uncommonly, show any item except the last
+ (org-drill-present-multicloze-hide-n -1 nil nil t))
+ (t
+ ;; Commonly, show the LAST item
+ (org-drill-present-multicloze-hide-n -1 nil t))))
+
+
+(defun org-drill-present-multicloze-show1-firstless ()
+ "Commonly, hides all pieces except one, where the shown piece
+is guaranteed NOT to be the first piece. Uncommonly, shows any
+random piece. The effect is similar to 'show1cloze' except that
+the first item is much less likely to be the item that is
+visible.
+
+The definitions of 'commonly' and 'uncommonly' are determined by
+the value of `org-drill-cloze-text-weight'."
+ (cond
+ ((null org-drill-cloze-text-weight)
+ ;; Behave as show1cloze
+ (org-drill-present-multicloze-show1))
+ ((not (and (integerp org-drill-cloze-text-weight)
+ (plusp org-drill-cloze-text-weight)))
+ (error "Illegal value for org-drill-cloze-text-weight: %S"
+ org-drill-cloze-text-weight))
+ ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
+ org-drill-cloze-text-weight))
+ ;; Uncommonly, show the first item
+ (org-drill-present-multicloze-hide-n -1 t))
+ (t
+ ;; Commonly, show any item, except the first
+ (org-drill-present-multicloze-hide-n -1 nil nil t))))
+
+
+(defun org-drill-present-multicloze-show1 ()
+ "Similar to `org-drill-present-multicloze-hide1', but hides all
+the pieces of text that are marked for cloze deletion, except for one
+piece which is chosen at random."
+ (org-drill-present-multicloze-hide-n -1))
+
+
+(defun org-drill-present-multicloze-show2 ()
+ "Similar to `org-drill-present-multicloze-show1', but reveals two
+pieces rather than one."
+ (org-drill-present-multicloze-hide-n -2))
+
+
+;; (defun org-drill-present-multicloze-show1 ()
+;; "Similar to `org-drill-present-multicloze-hide1', but hides all
+;; the pieces of text that are marked for cloze deletion, except for one
+;; piece which is chosen at random."
+;; (with-hidden-comments
+;; (with-hidden-cloze-hints
+;; (let ((item-end nil)
+;; (match-count 0)
+;; (body-start (or (cdr (org-get-property-block))
+;; (point))))
+;; (org-drill-hide-all-subheadings-except nil)
+;; (save-excursion
+;; (outline-next-heading)
+;; (setq item-end (point)))
+;; (save-excursion
+;; (goto-char body-start)
+;; (while (re-search-forward org-drill-cloze-regexp item-end t)
+;; (incf match-count)))
+;; (when (plusp match-count)
+;; (let ((match-to-hide (random* match-count)))
+;; (save-excursion
+;; (goto-char body-start)
+;; (dotimes (n match-count)
+;; (re-search-forward org-drill-cloze-regexp
+;; item-end t)
+;; (unless (= n match-to-hide)
+;; (org-drill-hide-matched-cloze-text))))))
+;; (org-display-inline-images t)
+;; (org-cycle-hide-drawers 'all)
+;; (prog1 (org-drill-presentation-prompt)
+;; (org-drill-hide-subheadings-if 'org-drill-entry-p)
+;; (org-drill-unhide-clozed-text))))))
+
+
+(defun org-drill-present-card-using-text (question &optional answer)
+ "Present the string QUESTION as the only visible content of the card."
+ (with-hidden-comments
+ (with-replaced-entry-text
+ question
+ (org-drill-hide-all-subheadings-except nil)
+ (org-cycle-hide-drawers 'all)
+ (ignore-errors
+ (org-display-inline-images t))
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
+
+(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
+ "TEXTS is a list of valid values for the 'display' text property.
+Present these overlays, in sequence, as the only
+visible content of the card."
+ (with-hidden-comments
+ (with-replaced-entry-text-multi
+ replacements
+ (org-drill-hide-all-subheadings-except nil)
+ (org-cycle-hide-drawers 'all)
+ (ignore-errors
+ (org-display-inline-images t))
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
+
+(defun org-drill-entry ()
+ "Present the current topic for interactive review, as in `org-drill'.
+Review will occur regardless of whether the topic is due for review or whether
+it meets the definition of a 'review topic' used by `org-drill'.
+
+Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol
+EDIT if the user chose to exit the drill and edit the current item. Choosing
+the latter option leaves the drill session suspended; it can be resumed
+later using `org-drill-resume'.
+
+See `org-drill' for more details."
+ (interactive)
+ (org-drill-goto-drill-entry-heading)
+ ;;(unless (org-part-of-drill-entry-p)
+ ;; (error "Point is not inside a drill entry"))
+ ;;(unless (org-at-heading-p)
+ ;; (org-back-to-heading))
+ (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
+ (answer-fn 'org-drill-present-default-answer)
+ (cont nil)
+ ;; fontification functions in `outline-view-change-hook' can cause big
+ ;; slowdowns, so we temporarily bind this variable to nil here.
+ (outline-view-change-hook nil))
+ (org-save-outline-visibility t
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-show-subtree)
+ (org-cycle-hide-drawers 'all)
+
+ (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
+ (if (listp presentation-fn)
+ (psetq answer-fn (or (second presentation-fn)
+ 'org-drill-present-default-answer)
+ presentation-fn (first presentation-fn)))
+ (cond
+ ((null presentation-fn)
+ (message "%s:%d: Unrecognised card type '%s', skipping..."
+ (buffer-name) (point) card-type)
+ (sit-for 0.5)
+ 'skip)
+ (t
+ (setq cont (funcall presentation-fn))
+ (cond
+ ((not cont)
+ (message "Quit")
+ nil)
+ ((eql cont 'edit)
+ 'edit)
+ ((eql cont 'skip)
+ 'skip)
+ (t
+ (save-excursion
+ (funcall answer-fn
+ (lambda () (org-drill-reschedule)))))))))))))
+
+
+(defun org-drill-entries-pending-p ()
+ (or *org-drill-again-entries*
+ (and (not (org-drill-maximum-item-count-reached-p))
+ (not (org-drill-maximum-duration-reached-p))
+ (or *org-drill-new-entries*
+ *org-drill-failed-entries*
+ *org-drill-young-mature-entries*
+ *org-drill-old-mature-entries*
+ *org-drill-overdue-entries*
+ *org-drill-again-entries*))))
+
+
+(defun org-drill-pending-entry-count ()
+ (+ (length *org-drill-new-entries*)
+ (length *org-drill-failed-entries*)
+ (length *org-drill-young-mature-entries*)
+ (length *org-drill-old-mature-entries*)
+ (length *org-drill-overdue-entries*)
+ (length *org-drill-again-entries*)))
+
+
+(defun org-drill-maximum-duration-reached-p ()
+ "Returns true if the current drill session has continued past its
+maximum duration."
+ (and org-drill-maximum-duration
+ *org-drill-start-time*
+ (> (- (float-time (current-time)) *org-drill-start-time*)
+ (* org-drill-maximum-duration 60))))
+
+
+(defun org-drill-maximum-item-count-reached-p ()
+ "Returns true if the current drill session has reached the
+maximum number of items."
+ (and org-drill-maximum-items-per-session
+ (>= (length *org-drill-done-entries*)
+ org-drill-maximum-items-per-session)))
+
+
+(defun org-drill-pop-next-pending-entry ()
+ (block org-drill-pop-next-pending-entry
+ (let ((m nil))
+ (while (or (null m)
+ (not (org-drill-entry-p m)))
+ (setq
+ m
+ (cond
+ ;; First priority is items we failed in a prior session.
+ ((and *org-drill-failed-entries*
+ (not (org-drill-maximum-item-count-reached-p))
+ (not (org-drill-maximum-duration-reached-p)))
+ (pop-random *org-drill-failed-entries*))
+ ;; Next priority is overdue items.
+ ((and *org-drill-overdue-entries*
+ (not (org-drill-maximum-item-count-reached-p))
+ (not (org-drill-maximum-duration-reached-p)))
+ ;; We use `pop', not `pop-random', because we have already
+ ;; sorted overdue items into a random order which takes
+ ;; number of days overdue into account.
+ (pop *org-drill-overdue-entries*))
+ ;; Next priority is 'young' items.
+ ((and *org-drill-young-mature-entries*
+ (not (org-drill-maximum-item-count-reached-p))
+ (not (org-drill-maximum-duration-reached-p)))
+ (pop-random *org-drill-young-mature-entries*))
+ ;; Next priority is newly added items, and older entries.
+ ;; We pool these into a single group.
+ ((and (or *org-drill-new-entries*
+ *org-drill-old-mature-entries*)
+ (not (org-drill-maximum-item-count-reached-p))
+ (not (org-drill-maximum-duration-reached-p)))
+ (cond
+ ((< (random* (+ (length *org-drill-new-entries*)
+ (length *org-drill-old-mature-entries*)))
+ (length *org-drill-new-entries*))
+ (pop-random *org-drill-new-entries*))
+ (t
+ (pop-random *org-drill-old-mature-entries*))))
+ ;; After all the above are done, last priority is items
+ ;; that were failed earlier THIS SESSION.
+ (*org-drill-again-entries*
+ (pop *org-drill-again-entries*))
+ (t ; nothing left -- return nil
+ (return-from org-drill-pop-next-pending-entry nil)))))
+ m)))
+
+
+(defun org-drill-entries (&optional resuming-p)
+ "Returns nil, t, or a list of markers representing entries that were
+'failed' and need to be presented again before the session ends.
+
+RESUMING-P is true if we are resuming a suspended drill session."
+ (block org-drill-entries
+ (while (org-drill-entries-pending-p)
+ (let ((m (cond
+ ((or (not resuming-p)
+ (null *org-drill-current-item*)
+ (not (org-drill-entry-p *org-drill-current-item*)))
+ (org-drill-pop-next-pending-entry))
+ (t ; resuming a suspended session.
+ (setq resuming-p nil)
+ *org-drill-current-item*))))
+ (setq *org-drill-current-item* m)
+ (unless m
+ (error "Unexpectedly ran out of pending drill items"))
+ (save-excursion
+ (org-drill-goto-entry m)
+ (cond
+ ((not (org-drill-entry-due-p))
+ ;; The entry is not due anymore. This could arise if the user
+ ;; suspends a drill session, then drills an individual entry,
+ ;; then resumes the session.
+ (message "Entry no longer due, skipping...")
+ (sit-for 0.3)
+ nil)
+ (t
+ (setq result (org-drill-entry))
+ (cond
+ ((null result)
+ (message "Quit")
+ (setq end-pos :quit)
+ (return-from org-drill-entries nil))
+ ((eql result 'edit)
+ (setq end-pos (point-marker))
+ (return-from org-drill-entries nil))
+ ((eql result 'skip)
+ nil) ; skip this item
+ (t
+ (cond
+ ((<= result org-drill-failure-quality)
+ (if *org-drill-again-entries*
+ (setq *org-drill-again-entries*
+ (shuffle-list *org-drill-again-entries*)))
+ (push-end m *org-drill-again-entries*))
+ (t
+ (push m *org-drill-done-entries*))))))))))))
+
+
+
+(defun org-drill-final-report ()
+ (let ((pass-percent
+ (round (* 100 (count-if (lambda (qual)
+ (> qual org-drill-failure-quality))
+ *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*))))
+ (prompt nil))
+ (setq prompt
+ (format
+ "%d items reviewed. Session duration %s.
+Recall of reviewed items:
+ Excellent (5): %3d%% | Near miss (2): %3d%%
+ Good (4): %3d%% | Failure (1): %3d%%
+ Hard (3): %3d%% | Abject failure (0): %3d%%
+
+You successfully recalled %d%% of reviewed items (quality > %s)
+%d/%d items still await review (%s, %s, %s, %s, %s).
+Tomorrow, %d more items will become due for review.
+Session finished. Press a key to continue..."
+ (length *org-drill-done-entries*)
+ (format-seconds "%h:%.2m:%.2s"
+ (- (float-time (current-time)) *org-drill-start-time*))
+ (round (* 100 (count 5 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ (round (* 100 (count 2 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ (round (* 100 (count 4 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ (round (* 100 (count 1 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ (round (* 100 (count 3 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ (round (* 100 (count 0 *org-drill-session-qualities*))
+ (max 1 (length *org-drill-session-qualities*)))
+ pass-percent
+ org-drill-failure-quality
+ (org-drill-pending-entry-count)
+ (+ (org-drill-pending-entry-count)
+ *org-drill-dormant-entry-count*)
+ (propertize
+ (format "%d failed"
+ (+ (length *org-drill-failed-entries*)
+ (length *org-drill-again-entries*)))
+ 'face `(:foreground ,org-drill-failed-count-color))
+ (propertize
+ (format "%d overdue"
+ (length *org-drill-overdue-entries*))
+ 'face `(:foreground ,org-drill-failed-count-color))
+ (propertize
+ (format "%d new"
+ (length *org-drill-new-entries*))
+ 'face `(:foreground ,org-drill-new-count-color))
+ (propertize
+ (format "%d young"
+ (length *org-drill-young-mature-entries*))
+ 'face `(:foreground ,org-drill-mature-count-color))
+ (propertize
+ (format "%d old"
+ (length *org-drill-old-mature-entries*))
+ 'face `(:foreground ,org-drill-mature-count-color))
+ *org-drill-due-tomorrow-count*
+ ))
+
+ (while (not (input-pending-p))
+ (message "%s" prompt)
+ (sit-for 0.5))
+ (read-char-exclusive)
+
+ (if (and *org-drill-session-qualities*
+ (< pass-percent (- 100 org-drill-forgetting-index)))
+ (read-char-exclusive
+ (format
+ "%s
+You failed %d%% of the items you reviewed during this session.
+%d (%d%%) of all items scanned were overdue.
+
+Are you keeping up with your items, and reviewing them
+when they are scheduled? If so, you may want to consider
+lowering the value of `org-drill-learn-fraction' slightly in
+order to make items appear more frequently over time."
+ (propertize "WARNING!" 'face 'org-warning)
+ (- 100 pass-percent)
+ *org-drill-overdue-entry-count*
+ (round (* 100 *org-drill-overdue-entry-count*)
+ (+ *org-drill-dormant-entry-count*
+ *org-drill-due-entry-count*)))
+ ))))
+
+
+
+(defun org-drill-free-markers (markers)
+ "MARKERS is a list of markers, all of which will be freed (set to
+point nowhere). Alternatively, MARKERS can be 't', in which case
+all the markers used by Org-Drill will be freed."
+ (dolist (m (if (eql t markers)
+ (append *org-drill-done-entries*
+ *org-drill-new-entries*
+ *org-drill-failed-entries*
+ *org-drill-again-entries*
+ *org-drill-overdue-entries*
+ *org-drill-young-mature-entries*
+ *org-drill-old-mature-entries*)
+ markers))
+ (free-marker m)))
+
+
+(defun org-drill-order-overdue-entries (overdue-data)
+ (setq *org-drill-overdue-entries*
+ (mapcar 'car
+ (sort (shuffle-list overdue-data)
+ (lambda (a b) (> (cdr a) (cdr b)))))))
+
+
+(defun org-drill-entry-status ()
+ "Returns a list (STATUS DUE) where DUE is the number of days overdue,
+zero being due today, -1 being scheduled 1 day in the future. STATUS is
+one of the following values:
+- nil, if the item is not a drill entry, or has an empty body
+- :unscheduled
+- :future
+- :new
+- :failed
+- :overdue
+- :young
+- :old
+"
+ (save-excursion
+ (unless (org-at-heading-p)
+ (org-back-to-heading))
+ (let ((due (org-drill-entry-days-overdue))
+ (last-int (org-drill-entry-last-interval 1)))
+ (list
+ (cond
+ ((not (org-drill-entry-p))
+ nil)
+ ((org-drill-entry-empty-p)
+ nil) ; skip -- item body is empty
+ ((null due) ; unscheduled - usually a skipped leech
+ :unscheduled)
+ ;; ((eql -1 due)
+ ;; :tomorrow)
+ ((minusp due) ; scheduled in the future
+ :future)
+ ;; The rest of the stati all denote 'due' items ==========================
+ ((<= (org-drill-entry-last-quality 9999)
+ org-drill-failure-quality)
+ ;; Mature entries that were failed last time are
+ ;; FAILED, regardless of how young, old or overdue
+ ;; they are.
+ :failed)
+ ((org-drill-entry-new-p)
+ :new)
+ ((org-drill-entry-overdue-p due last-int)
+ ;; Overdue status overrides young versus old
+ ;; distinction.
+ ;; Store marker + due, for sorting of overdue entries
+ :overdue)
+ ((<= (org-drill-entry-last-interval 9999)
+ org-drill-days-before-old)
+ :young)
+ (t
+ :old))
+ due))))
+
+
+(defun org-drill-progress-message (collected scanned)
+ (when (zerop (% scanned 50))
+ (let* ((meter-width 40)
+ (sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.))
+ (sym2 (if (eql sym1 ?.) ?| ?.)))
+ (message "Collecting due drill items:%4d %s%s"
+ collected
+ (make-string (% (ceiling scanned 50) meter-width)
+ sym2)
+ (make-string (- meter-width (% (ceiling scanned 50) meter-width))
+ sym1)))))
+
+
+(defun org-drill (&optional scope resume-p)
+ "Begin an interactive 'drill session'. The user is asked to
+review a series of topics (headers). Each topic is initially
+presented as a 'question', often with part of the topic content
+hidden. The user attempts to recall the hidden information or
+answer the question, then presses a key to reveal the answer. The
+user then rates his or her recall or performance on that
+topic. This rating information is used to reschedule the topic
+for future review.
+
+Org-drill proceeds by:
+
+- Finding all topics (headings) in SCOPE which have either been
+ used and rescheduled before, or which have a tag that matches
+ `org-drill-question-tag'.
+
+- All matching topics which are either unscheduled, or are
+ scheduled for the current date or a date in the past, are
+ considered to be candidates for the drill session.
+
+- If `org-drill-maximum-items-per-session' is set, a random
+ subset of these topics is presented. Otherwise, all of the
+ eligible topics will be presented.
+
+SCOPE determines the scope in which to search for
+questions. It accepts the same values as `org-drill-scope',
+which see.
+
+If RESUME-P is non-nil, resume a suspended drill session rather
+than starting a new one."
+
+ (interactive)
+ (let ((end-pos nil)
+ (overdue-data nil)
+ (cnt 0))
+ (block org-drill
+ (unless resume-p
+ (org-drill-free-markers t)
+ (setq *org-drill-current-item* nil
+ *org-drill-done-entries* nil
+ *org-drill-dormant-entry-count* 0
+ *org-drill-due-entry-count* 0
+ *org-drill-due-tomorrow-count* 0
+ *org-drill-overdue-entry-count* 0
+ *org-drill-new-entries* nil
+ *org-drill-overdue-entries* nil
+ *org-drill-young-mature-entries* nil
+ *org-drill-old-mature-entries* nil
+ *org-drill-failed-entries* nil
+ *org-drill-again-entries* nil)
+ (setq *org-drill-session-qualities* nil)
+ (setq *org-drill-start-time* (float-time (current-time))))
+ (setq *random-state* (make-random-state t)) ; reseed RNG
+ (unwind-protect
+ (save-excursion
+ (unless resume-p
+ (let ((org-trust-scanner-tags t)
+ (warned-about-id-creation nil))
+ (org-map-drill-entries
+ (lambda ()
+ (org-drill-progress-message
+ (+ (length *org-drill-new-entries*)
+ (length *org-drill-overdue-entries*)
+ (length *org-drill-young-mature-entries*)
+ (length *org-drill-old-mature-entries*)
+ (length *org-drill-failed-entries*))
+ (incf cnt))
+ (cond
+ ((not (org-drill-entry-p))
+ nil) ; skip
+ (t
+ (when (and (not warned-about-id-creation)
+ (null (org-id-get)))
+ (message (concat "Creating unique IDs for items "
+ "(slow, but only happens once)"))
+ (sit-for 0.5)
+ (setq warned-about-id-creation t))
+ (org-id-get-create) ; ensure drill entry has unique ID
+ (destructuring-bind (status due) (org-drill-entry-status)
+ (case status
+ (:unscheduled
+ (incf *org-drill-dormant-entry-count*))
+ ;; (:tomorrow
+ ;; (incf *org-drill-dormant-entry-count*)
+ ;; (incf *org-drill-due-tomorrow-count*))
+ (:future
+ (incf *org-drill-dormant-entry-count*)
+ (if (eq -1 due)
+ (incf *org-drill-due-tomorrow-count*)))
+ (:new
+ (push (point-marker) *org-drill-new-entries*))
+ (:failed
+ (push (point-marker) *org-drill-failed-entries*))
+ (:young
+ (push (point-marker) *org-drill-young-mature-entries*))
+ (:overdue
+ (push (cons (point-marker) due) overdue-data))
+ (:old
+ (push (point-marker) *org-drill-old-mature-entries*)))))))
+ scope)
+ ;; (let ((due (org-drill-entry-days-overdue))
+ ;; (last-int (org-drill-entry-last-interval 1)))
+ ;; (cond
+ ;; ((org-drill-entry-empty-p)
+ ;; nil) ; skip -- item body is empty
+ ;; ((or (null due) ; unscheduled - usually a skipped leech
+ ;; (minusp due)) ; scheduled in the future
+ ;; (incf *org-drill-dormant-entry-count*)
+ ;; (if (eq -1 due)
+ ;; (incf *org-drill-due-tomorrow-count*)))
+ ;; ((org-drill-entry-new-p)
+ ;; (push (point-marker) *org-drill-new-entries*))
+ ;; ((<= (org-drill-entry-last-quality 9999)
+ ;; org-drill-failure-quality)
+ ;; ;; Mature entries that were failed last time are
+ ;; ;; FAILED, regardless of how young, old or overdue
+ ;; ;; they are.
+ ;; (push (point-marker) *org-drill-failed-entries*))
+ ;; ((org-drill-entry-overdue-p due last-int)
+ ;; ;; Overdue status overrides young versus old
+ ;; ;; distinction.
+ ;; ;; Store marker + due, for sorting of overdue entries
+ ;; (push (cons (point-marker) due) overdue-data))
+ ;; ((<= (org-drill-entry-last-interval 9999)
+ ;; org-drill-days-before-old)
+ ;; ;; Item is 'young'.
+ ;; (push (point-marker)
+ ;; *org-drill-young-mature-entries*))
+ ;; (t
+ ;; (push (point-marker)
+ ;; *org-drill-old-mature-entries*))))
+ ;; Order 'overdue' items so that the most overdue will tend to
+ ;; come up for review first, while keeping exact order random
+ (org-drill-order-overdue-entries overdue-data)
+ (setq *org-drill-overdue-entry-count*
+ (length *org-drill-overdue-entries*))))
+ (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
+ (cond
+ ((and (null *org-drill-new-entries*)
+ (null *org-drill-failed-entries*)
+ (null *org-drill-overdue-entries*)
+ (null *org-drill-young-mature-entries*)
+ (null *org-drill-old-mature-entries*))
+ (message "I did not find any pending drill items."))
+ (t
+ (org-drill-entries resume-p)
+ (message "Drill session finished!"))))
+ (progn
+ (unless end-pos
+ (org-drill-free-markers *org-drill-done-entries*)))))
+ (cond
+ (end-pos
+ (when (markerp end-pos)
+ (org-drill-goto-entry end-pos)
+ (org-reveal)
+ (org-show-entry))
+ (let ((keystr (command-keybinding-to-string 'org-drill-resume)))
+ (message
+ "You can continue the drill session with the command `org-drill-resume'.%s"
+ (if keystr (format "\nYou can run this command by pressing %s." keystr)
+ ""))))
+ (t
+ (org-drill-final-report)
+ (if (eql 'sm5 org-drill-spaced-repetition-algorithm)
+ (org-drill-save-optimal-factor-matrix))
+ (if org-drill-save-buffers-after-drill-sessions-p
+ (save-some-buffers))
+ (message "Drill session finished!")
+ ))))
+
+
+(defun org-drill-save-optimal-factor-matrix ()
+ (message "Saving optimal factor matrix...")
+ (customize-save-variable 'org-drill-optimal-factor-matrix
+ org-drill-optimal-factor-matrix))
+
+
+(defun org-drill-cram (&optional scope)
+ "Run an interactive drill session in 'cram mode'. In cram mode,
+all drill items are considered to be due for review, unless they
+have been reviewed within the last `org-drill-cram-hours'
+hours."
+ (interactive)
+ (let ((*org-drill-cram-mode* t))
+ (org-drill scope)))
+
+
+(defun org-drill-tree ()
+ "Run an interactive drill session using drill items within the
+subtree at point."
+ (interactive)
+ (org-drill 'tree))
+
+
+(defun org-drill-directory ()
+ "Run an interactive drill session using drill items from all org
+files in the same directory as the current file."
+ (interactive)
+ (org-drill 'directory))
+
+
+(defun org-drill-again (&optional scope)
+ "Run a new drill session, but try to use leftover due items that
+were not reviewed during the last session, rather than scanning for
+unreviewed items. If there are no leftover items in memory, a full
+scan will be performed."
+ (interactive)
+ (cond
+ ((plusp (org-drill-pending-entry-count))
+ (org-drill-free-markers *org-drill-done-entries*)
+ (if (markerp *org-drill-current-item*)
+ (free-marker *org-drill-current-item*))
+ (setq *org-drill-start-time* (float-time (current-time))
+ *org-drill-done-entries* nil
+ *org-drill-current-item* nil)
+ (org-drill scope t))
+ (t
+ (org-drill scope))))
+
+
+
+(defun org-drill-resume ()
+ "Resume a suspended drill session. Sessions are suspended by
+exiting them with the `edit' or `quit' options."
+ (interactive)
+ (cond
+ ((org-drill-entries-pending-p)
+ (org-drill nil t))
+ ((and (plusp (org-drill-pending-entry-count))
+ ;; Current drill session is finished, but there are still
+ ;; more items which need to be reviewed.
+ (y-or-n-p (format
+ "You have finished the drill session. However, %d items still
+need reviewing. Start a new drill session? "
+ (org-drill-pending-entry-count))))
+ (org-drill-again))
+ (t
+ (message "You have finished the drill session."))))
+
+
+(defun org-drill-strip-entry-data ()
+ (dolist (prop org-drill-scheduling-properties)
+ (org-delete-property prop))
+ (org-schedule t))
+
+
+(defun org-drill-strip-all-data (&optional scope)
+ "Delete scheduling data from every drill entry in scope. This
+function may be useful if you want to give your collection of
+entries to someone else. Scope defaults to the current buffer,
+and is specified by the argument SCOPE, which accepts the same
+values as `org-drill-scope'."
+ (interactive)
+ (when (yes-or-no-p
+ "Delete scheduling data from ALL items in scope: are you sure?")
+ (cond
+ ((null scope)
+ ;; Scope is the current buffer. This means we can use
+ ;; `org-delete-property-globally', which is faster.
+ (dolist (prop org-drill-scheduling-properties)
+ (org-delete-property-globally prop))
+ (org-map-drill-entries (lambda () (org-schedule t)) scope))
+ (t
+ (org-map-drill-entries 'org-drill-strip-entry-data scope)))
+ (message "Done.")))
+
+
+
+(defun org-drill-add-cloze-fontification ()
+ (when org-drill-use-visible-cloze-face-p
+ (font-lock-add-keywords 'org-mode
+ org-drill-cloze-keywords
+ nil)))
+
+(add-hook 'org-mode-hook 'org-drill-add-cloze-fontification)
+
+(org-drill-add-cloze-fontification)
+
+
+;;; Synching card collections =================================================
+
+
+(defvar *org-drill-dest-id-table* (make-hash-table :test 'equal))
+
+
+(defun org-drill-copy-entry-to-other-buffer (dest &optional path)
+ "Copy the subtree at point to the buffer DEST. The copy will receive
+the tag 'imported'."
+ (block org-drill-copy-entry-to-other-buffer
+ (save-excursion
+ (let ((src (current-buffer))
+ (m nil))
+ (flet ((paste-tree-here (&optional level)
+ (org-paste-subtree level)
+ (org-drill-strip-entry-data)
+ (org-toggle-tag "imported" 'on)
+ (org-map-drill-entries
+ (lambda ()
+ (let ((id (org-id-get)))
+ (org-drill-strip-entry-data)
+ (unless (gethash id *org-drill-dest-id-table*)
+ (puthash id (point-marker)
+ *org-drill-dest-id-table*))))
+ 'tree)))
+ (unless path
+ (setq path (org-get-outline-path)))
+ (org-copy-subtree)
+ (switch-to-buffer dest)
+ (setq m
+ (condition-case nil
+ (org-find-olp path t)
+ (error ; path does not exist in DEST
+ (return-from org-drill-copy-entry-to-other-buffer
+ (cond
+ ((cdr path)
+ (org-drill-copy-entry-to-other-buffer
+ dest (butlast path)))
+ (t
+ ;; We've looked all the way up the path
+ ;; Default to appending to the end of DEST
+ (goto-char (point-max))
+ (newline)
+ (paste-tree-here)))))))
+ (goto-char m)
+ (outline-next-heading)
+ (newline)
+ (forward-line -1)
+ (paste-tree-here (1+ (or (org-current-level) 0)))
+ )))))
+
+
+
+(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
+ "SRC and DEST are two org mode buffers containing drill items.
+For each drill item in DEST that shares an ID with an item in SRC,
+overwrite scheduling data in DEST with data taken from the item in SRC.
+This is intended for use when two people are sharing a set of drill items,
+one person has made some updates to the item set, and the other person
+wants to migrate to the updated set without losing their scheduling data.
+
+By default, any drill items in SRC which do not exist in DEST are
+copied into DEST. We attempt to place the copied item in the
+equivalent location in DEST to its location in SRC, by matching
+the heading hierarchy. However if IGNORE-NEW-ITEMS-P is non-nil,
+we simply ignore any items that do not exist in DEST, and do not
+copy them across."
+ (interactive "bImport scheduling info from which buffer?")
+ (unless dest
+ (setq dest (current-buffer)))
+ (setq src (get-buffer src)
+ dest (get-buffer dest))
+ (when (yes-or-no-p
+ (format
+ (concat "About to overwrite all scheduling data for drill items in `%s' "
+ "with information taken from matching items in `%s'. Proceed? ")
+ (buffer-name dest) (buffer-name src)))
+ ;; Compile list of all IDs in the destination buffer.
+ (clrhash *org-drill-dest-id-table*)
+ (with-current-buffer dest
+ (org-map-drill-entries
+ (lambda ()
+ (let ((this-id (org-id-get)))
+ (when this-id
+ (puthash this-id (point-marker) *org-drill-dest-id-table*))))
+ 'file))
+ ;; Look through all entries in source buffer.
+ (with-current-buffer src
+ (org-map-drill-entries
+ (lambda ()
+ (let ((id (org-id-get))
+ (last-quality nil) (last-reviewed nil)
+ (scheduled-time nil))
+ (cond
+ ((or (null id)
+ (not (org-drill-entry-p)))
+ nil)
+ ((gethash id *org-drill-dest-id-table*)
+ ;; This entry matches an entry in dest. Retrieve all its
+ ;; scheduling data, then go to the matching location in dest
+ ;; and write the data.
+ (let ((marker (gethash id *org-drill-dest-id-table*)))
+ (destructuring-bind (last-interval repetitions failures
+ total-repeats meanq ease)
+ (org-drill-get-item-data)
+ (setq last-reviewed (org-entry-get (point) "DRILL_LAST_REVIEWED")
+ last-quality (org-entry-get (point) "DRILL_LAST_QUALITY")
+ scheduled-time (org-get-scheduled-time (point)))
+ (save-excursion
+ ;; go to matching entry in destination buffer
+ (switch-to-buffer (marker-buffer marker))
+ (goto-char marker)
+ (org-drill-strip-entry-data)
+ (unless (zerop total-repeats)
+ (org-drill-store-item-data last-interval repetitions failures
+ total-repeats meanq ease)
+ (if last-quality
+ (org-set-property "LAST_QUALITY" last-quality)
+ (org-delete-property "LAST_QUALITY"))
+ (if last-reviewed
+ (org-set-property "LAST_REVIEWED" last-reviewed)
+ (org-delete-property "LAST_REVIEWED"))
+ (if scheduled-time
+ (org-schedule nil scheduled-time)))))
+ (remhash id *org-drill-dest-id-table*)
+ (free-marker marker)))
+ (t
+ ;; item in SRC has ID, but no matching ID in DEST.
+ ;; It must be a new item that does not exist in DEST.
+ ;; Copy the entire item to the *end* of DEST.
+ (unless ignore-new-items-p
+ (org-drill-copy-entry-to-other-buffer dest))))))
+ 'file))
+ ;; Finally: there may be some items in DEST which are not in SRC, and
+ ;; which have been scheduled by another user of DEST. Clear out the
+ ;; scheduling info from all the unmatched items in DEST.
+ (with-current-buffer dest
+ (maphash (lambda (id m)
+ (goto-char m)
+ (org-drill-strip-entry-data)
+ (free-marker m))
+ *org-drill-dest-id-table*))))
+
+
+
+;;; Card types for learning languages =========================================
+
+;;; Get spell-number.el from:
+;;; http://www.emacswiki.org/emacs/spell-number.el
+(autoload 'spelln-integer-in-words "spell-number")
+
+
+;;; `conjugate' card type =====================================================
+;;; See spanish.org for usage
+
+(defvar org-drill-verb-tense-alist
+ '(("present" "tomato")
+ ("simple present" "tomato")
+ ("present indicative" "tomato")
+ ;; past tenses
+ ("past" "purple")
+ ("simple past" "purple")
+ ("preterite" "purple")
+ ("imperfect" "darkturquoise")
+ ("present perfect" "royalblue")
+ ;; future tenses
+ ("future" "green")
+ ;; moods (backgrounds).
+ ("indicative" nil) ; default
+ ("subjunctive" "medium blue")
+ ("conditional" "grey30")
+ ("negative imperative" "red4")
+ ("positive imperative" "darkgreen")
+ )
+ "Alist where each entry has the form (TENSE COLOUR), where
+TENSE is a string naming a tense in which verbs can be
+conjugated, and COLOUR is a string specifying a foreground colour
+which will be used by `org-drill-present-verb-conjugation' and
+`org-drill-show-answer-verb-conjugation' to fontify the verb and
+the name of the tense.")
+
+
+(defun org-drill-get-verb-conjugation-info ()
+ "Auxiliary function used by `org-drill-present-verb-conjugation' and
+`org-drill-show-answer-verb-conjugation'."
+ (let ((infinitive (org-entry-get (point) "VERB_INFINITIVE" t))
+ (inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t))
+ (translation (org-entry-get (point) "VERB_TRANSLATION" t))
+ (tense (org-entry-get (point) "VERB_TENSE" nil))
+ (mood (org-entry-get (point) "VERB_MOOD" nil))
+ (highlight-face nil))
+ (unless (and infinitive translation (or tense mood))
+ (error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s"
+ infinitive translation tense mood (point)))
+ (setq tense (if tense (downcase (car (read-from-string tense))))
+ mood (if mood (downcase (car (read-from-string mood))))
+ infinitive (car (read-from-string infinitive))
+ inf-hint (if inf-hint (car (read-from-string inf-hint)))
+ translation (car (read-from-string translation)))
+ (setq highlight-face
+ (list :foreground
+ (or (second (assoc-string tense org-drill-verb-tense-alist t))
+ "hotpink")
+ :background
+ (second (assoc-string mood org-drill-verb-tense-alist t))))
+ (setq infinitive (propertize infinitive 'face highlight-face))
+ (setq translation (propertize translation 'face highlight-face))
+ (if tense (setq tense (propertize tense 'face highlight-face)))
+ (if mood (setq mood (propertize mood 'face highlight-face)))
+ (list infinitive inf-hint translation tense mood)))
+
+
+(defun org-drill-present-verb-conjugation ()
+ "Present a drill entry whose card type is 'conjugate'."
+ (flet ((tense-and-mood-to-string
+ (tense mood)
+ (cond
+ ((and tense mood)
+ (format "%s tense, %s mood" tense mood))
+ (tense
+ (format "%s tense" tense))
+ (mood
+ (format "%s mood" mood)))))
+ (destructuring-bind (infinitive inf-hint translation tense mood)
+ (org-drill-get-verb-conjugation-info)
+ (org-drill-present-card-using-text
+ (cond
+ ((zerop (random* 2))
+ (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
+ infinitive (tense-and-mood-to-string tense mood)))
+
+ (t
+ (format "\nGive the verb that means\n\n%s %s\n
+and conjugate for the %s.\n\n"
+ translation
+ (if inf-hint (format " [HINT: %s]" inf-hint) "")
+ (tense-and-mood-to-string tense mood))))))))
+
+
+(defun org-drill-show-answer-verb-conjugation (reschedule-fn)
+ "Show the answer for a drill item whose card type is 'conjugate'.
+RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
+returns its return value."
+ (destructuring-bind (infinitive inf-hint translation tense mood)
+ (org-drill-get-verb-conjugation-info)
+ (with-replaced-entry-heading
+ (format "%s of %s ==> %s\n\n"
+ (capitalize
+ (cond
+ ((and tense mood)
+ (format "%s tense, %s mood" tense mood))
+ (tense
+ (format "%s tense" tense))
+ (mood
+ (format "%s mood" mood))))
+ infinitive translation)
+ (funcall reschedule-fn))))
+
+
+;;; `translate_number' card type ==============================================
+;;; See spanish.org for usage
+
+(defvar *drilled-number* 0)
+(defvar *drilled-number-direction* 'to-english)
+
+(defun org-drill-present-translate-number ()
+ (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
+ (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
+ (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
+ (highlight-face 'font-lock-warning-face))
+ (cond
+ ((not (fboundp 'spelln-integer-in-words))
+ (message "`spell-number.el' not loaded, skipping 'translate_number' card...")
+ (sit-for 0.5)
+ 'skip)
+ ((not (and (numberp num-min) (numberp num-max) language))
+ (error "Missing language or minimum or maximum numbers for number card"))
+ (t
+ (if (> num-min num-max)
+ (psetf num-min num-max
+ num-max num-min))
+ (setq *drilled-number*
+ (+ num-min (random* (abs (1+ (- num-max num-min))))))
+ (setq *drilled-number-direction*
+ (if (zerop (random* 2)) 'from-english 'to-english))
+ (org-drill-present-card-using-text
+ (if (eql 'to-english *drilled-number-direction*)
+ (format "\nTranslate into English:\n\n%s\n"
+ (let ((spelln-language language))
+ (propertize
+ (spelln-integer-in-words *drilled-number*)
+ 'face highlight-face)))
+ (format "\nTranslate into %s:\n\n%s\n"
+ (capitalize (format "%s" language))
+ (let ((spelln-language 'english-gb))
+ (propertize
+ (spelln-integer-in-words *drilled-number*)
+ 'face highlight-face)))))))))
+
+
+(defun org-drill-show-answer-translate-number (reschedule-fn)
+ (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
+ (highlight-face 'font-lock-warning-face)
+ (non-english
+ (let ((spelln-language language))
+ (propertize (spelln-integer-in-words *drilled-number*)
+ 'face highlight-face)))
+ (english
+ (let ((spelln-language 'english-gb))
+ (propertize (spelln-integer-in-words *drilled-number*)
+ 'face 'highlight-face))))
+ (with-replaced-entry-text
+ (cond
+ ((eql 'to-english *drilled-number-direction*)
+ (format "\nThe English translation of %s is:\n\n%s\n"
+ non-english english))
+ (t
+ (format "\nThe %s translation of %s is:\n\n%s\n"
+ (capitalize (format "%s" language))
+ english non-english)))
+ (funcall reschedule-fn))))
+
+
+;;; `spanish_verb' card type ==================================================
+;;; Not very interesting, but included to demonstrate how a presentation
+;;; function can manipulate which subheading are hidden versus shown.
+
+
+(defun org-drill-present-spanish-verb ()
+ (let ((prompt nil)
+ (reveal-headings nil))
+ (with-hidden-comments
+ (with-hidden-cloze-hints
+ (with-hidden-cloze-text
+ (case (random* 6)
+ (0
+ (org-drill-hide-all-subheadings-except '("Infinitive"))
+ (setq prompt
+ (concat "Translate this Spanish verb, and conjugate it "
+ "for the *present* tense.")
+ reveal-headings '("English" "Present Tense" "Notes")))
+ (1
+ (org-drill-hide-all-subheadings-except '("English"))
+ (setq prompt (concat "For the *present* tense, conjugate the "
+ "Spanish translation of this English verb.")
+ reveal-headings '("Infinitive" "Present Tense" "Notes")))
+ (2
+ (org-drill-hide-all-subheadings-except '("Infinitive"))
+ (setq prompt (concat "Translate this Spanish verb, and "
+ "conjugate it for the *past* tense.")
+ reveal-headings '("English" "Past Tense" "Notes")))
+ (3
+ (org-drill-hide-all-subheadings-except '("English"))
+ (setq prompt (concat "For the *past* tense, conjugate the "
+ "Spanish translation of this English verb.")
+ reveal-headings '("Infinitive" "Past Tense" "Notes")))
+ (4
+ (org-drill-hide-all-subheadings-except '("Infinitive"))
+ (setq prompt (concat "Translate this Spanish verb, and "
+ "conjugate it for the *future perfect* tense.")
+ reveal-headings '("English" "Future Perfect Tense" "Notes")))
+ (5
+ (org-drill-hide-all-subheadings-except '("English"))
+ (setq prompt (concat "For the *future perfect* tense, conjugate the "
+ "Spanish translation of this English verb.")
+ reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
+ (org-cycle-hide-drawers 'all)
+ (prog1 (org-drill-presentation-prompt)
+ (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
+
+
+(provide 'org-drill)
diff --git a/contrib/lisp/org-e-ascii.el b/contrib/lisp/org-e-ascii.el
new file mode 100644
index 0000000..ad0f1b3
--- /dev/null
+++ b/contrib/lisp/org-e-ascii.el
@@ -0,0 +1,1807 @@
+;;; org-e-ascii.el --- ASCII Back-End For Org Export Engine
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements an ASCII back-end for Org generic exporter.
+;;
+;; It provides two commands for export, depending on the desired
+;; output: `org-e-ascii-export-as-ascii' (temporary buffer) and
+;; `org-e-ascii-export-to-ascii' ("txt" file).
+;;
+;; Output encoding is specified through `org-e-ascii-charset'
+;; variable, among `ascii', `latin1' and `utf-8' symbols.
+;;
+;; By default, horizontal rules span over the full text with, but with
+;; a given width attribute (set though #+ATTR_ASCII: :width <num>)
+;; they can be shortened and centered.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-export)
+
+(declare-function aa2u "ext:ascii-art-to-unicode" ())
+
+;;; Define Back-End
+;;
+;; The following setting won't allow to modify preferred charset
+;; through a buffer keyword or an option item, but, since the property
+;; will appear in communication channel nonetheless, it allows to
+;; override `org-e-ascii-charset' variable on the fly by the ext-plist
+;; mechanism.
+;;
+;; We also install a filter for headlines and sections, in order to
+;; control blank lines separating them in output string.
+
+(org-export-define-backend e-ascii
+ ((bold . org-e-ascii-bold)
+ (center-block . org-e-ascii-center-block)
+ (clock . org-e-ascii-clock)
+ (code . org-e-ascii-code)
+ (drawer . org-e-ascii-drawer)
+ (dynamic-block . org-e-ascii-dynamic-block)
+ (entity . org-e-ascii-entity)
+ (example-block . org-e-ascii-example-block)
+ (export-block . org-e-ascii-export-block)
+ (export-snippet . org-e-ascii-export-snippet)
+ (fixed-width . org-e-ascii-fixed-width)
+ (footnote-definition . org-e-ascii-footnote-definition)
+ (footnote-reference . org-e-ascii-footnote-reference)
+ (headline . org-e-ascii-headline)
+ (horizontal-rule . org-e-ascii-horizontal-rule)
+ (inline-src-block . org-e-ascii-inline-src-block)
+ (inlinetask . org-e-ascii-inlinetask)
+ (italic . org-e-ascii-italic)
+ (item . org-e-ascii-item)
+ (keyword . org-e-ascii-keyword)
+ (latex-environment . org-e-ascii-latex-environment)
+ (latex-fragment . org-e-ascii-latex-fragment)
+ (line-break . org-e-ascii-line-break)
+ (link . org-e-ascii-link)
+ (macro . org-e-ascii-macro)
+ (paragraph . org-e-ascii-paragraph)
+ (plain-list . org-e-ascii-plain-list)
+ (plain-text . org-e-ascii-plain-text)
+ (planning . org-e-ascii-planning)
+ (quote-block . org-e-ascii-quote-block)
+ (quote-section . org-e-ascii-quote-section)
+ (radio-target . org-e-ascii-radio-target)
+ (section . org-e-ascii-section)
+ (special-block . org-e-ascii-special-block)
+ (src-block . org-e-ascii-src-block)
+ (statistics-cookie . org-e-ascii-statistics-cookie)
+ (strike-through . org-e-ascii-strike-through)
+ (subscript . org-e-ascii-subscript)
+ (superscript . org-e-ascii-superscript)
+ (table . org-e-ascii-table)
+ (table-cell . org-e-ascii-table-cell)
+ (table-row . org-e-ascii-table-row)
+ (target . org-e-ascii-target)
+ (template . org-e-ascii-template)
+ (timestamp . org-e-ascii-timestamp)
+ (underline . org-e-ascii-underline)
+ (verbatim . org-e-ascii-verbatim)
+ (verse-block . org-e-ascii-verse-block))
+ :export-block "ASCII"
+ :filters-alist ((:filter-headline . org-e-ascii-filter-headline-blank-lines)
+ (:filter-section . org-e-ascii-filter-headline-blank-lines))
+ :options-alist ((:ascii-charset nil nil org-e-ascii-charset)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-e-ascii nil
+ "Options for exporting Org mode files to ASCII."
+ :tag "Org Export ASCII"
+ :group 'org-export)
+
+(defcustom org-e-ascii-text-width 72
+ "Maximum width of exported text.
+This number includes margin size, as set in
+`org-e-ascii-global-margin'."
+ :group 'org-export-e-ascii
+ :type 'integer)
+
+(defcustom org-e-ascii-global-margin 0
+ "Width of the left margin, in number of characters."
+ :group 'org-export-e-ascii
+ :type 'integer)
+
+(defcustom org-e-ascii-inner-margin 2
+ "Width of the inner margin, in number of characters.
+Inner margin is applied between each headline."
+ :group 'org-export-e-ascii
+ :type 'integer)
+
+(defcustom org-e-ascii-quote-margin 6
+ "Width of margin used for quoting text, in characters.
+This margin is applied on both sides of the text."
+ :group 'org-export-e-ascii
+ :type 'integer)
+
+(defcustom org-e-ascii-inlinetask-width 30
+ "Width of inline tasks, in number of characters.
+This number ignores any margin."
+ :group 'org-export-e-ascii
+ :type 'integer)
+
+(defcustom org-e-ascii-headline-spacing '(1 . 2)
+ "Number of blank lines inserted around headlines.
+
+This variable can be set to a cons cell. In that case, its car
+represents the number of blank lines present before headline
+contents whereas its cdr reflects the number of blank lines after
+contents.
+
+A nil value replicates the number of blank lines found in the
+original Org buffer at the same place."
+ :group 'org-export-e-ascii
+ :type '(choice
+ (const :tag "Replicate original spacing" nil)
+ (cons :tag "Set an uniform spacing"
+ (integer :tag "Number of blank lines before contents")
+ (integer :tag "Number of blank lines after contents"))))
+
+(defcustom org-e-ascii-charset 'ascii
+ "The charset allowed to represent various elements and objects.
+Possible values are:
+`ascii' Only use plain ASCII characters
+`latin1' Include Latin-1 characters
+`utf-8' Use all UTF-8 characters"
+ :group 'org-export-e-ascii
+ :type '(choice
+ (const :tag "ASCII" ascii)
+ (const :tag "Latin-1" latin1)
+ (const :tag "UTF-8" utf-8)))
+
+(defcustom org-e-ascii-underline '((ascii ?= ?~ ?-)
+ (latin1 ?= ?~ ?-)
+ (utf-8 ?═ ?─ ?╌ ?┄ ?┈))
+ "Characters for underlining headings in ASCII export.
+
+Alist whose key is a symbol among `ascii', `latin1' and `utf-8'
+and whose value is a list of characters.
+
+For each supported charset, this variable associates a sequence
+of underline characters. In a sequence, the characters will be
+used in order for headlines level 1, 2, ... If no character is
+available for a given level, the headline won't be underlined."
+ :group 'org-export-e-ascii
+ :type '(list
+ (cons :tag "Underline characters sequence"
+ (const :tag "ASCII charset" ascii)
+ (repeat character))
+ (cons :tag "Underline characters sequence"
+ (const :tag "Latin-1 charset" latin1)
+ (repeat character))
+ (cons :tag "Underline characters sequence"
+ (const :tag "UTF-8 charset" utf-8)
+ (repeat character))))
+
+(defcustom org-e-ascii-bullets '((ascii ?* ?+ ?-)
+ (latin1 ?§ ?¶)
+ (utf-8 ?◊))
+ "Bullet characters for headlines converted to lists in ASCII export.
+
+Alist whose key is a symbol among `ascii', `latin1' and `utf-8'
+and whose value is a list of characters.
+
+The first character is used for the first level considered as low
+level, and so on. If there are more levels than characters given
+here, the list will be repeated.
+
+Note that this variable doesn't affect plain lists
+representation."
+ :group 'org-export-e-ascii
+ :type '(list
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "ASCII charset" ascii)
+ (repeat character))
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "Latin-1 charset" latin1)
+ (repeat character))
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "UTF-8 charset" utf-8)
+ (repeat character))))
+
+(defcustom org-e-ascii-links-to-notes t
+ "Non-nil means convert links to notes before the next headline.
+When nil, the link will be exported in place. If the line
+becomes long in this way, it will be wrapped."
+ :group 'org-export-e-ascii
+ :type 'boolean)
+
+(defcustom org-e-ascii-table-keep-all-vertical-lines nil
+ "Non-nil means keep all vertical lines in ASCII tables.
+When nil, vertical lines will be removed except for those needed
+for column grouping."
+ :group 'org-export-e-ascii
+ :type 'boolean)
+
+(defcustom org-e-ascii-table-widen-columns t
+ "Non-nil means widen narrowed columns for export.
+When nil, narrowed columns will look in ASCII export just like in
+Org mode, i.e. with \"=>\" as ellipsis."
+ :group 'org-export-e-ascii
+ :type 'boolean)
+
+(defcustom org-e-ascii-table-use-ascii-art nil
+ "Non-nil means table.el tables are turned into ascii-art.
+
+It only makes sense when export charset is `utf-8'. It is nil by
+default since it requires ascii-art-to-unicode.el package. You
+can download it here:
+
+ http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.")
+
+(defcustom org-e-ascii-caption-above nil
+ "When non-nil, place caption string before the element.
+Otherwise, place it right after it."
+ :group 'org-export-e-ascii
+ :type 'boolean)
+
+(defcustom org-e-ascii-verbatim-format "`%s'"
+ "Format string used for verbatim text and inline code."
+ :group 'org-export-e-ascii
+ :type 'string)
+
+(defcustom org-e-ascii-format-drawer-function nil
+ "Function called to format a drawer in ASCII.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+ WIDTH the text width within the drawer.
+
+The function should return either the string to be exported or
+nil to ignore the drawer.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-ascii-format-drawer-default \(name contents width\)
+ \"Format a drawer element for ASCII export.\"
+ contents\)"
+ :group 'org-export-e-ascii
+ :type 'function)
+
+(defcustom org-e-ascii-format-inlinetask-function nil
+ "Function called to format an inlinetask in ASCII.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return either the string to be exported or
+nil to ignore the inline task.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-ascii-format-inlinetask-default
+ \(todo type priority name tags contents\)
+ \"Format an inline task element for ASCII export.\"
+ \(let* \(\(utf8p \(eq \(plist-get info :ascii-charset\) 'utf-8\)\)
+ \(width org-e-ascii-inlinetask-width\)
+ \(org-e-ascii--indent-string
+ \(concat
+ ;; Top line, with an additional blank line if not in UTF-8.
+ \(make-string width \(if utf8p ?━ ?_\)\) \"\\n\"
+ \(unless utf8p \(concat \(make-string width ? \) \"\\n\"\)\)
+ ;; Add title. Fill it if wider than inlinetask.
+ \(let \(\(title \(org-e-ascii--build-title inlinetask info width\)\)\)
+ \(if \(<= \(length title\) width\) title
+ \(org-e-ascii--fill-string title width info\)\)\)
+ \"\\n\"
+ ;; If CONTENTS is not empty, insert it along with
+ ;; a separator.
+ \(when \(org-string-nw-p contents\)
+ \(concat \(make-string width \(if utf8p ?─ ?-\)\) \"\\n\" contents\)\)
+ ;; Bottom line.
+ \(make-string width \(if utf8p ?━ ?_\)\)\)
+ ;; Flush the inlinetask to the right.
+ \(- \(plist-get info :ascii-width\)
+ \(plist-get info :ascii-margin\)
+ \(plist-get info :ascii-inner-margin\)
+ \(org-e-ascii--current-text-width inlinetask info\)\)"
+ :group 'org-export-e-ascii
+ :type 'function)
+
+
+
+;;; Internal Functions
+
+;; Internal functions fall into three categories.
+
+;; The first one is about text formatting. The core function is
+;; `org-e-ascii--current-text-width', which determines the current
+;; text width allowed to a given element. In other words, it helps
+;; keeping each line width within maximum text width defined in
+;; `org-e-ascii-text-width'. Once this information is known,
+;; `org-e-ascii--fill-string', `org-e-ascii--justify-string',
+;; `org-e-ascii--box-string' and `org-e-ascii--indent-string' can
+;; operate on a given output string.
+
+;; The second category contains functions handling elements listings,
+;; triggered by "#+TOC:" keyword. As such, `org-e-ascii--build-toc'
+;; returns a complete table of contents, `org-e-ascii--list-listings'
+;; returns a list of referenceable src-block elements, and
+;; `org-e-ascii--list-tables' does the same for table elements.
+
+;; The third category includes general helper functions.
+;; `org-e-ascii--build-title' creates the title for a given headline
+;; or inlinetask element. `org-e-ascii--build-caption' returns the
+;; caption string associated to a table or a src-block.
+;; `org-e-ascii--describe-links' creates notes about links for
+;; insertion at the end of a section. It uses
+;; `org-e-ascii--unique-links' to get the list of links to describe.
+;; Eventually, `org-e-ascii--translate' translates a string according
+;; to language and charset specification.
+
+
+(defun org-e-ascii--fill-string (s text-width info &optional justify)
+ "Fill a string with specified text-width and return it.
+
+S is the string being filled. TEXT-WIDTH is an integer
+specifying maximum length of a line. INFO is the plist used as
+a communication channel.
+
+Optional argument JUSTIFY can specify any type of justification
+among `left', `center', `right' or `full'. A nil value is
+equivalent to `left'. For a justification that doesn't also fill
+string, see `org-e-ascii--justify-string'.
+
+Return nil if S isn't a string."
+ ;; Don't fill paragraph when break should be preserved.
+ (cond ((not (stringp s)) nil)
+ ((plist-get info :preserve-breaks) s)
+ (t (with-temp-buffer
+ (let ((fill-column text-width)
+ (use-hard-newlines t))
+ (insert s)
+ (fill-region (point-min) (point-max) justify))
+ (buffer-string)))))
+
+(defun org-e-ascii--justify-string (s text-width how)
+ "Justify string S.
+TEXT-WIDTH is an integer specifying maximum length of a line.
+HOW determines the type of justification: it can be `left',
+`right', `full' or `center'."
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ (let ((fill-column text-width))
+ (while (< (point) (point-max))
+ (justify-current-line how)
+ (forward-line)))
+ (buffer-string)))
+
+(defun org-e-ascii--indent-string (s width)
+ "Indent string S by WIDTH white spaces.
+Empty lines are not indented."
+ (when (stringp s)
+ (replace-regexp-in-string
+ "\\(^\\)\\(?:.*\\S-\\)" (make-string width ? ) s nil nil 1)))
+
+(defun org-e-ascii--box-string (s info)
+ "Return string S with a partial box to its left.
+INFO is a plist used as a communicaton channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (format (if utf8p "╭────\n%s\n╰────" ",----\n%s\n`----")
+ (replace-regexp-in-string
+ "^" (if utf8p "│ " "| ")
+ ;; Remove last newline character.
+ (replace-regexp-in-string "\n[ \t]*\\'" "" s)))))
+
+(defun org-e-ascii--current-text-width (element info)
+ "Return maximum text width for ELEMENT's contents.
+INFO is a plist used as a communication channel."
+ (case (org-element-type element)
+ ;; Elements with an absolute width: `headline' and `inlinetask'.
+ (inlinetask org-e-ascii-inlinetask-width)
+ ('headline
+ (- org-e-ascii-text-width
+ (let ((low-level-rank (org-export-low-level-p element info)))
+ (if low-level-rank (* low-level-rank 2) org-e-ascii-global-margin))))
+ ;; Elements with a relative width: store maximum text width in
+ ;; TOTAL-WIDTH.
+ (otherwise
+ (let* ((genealogy (cons element (org-export-get-genealogy element)))
+ ;; Total width is determined by the presence, or not, of an
+ ;; inline task among ELEMENT parents.
+ (total-width
+ (if (loop for parent in genealogy
+ thereis (eq (org-element-type parent) 'inlinetask))
+ org-e-ascii-inlinetask-width
+ ;; No inlinetask: Remove global margin from text width.
+ (- org-e-ascii-text-width
+ org-e-ascii-global-margin
+ (let ((parent (org-export-get-parent-headline element)))
+ ;; Inner margin doesn't apply to text before first
+ ;; headline.
+ (if (not parent) 0
+ (let ((low-level-rank
+ (org-export-low-level-p parent info)))
+ ;; Inner margin doesn't apply to contents of
+ ;; low level headlines, since they've got their
+ ;; own indentation mechanism.
+ (if low-level-rank (* low-level-rank 2)
+ org-e-ascii-inner-margin))))))))
+ (- total-width
+ ;; Each `quote-block', `quote-section' and `verse-block' above
+ ;; narrows text width by twice the standard margin size.
+ (+ (* (loop for parent in genealogy
+ when (memq (org-element-type parent)
+ '(quote-block quote-section verse-block))
+ count parent)
+ 2 org-e-ascii-quote-margin)
+ ;; Text width within a plain-list is restricted by
+ ;; indentation of current item. If that's the case,
+ ;; compute it with the help of `:structure' property from
+ ;; parent item, if any.
+ (let ((parent-item
+ (if (eq (org-element-type element) 'item) element
+ (loop for parent in genealogy
+ when (eq (org-element-type parent) 'item)
+ return parent))))
+ (if (not parent-item) 0
+ ;; Compute indentation offset of the current item,
+ ;; that is the sum of the difference between its
+ ;; indentation and the indentation of the top item in
+ ;; the list and current item bullet's length. Also
+ ;; remove checkbox length, and tag length (for
+ ;; description lists) or bullet length.
+ (let ((struct (org-element-property :structure parent-item))
+ (beg-item (org-element-property :begin parent-item)))
+ (+ (- (org-list-get-ind beg-item struct)
+ (org-list-get-ind
+ (org-list-get-top-point struct) struct))
+ (length (org-e-ascii--checkbox parent-item info))
+ (length
+ (or (org-list-get-tag beg-item struct)
+ (org-list-get-bullet beg-item struct)))))))))))))
+
+(defun org-e-ascii--build-title
+ (element info text-width &optional underline notags)
+ "Format ELEMENT title and return it.
+
+ELEMENT is either an `headline' or `inlinetask' element. INFO is
+a plist used as a communication channel. TEXT-WIDTH is an
+integer representing the maximum length of a line.
+
+When optional argument UNDERLINE is non-nil, underline title,
+without the tags, according to `org-e-ascii-underline'
+specifications.
+
+if optional argument NOTAGS is nil, no tags will be added to the
+title."
+ (let* ((headlinep (eq (org-element-type element) 'headline))
+ (numbers
+ ;; Numbering is specific to headlines.
+ (and headlinep (org-export-numbered-headline-p element info)
+ ;; All tests passed: build numbering string.
+ (concat
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number element info) ".")
+ " ")))
+ (text (org-export-data (org-element-property :title element) info))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword element)))
+ (and todo (concat (org-export-data todo info) " ")))))
+ (tags (and (not notags)
+ (plist-get info :with-tags)
+ (let ((tag-list (org-export-get-tags element info)))
+ (and tag-list
+ (format ":%s:"
+ (mapconcat 'identity tag-list ":"))))))
+ (priority
+ (and (plist-get info :with-priority)
+ (let ((char (org-element-property :priority element)))
+ (and char (format "(#%c) " char)))))
+ (first-part (concat numbers todo priority text)))
+ (concat
+ first-part
+ ;; Align tags, if any.
+ (when tags
+ (format
+ (format " %%%ds"
+ (max (- text-width (1+ (length first-part))) (length tags)))
+ tags))
+ ;; Maybe underline text, if ELEMENT type is `headline' and an
+ ;; underline character has been defined.
+ (when (and underline headlinep)
+ (let ((under-char
+ (nth (1- (org-export-get-relative-level element info))
+ (cdr (assq (plist-get info :ascii-charset)
+ org-e-ascii-underline)))))
+ (and under-char
+ (concat "\n"
+ (make-string (length first-part) under-char))))))))
+
+(defun org-e-ascii--has-caption-p (element info)
+ "Non-nil when ELEMENT has a caption affiliated keyword.
+INFO is a plist used as a communication channel. This function
+is meant to be used as a predicate for `org-export-get-ordinal'."
+ (org-element-property :caption element))
+
+(defun org-e-ascii--build-caption (element info)
+ "Return caption string for ELEMENT, if applicable.
+
+INFO is a plist used as a communication channel.
+
+The caption string contains the sequence number of ELEMENT along
+with its real caption. Return nil when ELEMENT has no affiliated
+caption keyword."
+ (let ((caption (org-element-property :caption element)))
+ (when caption
+ ;; Get sequence number of current src-block among every
+ ;; src-block with a caption.
+ (let ((reference
+ (org-export-get-ordinal
+ element info nil 'org-e-ascii--has-caption-p))
+ (title-fmt (org-e-ascii--translate
+ (case (org-element-type element)
+ (table "Table %d: %s")
+ (src-block "Listing %d: %s"))
+ info)))
+ (org-e-ascii--fill-string
+ (format title-fmt reference (org-export-data (car caption) info))
+ (org-e-ascii--current-text-width element info) info)))))
+
+(defun org-e-ascii--build-toc (info &optional n keyword)
+ "Return a table of contents.
+
+INFO is a plist used as a communication channel.
+
+Optional argument N, when non-nil, is an integer specifying the
+depth of the table.
+
+Optional argument KEYWORD specifies the TOC keyword, if any, from
+which the table of contents generation has been initiated."
+ (let ((title (org-e-ascii--translate "Table of Contents" info)))
+ (concat
+ title "\n"
+ (make-string (length title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-e-ascii--current-text-width keyword info)
+ (- org-e-ascii-text-width org-e-ascii-global-margin))))
+ (mapconcat
+ (lambda (headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (indent (* (1- level) 3)))
+ (concat
+ (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
+ (org-e-ascii--build-title
+ headline info (- text-width indent) nil
+ (eq (plist-get info :with-tags) 'not-in-toc)))))
+ (org-export-collect-headlines info n) "\n")))))
+
+(defun org-e-ascii--list-listings (keyword info)
+ "Return a list of listings.
+
+KEYWORD is the keyword that initiated the list of listings
+generation. INFO is a plist used as a communication channel."
+ (let ((title (org-e-ascii--translate "List of Listings" info)))
+ (concat
+ title "\n"
+ (make-string (length title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-e-ascii--current-text-width keyword info)
+ (- org-e-ascii-text-width org-e-ascii-global-margin)))
+ ;; Use a counter instead of retreiving ordinal of each
+ ;; src-block.
+ (count 0))
+ (mapconcat
+ (lambda (src-block)
+ ;; Store initial text so its length can be computed. This is
+ ;; used to properly align caption right to it in case of
+ ;; filling (like contents of a description list item).
+ (let ((initial-text
+ (format (org-e-ascii--translate "Listing %d:" info)
+ (incf count))))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-e-ascii--indent-string
+ (org-e-ascii--fill-string
+ (let ((caption (org-element-property :caption src-block)))
+ ;; Use short name in priority, if available.
+ (org-export-data (or (cdr caption) (car caption)) info))
+ (- text-width (length initial-text)) info)
+ (length initial-text))))))
+ (org-export-collect-listings info) "\n")))))
+
+(defun org-e-ascii--list-tables (keyword info)
+ "Return a list of listings.
+
+KEYWORD is the keyword that initiated the list of listings
+generation. INFO is a plist used as a communication channel."
+ (let ((title (org-e-ascii--translate "List of Tables" info)))
+ (concat
+ title "\n"
+ (make-string (length title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-e-ascii--current-text-width keyword info)
+ (- org-e-ascii-text-width org-e-ascii-global-margin)))
+ ;; Use a counter instead of retreiving ordinal of each
+ ;; src-block.
+ (count 0))
+ (mapconcat
+ (lambda (table)
+ ;; Store initial text so its length can be computed. This is
+ ;; used to properly align caption right to it in case of
+ ;; filling (like contents of a description list item).
+ (let ((initial-text
+ (format (org-e-ascii--translate "Table %d:" info)
+ (incf count))))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-e-ascii--indent-string
+ (org-e-ascii--fill-string
+ (let ((caption (org-element-property :caption table)))
+ ;; Use short name in priority, if available.
+ (org-export-data (or (cdr caption) (car caption)) info))
+ (- text-width (length initial-text)) info)
+ (length initial-text))))))
+ (org-export-collect-tables info) "\n")))))
+
+(defun org-e-ascii--unique-links (element info)
+ "Return a list of unique link references in ELEMENT.
+
+ELEMENT is either an headline element or a section element. INFO
+is a plist used as a communication channel."
+ (let* (seen
+ (unique-link-p
+ (function
+ ;; Return LINK if it wasn't referenced so far, or nil.
+ ;; Update SEEN links along the way.
+ (lambda (link)
+ (let ((footprint
+ (cons (org-element-property :raw-link link)
+ (org-element-contents link))))
+ (unless (member footprint seen)
+ (push footprint seen) link)))))
+ ;; If at a section, find parent headline, if any, in order to
+ ;; count links that might be in the title.
+ (headline
+ (if (eq (org-element-type element) 'headline) element
+ (or (org-export-get-parent-headline element) element))))
+ ;; Get all links in HEADLINE.
+ (org-element-map
+ headline 'link (lambda (link) (funcall unique-link-p link)) info)))
+
+(defun org-e-ascii--describe-links (links width info)
+ "Return a string describing a list of links.
+
+LINKS is a list of link type objects, as returned by
+`org-e-ascii--unique-links'. WIDTH is the text width allowed for
+the output string. INFO is a plist used as a communication
+channel."
+ (mapconcat
+ (lambda (link)
+ (let ((type (org-element-property :type link))
+ (anchor (let ((desc (org-element-contents link)))
+ (if (not desc) (org-element-property :raw-link link)
+ (org-export-data desc info)))))
+ (cond
+ ;; Coderefs, radio links and fuzzy links are ignored.
+ ((member type '("coderef" "radio" "fuzzy")) nil)
+ ;; Id and custom-id links: Headlines refer to their numbering.
+ ((member type '("custom-id" "id"))
+ (let ((dest (org-export-resolve-id-link link info)))
+ (concat
+ (org-e-ascii--fill-string
+ (format
+ "[%s] %s"
+ anchor
+ (if (not dest) (org-e-ascii--translate "Unknown reference" info)
+ (format
+ (org-e-ascii--translate "See section %s" info)
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number dest info) "."))))
+ width info) "\n\n")))
+ ;; Do not add a link that cannot be resolved and doesn't have
+ ;; any description: destination is already visible in the
+ ;; paragraph.
+ ((not (org-element-contents link)) nil)
+ (t
+ (concat
+ (org-e-ascii--fill-string
+ (format "[%s] %s" anchor (org-element-property :raw-link link))
+ width info)
+ "\n\n")))))
+ links ""))
+
+(defun org-e-ascii--checkbox (item info)
+ "Return checkbox string for ITEM or nil.
+INFO is a plist used as a communication channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (case (org-element-property :checkbox item)
+ (on (if utf8p "☑ " "[X] "))
+ (off (if utf8p "☐ " "[ ] "))
+ (trans (if utf8p "☒ " "[-] ")))))
+
+
+
+;;; Template
+
+(defun org-e-ascii-template--document-title (info)
+ "Return document title, as a string.
+INFO is a plist used as a communication channel."
+ (let ((text-width org-e-ascii-text-width)
+ (title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info)))
+ (date (org-export-data (plist-get info :date) info)))
+ ;; There are two types of title blocks depending on the presence
+ ;; of a title to display.
+ (if (string= title "")
+ ;; Title block without a title. DATE is positioned at the top
+ ;; right of the document, AUTHOR to the top left and EMAIL
+ ;; just below.
+ (cond
+ ((and (org-string-nw-p date) (org-string-nw-p author))
+ (concat
+ author
+ (make-string (- text-width (length date) (length author)) ? )
+ date
+ (when (org-string-nw-p email) (concat "\n" email))
+ "\n\n\n"))
+ ((and (org-string-nw-p date) (org-string-nw-p email))
+ (concat
+ email
+ (make-string (- text-width (length date) (length email)) ? )
+ date "\n\n\n"))
+ ((org-string-nw-p date)
+ (concat
+ (org-e-ascii--justify-string date text-width 'right)
+ "\n\n\n"))
+ ((and (org-string-nw-p author) (org-string-nw-p email))
+ (concat author "\n" email "\n\n\n"))
+ ((org-string-nw-p author) (concat author "\n\n\n"))
+ ((org-string-nw-p email) (concat email "\n\n\n")))
+ ;; Title block with a title. Document's TITLE, along with the
+ ;; AUTHOR and its EMAIL are both overlined and an underlined,
+ ;; centered. Date is just below, also centered.
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ ;; Format TITLE. It may be filled if it is too wide,
+ ;; that is wider than the two thirds of the total width.
+ (title-len (min (length title) (/ (* 2 text-width) 3)))
+ (formatted-title (org-e-ascii--fill-string title title-len info))
+ (line
+ (make-string
+ (min (+ (max title-len (length author) (length email)) 2)
+ text-width) (if utf8p ?━ ?_))))
+ (org-e-ascii--justify-string
+ (concat line "\n"
+ (unless utf8p "\n")
+ (upcase formatted-title)
+ (cond
+ ((and (org-string-nw-p author) (org-string-nw-p email))
+ (concat (if utf8p "\n\n\n" "\n\n") author "\n" email))
+ ((org-string-nw-p author)
+ (concat (if utf8p "\n\n\n" "\n\n") author))
+ ((org-string-nw-p email)
+ (concat (if utf8p "\n\n\n" "\n\n") email)))
+ "\n" line
+ (when (org-string-nw-p date) (concat "\n\n\n" date))
+ "\n\n\n") text-width 'center)))))
+
+(defun org-e-ascii-template (contents info)
+ "Return complete document string after ASCII conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (org-element-normalize-string
+ (org-e-ascii--indent-string
+ (let ((text-width (- org-e-ascii-text-width org-e-ascii-global-margin)))
+ ;; 1. Build title block.
+ (concat
+ (org-e-ascii-template--document-title info)
+ ;; 2. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (org-e-ascii--build-toc info (and (wholenump depth) depth))
+ "\n\n\n")))
+ ;; 3. Document's body.
+ contents
+ ;; 4. Footnote definitions.
+ (let ((definitions (org-export-collect-footnote-definitions
+ (plist-get info :parse-tree) info))
+ ;; Insert full links right inside the footnote definition
+ ;; as they have no chance to be inserted later.
+ (org-e-ascii-links-to-notes nil))
+ (when definitions
+ (concat
+ "\n\n\n"
+ (let ((title (org-e-ascii--translate "Footnotes" info)))
+ (concat
+ title "\n"
+ (make-string
+ (length title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
+ "\n\n"
+ (mapconcat
+ (lambda (ref)
+ (let ((id (format "[%s] " (car ref))))
+ ;; Distinguish between inline definitions and
+ ;; full-fledged definitions.
+ (org-trim
+ (let ((def (nth 2 ref)))
+ (if (eq (org-element-type def) 'org-data)
+ ;; Full-fledged definition: footnote ID is
+ ;; inserted inside the first parsed paragraph
+ ;; (FIRST), if any, to be sure filling will
+ ;; take it into consideration.
+ (let ((first (car (org-element-contents def))))
+ (if (not (eq (org-element-type first) 'paragraph))
+ (concat id "\n" (org-export-data def info))
+ (push id (nthcdr 2 first))
+ (org-export-data def info)))
+ ;; Fill paragraph once footnote ID is inserted in
+ ;; order to have a correct length for first line.
+ (org-e-ascii--fill-string
+ (concat id (org-export-data def info))
+ text-width info))))))
+ definitions "\n\n"))))
+ ;; 5. Creator. Ignore `comment' value as there are no comments in
+ ;; ASCII. Justify it to the bottom right.
+ (let ((creator-info (plist-get info :with-creator)))
+ (unless (or (not creator-info) (eq creator-info 'comment))
+ (concat
+ "\n\n\n"
+ (org-e-ascii--fill-string
+ (plist-get info :creator) text-width info 'right))))))
+ org-e-ascii-global-margin)))
+
+(defun org-e-ascii--translate (s info)
+ "Translate string S according to specified language and charset.
+INFO is a plist used as a communication channel."
+ (let ((charset (intern (format ":%s" (plist-get info :ascii-charset)))))
+ (org-export-translate s charset info)))
+
+
+
+;;; Transcode Functions
+
+;;;; Babel Call
+
+;; Babel Calls are ignored.
+
+
+;;;; Bold
+
+(defun org-e-ascii-bold (bold contents info)
+ "Transcode BOLD from Org to ASCII.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "*%s*" contents))
+
+
+;;;; Center Block
+
+(defun org-e-ascii-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-ascii--justify-string
+ contents (org-e-ascii--current-text-width center-block info) 'center))
+
+
+;;;; Clock
+
+(defun org-e-ascii-clock (clock contents info)
+ "Transcode a CLOCK object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat org-clock-string " "
+ (org-translate-time (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":")))))))
+
+
+;;;; Code
+
+(defun org-e-ascii-code (code contents info)
+ "Return a CODE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format org-e-ascii-verbatim-format (org-element-property :value code)))
+
+
+;;;; Comment
+
+;; Comments are ignored.
+
+
+;;;; Comment Block
+
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-e-ascii-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((name (org-element-property :drawer-name drawer))
+ (width (org-e-ascii--current-text-width drawer info)))
+ (if (functionp org-e-ascii-format-drawer-function)
+ (funcall org-e-ascii-format-drawer-function name contents width)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+
+
+;;;; Dynamic Block
+
+(defun org-e-ascii-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Entity
+
+(defun org-e-ascii-entity (entity contents info)
+ "Transcode an ENTITY object from Org to ASCII.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property
+ (intern (concat ":" (symbol-name (plist-get info :ascii-charset))))
+ entity))
+
+
+;;;; Example Block
+
+(defun org-e-ascii-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-ascii--box-string
+ (org-export-format-code-default example-block info) info))
+
+
+;;;; Export Snippet
+
+(defun org-e-ascii-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-ascii)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-e-ascii-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "ASCII")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Fixed Width
+
+(defun org-e-ascii-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-ascii--box-string
+ (org-remove-indentation
+ (org-element-property :value fixed-width)) info))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored. They are compiled at the end of
+;; the document, by `org-e-ascii-template'.
+
+
+;;;; Footnote Reference
+
+(defun org-e-ascii-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "[%s]" (org-export-get-footnote-number footnote-reference info)))
+
+
+;;;; Headline
+
+(defun org-e-ascii-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to ASCII.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ ;; Don't export footnote section, which will be handled at the end
+ ;; of the template.
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((low-level-rank (org-export-low-level-p headline info))
+ (width (org-e-ascii--current-text-width headline info))
+ ;; Blank lines between headline and its contents.
+ ;; `org-e-ascii-headline-spacing', when set, overwrites
+ ;; original buffer's spacing.
+ (pre-blanks
+ (make-string
+ (if org-e-ascii-headline-spacing (car org-e-ascii-headline-spacing)
+ (org-element-property :pre-blank headline)) ?\n))
+ ;; Even if HEADLINE has no section, there might be some
+ ;; links in its title that we shouldn't forget to describe.
+ (links
+ (unless (or (eq (caar (org-element-contents headline)) 'section))
+ (let ((title (org-element-property :title headline)))
+ (when (consp title)
+ (org-e-ascii--describe-links
+ (org-e-ascii--unique-links title info) width info))))))
+ ;; Deep subtree: export it as a list item.
+ (if low-level-rank
+ (concat
+ ;; Bullet.
+ (let ((bullets (cdr (assq (plist-get info :ascii-charset)
+ org-e-ascii-bullets))))
+ (char-to-string
+ (nth (mod (1- low-level-rank) (length bullets)) bullets)))
+ " "
+ ;; Title.
+ (org-e-ascii--build-title headline info width) "\n"
+ ;; Contents, indented by length of bullet.
+ pre-blanks
+ (org-e-ascii--indent-string
+ (concat contents
+ (when (org-string-nw-p links) (concat "\n\n" links)))
+ 2))
+ ;; Else: Standard headline.
+ (concat
+ (org-e-ascii--build-title headline info width 'underline)
+ "\n" pre-blanks
+ (concat (when (org-string-nw-p links) links) contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-e-ascii-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((text-width (org-e-ascii--current-text-width horizontal-rule info))
+ (spec-width
+ (org-export-read-attribute :attr_ascii horizontal-rule :width)))
+ (org-e-ascii--justify-string
+ (make-string (if (wholenump spec-width) spec-width text-width)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-))
+ text-width 'center)))
+
+
+;;;; Inline Babel Call
+
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-e-ascii-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (format org-e-ascii-verbatim-format
+ (org-element-property :value inline-src-block)))
+
+
+;;;; Inlinetask
+
+(defun org-e-ascii-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((width (org-e-ascii--current-text-width inlinetask info)))
+ ;; If `org-e-ascii-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-e-ascii-format-inlinetask-function)
+ (funcall org-e-ascii-format-inlinetask-function
+ ;; todo.
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property
+ :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info))))
+ ;; todo-type
+ (org-element-property :todo-type inlinetask)
+ ;; priority
+ (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))
+ ;; title
+ (org-export-data (org-element-property :title inlinetask) info)
+ ;; tags
+ (and (plist-get info :with-tags)
+ (org-element-property :tags inlinetask))
+ ;; contents and width
+ contents width)
+ ;; Otherwise, use a default template.
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (org-e-ascii--indent-string
+ (concat
+ ;; Top line, with an additional blank line if not in UTF-8.
+ (make-string width (if utf8p ?━ ?_)) "\n"
+ (unless utf8p (concat (make-string width ? ) "\n"))
+ ;; Add title. Fill it if wider than inlinetask.
+ (let ((title (org-e-ascii--build-title inlinetask info width)))
+ (if (<= (length title) width) title
+ (org-e-ascii--fill-string title width info)))
+ "\n"
+ ;; If CONTENTS is not empty, insert it along with
+ ;; a separator.
+ (when (org-string-nw-p contents)
+ (concat (make-string width (if utf8p ?─ ?-)) "\n" contents))
+ ;; Bottom line.
+ (make-string width (if utf8p ?━ ?_)))
+ ;; Flush the inlinetask to the right.
+ (- org-e-ascii-text-width org-e-ascii-global-margin
+ (if (not (org-export-get-parent-headline inlinetask)) 0
+ org-e-ascii-inner-margin)
+ (org-e-ascii--current-text-width inlinetask info)))))))
+
+;;;; Italic
+
+(defun org-e-ascii-italic (italic contents info)
+ "Transcode italic from Org to ASCII.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "/%s/" contents))
+
+
+;;;; Item
+
+(defun org-e-ascii-item (item contents info)
+ "Transcode an ITEM element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ (checkbox (org-e-ascii--checkbox item info))
+ (list-type (org-element-property :type (org-export-get-parent item)))
+ (bullet
+ ;; First parent of ITEM is always the plain-list. Get
+ ;; `:type' property from it.
+ (org-list-bullet-string
+ (case list-type
+ (descriptive
+ (concat checkbox
+ (org-export-data (org-element-property :tag item) info)
+ ": "))
+ (ordered
+ ;; Return correct number for ITEM, paying attention to
+ ;; counters.
+ (let* ((struct (org-element-property :structure item))
+ (bul (org-element-property :bullet item))
+ (num (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))))
+ (replace-regexp-in-string "[0-9]+" num bul)))
+ (t (let ((bul (org-element-property :bullet item)))
+ ;; Change bullets into more visible form if UTF-8 is active.
+ (if (not utf8p) bul
+ (replace-regexp-in-string
+ "-" "•"
+ (replace-regexp-in-string
+ "+" "⁃"
+ (replace-regexp-in-string "*" "‣" bul))))))))))
+ (concat
+ bullet
+ (unless (eq list-type 'descriptive) checkbox)
+ ;; Contents: Pay attention to indentation. Note: check-boxes are
+ ;; already taken care of at the paragraph level so they don't
+ ;; interfere with indentation.
+ (let ((contents (org-e-ascii--indent-string contents (length bullet))))
+ (if (eq (org-element-type (car (org-element-contents item))) 'paragraph)
+ (org-trim contents)
+ (concat "\n" contents))))))
+
+
+;;;; Keyword
+
+(defun org-e-ascii-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "ASCII") value)
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (org-e-ascii--build-toc
+ info (and (wholenump depth) depth) keyword)))
+ ((string= "tables" value)
+ (org-e-ascii--list-tables keyword info))
+ ((string= "listings" value)
+ (org-e-ascii--list-listings keyword info))))))))
+
+
+;;;; Latex Environment
+
+(defun org-e-ascii-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-remove-indentation (org-element-property :value latex-environment)))
+
+
+;;;; Latex Fragment
+
+(defun org-e-ascii-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-element-property :value latex-fragment))
+
+
+;;;; Line Break
+
+(defun org-e-ascii-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+ information." hard-newline)
+
+
+;;;; Link
+
+(defun org-e-ascii-link (link desc info)
+ "Transcode a LINK object from Org to ASCII.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information."
+ (let ((raw-link (org-element-property :raw-link link))
+ (type (org-element-property :type link)))
+ (cond
+ ((string= type "coderef")
+ (let ((ref (org-element-property :path link)))
+ (format (org-export-get-coderef-format ref desc)
+ (org-export-resolve-coderef ref info))))
+ ;; Do not apply a special syntax on radio links. Though, use
+ ;; transcoded target's contents as output.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (org-export-data (org-element-contents destination) info))))
+ ;; Do not apply a special syntax on fuzzy links pointing to
+ ;; targets.
+ ((string= type "fuzzy")
+ (let ((destination (org-export-resolve-fuzzy-link link info)))
+ ;; Ignore invisible "#+TARGET: path".
+ (unless (eq (org-element-type destination) 'keyword)
+ (if (org-string-nw-p desc) desc
+ (when destination
+ (let ((number
+ (org-export-get-ordinal
+ destination info nil 'org-e-ascii--has-caption-p)))
+ (when number
+ (if (atom number) (number-to-string number)
+ (mapconcat 'number-to-string number ".")))))))))
+ (t
+ (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
+ (concat
+ (format "[%s]" desc)
+ (unless org-e-ascii-links-to-notes (format " (%s)" raw-link))))))))
+
+
+;;;; Macro
+
+(defun org-e-ascii-macro (macro contents info)
+ "Transcode a MACRO element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-export-expand-macro macro info))
+
+
+;;;; Paragraph
+
+(defun org-e-ascii-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to ASCII.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (org-e-ascii--fill-string
+ contents
+ (org-e-ascii--current-text-width paragraph info) info))
+
+
+;;;; Plain List
+
+(defun org-e-ascii-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to ASCII.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-e-ascii-plain-text (text info)
+ "Transcode a TEXT string from Org to ASCII.
+INFO is a plist used as a communication channel."
+ (if (not (and (eq (plist-get info :ascii-charset) 'utf-8)
+ (plist-get info :with-special-strings)))
+ text
+ ;; Usual replacements in utf-8 with proper option set.
+ (replace-regexp-in-string
+ "\\.\\.\\." "…"
+ (replace-regexp-in-string
+ "--" "–"
+ (replace-regexp-in-string "---" "—" text)))))
+
+
+;;;; Planning
+
+(defun org-e-ascii-planning (planning contents info)
+ "Transcode a PLANNING element from Org to ASCII.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (mapconcat
+ 'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed (concat org-closed-string " "
+ (org-translate-time closed))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline (concat org-deadline-string " "
+ (org-translate-time deadline))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled (concat org-scheduled-string " "
+ (org-translate-time scheduled))))))
+ " "))
+
+
+;;;; Property Drawer
+;;
+;; Property drawers are ignored.
+
+
+;;;; Quote Block
+
+(defun org-e-ascii-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((width (org-e-ascii--current-text-width quote-block info)))
+ (org-e-ascii--indent-string
+ (org-remove-indentation
+ (org-e-ascii--fill-string contents width info))
+ org-e-ascii-quote-margin)))
+
+
+;;;; Quote Section
+
+(defun org-e-ascii-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((width (org-e-ascii--current-text-width quote-section info))
+ (value
+ (org-export-data
+ (org-remove-indentation (org-element-property :value quote-section))
+ info)))
+ (org-e-ascii--indent-string
+ value
+ (+ org-e-ascii-quote-margin
+ ;; Don't apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline quote-section)))
+ (if (org-export-low-level-p headline info) 0
+ org-e-ascii-inner-margin))))))
+
+
+;;;; Radio Target
+
+(defun org-e-ascii-radio-target (radio-target contents info)
+ "Transcode a RADIO-TARGET object from Org to ASCII.
+CONTENTS is the contents of the target. INFO is a plist holding
+contextual information."
+ contents)
+
+;;;; Section
+
+(defun org-e-ascii-section (section contents info)
+ "Transcode a SECTION element from Org to ASCII.
+CONTENTS is the contents of the section. INFO is a plist holding
+contextual information."
+ (org-e-ascii--indent-string
+ (concat
+ contents
+ (when org-e-ascii-links-to-notes
+ ;; Add list of links at the end of SECTION.
+ (let ((links (org-e-ascii--describe-links
+ (org-e-ascii--unique-links section info)
+ (org-e-ascii--current-text-width section info) info)))
+ ;; Separate list of links and section contents.
+ (when (org-string-nw-p links) (concat "\n\n" links)))))
+ ;; Do not apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline section)))
+ (if (or (not headline) (org-export-low-level-p headline info)) 0
+ org-e-ascii-inner-margin))))
+
+
+;;;; Special Block
+
+(defun org-e-ascii-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Src Block
+
+(defun org-e-ascii-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let ((caption (org-e-ascii--build-caption src-block info)))
+ (concat
+ (when (and caption org-e-ascii-caption-above) (concat caption "\n"))
+ (org-e-ascii--box-string
+ (org-export-format-code-default src-block info) info)
+ (when (and caption (not org-e-ascii-caption-above))
+ (concat "\n" caption)))))
+
+;;;; Statistics Cookie
+
+(defun org-e-ascii-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+
+;;;; Subscript
+
+(defun org-e-ascii-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to ASCII.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (org-element-property :use-brackets-p subscript)
+ (format "_{%s}" contents)
+ (format "_%s" contents)))
+
+
+;;;; Superscript
+
+(defun org-e-ascii-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to ASCII.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (org-element-property :use-brackets-p superscript)
+ (format "_{%s}" contents)
+ (format "_%s" contents)))
+
+
+;;;; Strike-through
+
+(defun org-e-ascii-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to ASCII.
+CONTENTS is text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "+%s+" contents))
+
+
+;;;; Table
+
+(defun org-e-ascii-table (table contents info)
+ "Transcode a TABLE element from Org to ASCII.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (let ((caption (org-e-ascii--build-caption table info)))
+ (concat
+ ;; Possibly add a caption string above.
+ (when (and caption org-e-ascii-caption-above) (concat caption "\n"))
+ ;; Insert table. Note: "table.el" tables are left unmodified.
+ (cond ((eq (org-element-property :type table) 'org) contents)
+ ((and org-e-ascii-table-use-ascii-art
+ (eq (plist-get info :ascii-charset) 'utf-8)
+ (require 'ascii-art-to-unicode nil t))
+ (with-temp-buffer
+ (insert (org-remove-indentation
+ (org-element-property :value table)))
+ (goto-char (point-min))
+ (aa2u)
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (buffer-substring (point-min) (point))))
+ (t (org-remove-indentation (org-element-property :value table))))
+ ;; Possible add a caption string below.
+ (when (and caption (not org-e-ascii-caption-above))
+ (concat "\n" caption)))))
+
+
+;;;; Table Cell
+
+(defun org-e-ascii--table-cell-width (table-cell info)
+ "Return width of TABLE-CELL.
+
+INFO is a plist used as a communication channel.
+
+Width of a cell is determined either by a width cookie in the
+same column as the cell, or by the maximum cell's length in that
+column.
+
+When `org-e-ascii-table-widen-columns' is non-nil, width cookies
+are ignored."
+ (or (and (not org-e-ascii-table-widen-columns)
+ (org-export-table-cell-width table-cell info))
+ (let* ((max-width 0)
+ (table (org-export-get-parent-table table-cell))
+ (specialp (org-export-table-has-special-column-p table))
+ (col (cdr (org-export-table-cell-address table-cell info))))
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (setq max-width
+ (max (length
+ (org-export-data
+ (org-element-contents
+ (elt (if specialp (cdr (org-element-contents row))
+ (org-element-contents row))
+ col))
+ info))
+ max-width)))
+ info)
+ max-width)))
+
+(defun org-e-ascii-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL object from Org to ASCII.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ ;; Determine column width. When `org-e-ascii-table-widen-columns'
+ ;; is nil and some width cookie has set it, use that value.
+ ;; Otherwise, compute the maximum width among transcoded data of
+ ;; each cell in the column.
+ (let ((width (org-e-ascii--table-cell-width table-cell info)))
+ ;; When contents are too large, truncate them.
+ (unless (or org-e-ascii-table-widen-columns (<= (length contents) width))
+ (setq contents (concat (substring contents 0 (- width 2)) "=>")))
+ ;; Align contents correctly within the cell.
+ (let* ((indent-tabs-mode nil)
+ (data
+ (when contents
+ (org-e-ascii--justify-string
+ contents width
+ (org-export-table-cell-alignment table-cell info)))))
+ (setq contents (concat data (make-string (- width (length data)) ? ))))
+ ;; Return cell.
+ (concat (format " %s " contents)
+ (when (memq 'right (org-export-table-cell-borders table-cell info))
+ (if (eq (plist-get info :ascii-charset) 'utf-8) "│" "|")))))
+
+
+;;;; Table Row
+
+(defun org-e-ascii-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to ASCII.
+CONTENTS is the row contents. INFO is a plist used as
+a communication channel."
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let ((build-hline
+ (function
+ (lambda (lcorner horiz vert rcorner)
+ (concat
+ (apply
+ 'concat
+ (org-element-map
+ table-row 'table-cell
+ (lambda (cell)
+ (let ((width (org-e-ascii--table-cell-width cell info))
+ (borders (org-export-table-cell-borders cell info)))
+ (concat
+ ;; In order to know if CELL starts the row, do
+ ;; not compare it with the first cell in the row
+ ;; as there might be a special column. Instead,
+ ;; compare it with the first exportable cell,
+ ;; obtained with `org-element-map'.
+ (when (and (memq 'left borders)
+ (eq (org-element-map
+ table-row 'table-cell 'identity info t)
+ cell))
+ lcorner)
+ (make-string (+ 2 width) (string-to-char horiz))
+ (cond
+ ((not (memq 'right borders)) nil)
+ ((eq (car (last (org-element-contents table-row))) cell)
+ rcorner)
+ (t vert)))))
+ info)) "\n"))))
+ (utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ (borders (org-export-table-cell-borders
+ (org-element-map table-row 'table-cell 'identity info t)
+ info)))
+ (concat (cond
+ ((and (memq 'top borders) (or utf8p (memq 'above borders)))
+ (if utf8p (funcall build-hline "┍" "━" "┯" "┑")
+ (funcall build-hline "+" "-" "+" "+")))
+ ((memq 'above borders)
+ (if utf8p (funcall build-hline "├" "─" "┼" "┤")
+ (funcall build-hline "+" "-" "+" "+"))))
+ (when (memq 'left borders) (if utf8p "│" "|"))
+ contents "\n"
+ (when (and (memq 'bottom borders) (or utf8p (memq 'below borders)))
+ (if utf8p (funcall build-hline "┕" "━" "┷" "┙")
+ (funcall build-hline "+" "-" "+" "+")))))))
+
+
+;;;; Target
+
+;; Targets are invisible.
+
+
+;;;; Timestamp
+
+(defun org-e-ascii-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-translate-time (org-element-property :value timestamp)))
+ (range-end
+ (org-translate-time (org-element-property :range-end timestamp)))
+ (utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (concat value
+ (when range-end (concat (if utf8p "–" "--") range-end)))))
+
+
+;;;; Underline
+
+(defun org-e-ascii-underline (underline contents info)
+ "Transcode UNDERLINE from Org to ASCII.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "_%s_" contents))
+
+
+;;;; Verbatim
+
+(defun org-e-ascii-verbatim (verbatim contents info)
+ "Return a VERBATIM object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format org-e-ascii-verbatim-format
+ (org-element-property :value verbatim)))
+
+
+;;;; Verse Block
+
+(defun org-e-ascii-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to ASCII.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (let ((verse-width (org-e-ascii--current-text-width verse-block info)))
+ (org-e-ascii--indent-string
+ (org-e-ascii--justify-string contents verse-width 'left)
+ org-e-ascii-quote-margin)))
+
+
+;;; Filter
+
+(defun org-e-ascii-filter-headline-blank-lines (headline back-end info)
+ "Filter controlling number of blank lines after an headline.
+
+HEADLINE is a string representing a transcoded headline.
+BACK-END is symbol specifying back-end used for export. INFO is
+plist containing the communication channel.
+
+This function only applies to `e-ascii' back-end. See
+`org-e-ascii-headline-spacing' for information.
+
+For any other back-end, HEADLINE is returned as-is."
+ (if (not org-e-ascii-headline-spacing) headline
+ (let ((blanks (make-string (1+ (cdr org-e-ascii-headline-spacing)) ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-e-ascii-export-as-ascii
+ (&optional subtreep visible-only body-only ext-plist)
+ "Export current buffer to a text buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, strip title, table
+of contents and footnote definitions from output.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org E-ASCII Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (let ((outbuf (org-export-to-buffer
+ 'e-ascii "*Org E-ASCII Export*"
+ subtreep visible-only body-only ext-plist)))
+ (with-current-buffer outbuf (text-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf))))
+
+;;;###autoload
+(defun org-e-ascii-export-to-ascii
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a text file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, strip title, table
+of contents and footnote definitions from output.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".txt" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-ascii outfile subtreep visible-only body-only ext-plist)))
+
+
+(provide 'org-e-ascii)
+;;; org-e-ascii.el ends here
diff --git a/contrib/lisp/org-e-beamer.el b/contrib/lisp/org-e-beamer.el
new file mode 100644
index 0000000..0c3c430
--- /dev/null
+++ b/contrib/lisp/org-e-beamer.el
@@ -0,0 +1,1069 @@
+;;; org-e-beamer.el --- Beamer Back-End for Org Export Engine
+
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
+;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
+;; Keywords: org, wp, tex
+
+;; 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 library implements both a Beamer back-end, derived from the
+;; LaTeX one and a minor mode easing structure edition of the
+;; document.
+;;
+;; Depending on the desired output format, three commands are provided
+;; for export: `org-e-beamer-export-as-latex' (temporary buffer),
+;; `org-e-beamer-export-to-latex' ("tex" file) and
+;; `org-e-beamer-export-to-pdf' ("pdf" file).
+;;
+;; On top of buffer keywords supported by `e-latex' back-end (see
+;; `org-e-latex-options-alist'), this back-end introduces the
+;; following keywords: "BEAMER_THEME", "BEAMER_COLOR_THEME",
+;; "BEAMER_FONT_THEME", "BEAMER_INNER_THEME" and "BEAMER_OUTER_THEME".
+;; All accept options in square brackets.
+;;
+;; Moreover, headlines now fall into three categories: sectioning
+;; elements, frames and blocks.
+;;
+;; - Like `e-latex' back-end sectioning elements are still set through
+;; `org-e-latex-classes' variable.
+;;
+;; - Headlines become frames when their level is equal to
+;; `org-e-beamer-frame-level' (or "H" value in the OPTIONS line).
+;; Though, if an headline in the current tree has a "BEAMER_env"
+;; (see below) property set to "frame", its level overrides the
+;; variable.
+;;
+;; - All frames' children become block environments. Special block
+;; types can be enforced by setting headline's "BEAMER_env" property
+;; to an appropriate value (see `org-e-beamer-environments-default'
+;; for supported value and `org-e-beamer-environments-extra' for
+;; adding more).
+;;
+;; - As a special case, if the "BEAMER_env" property is set to either
+;; "appendix", "note" or "noteNH", the headline will become,
+;; respectively, an appendix, a note (within frame or between frame,
+;; depending on its level) and a note with its title ignored.
+;;
+;; Also, an headline with an "ignoreheading" value will have its
+;; contents only inserted in the output. This special value is
+;; useful to have data between frames, or to properly close
+;; a "column" environment.
+;;
+;; Along with "BEAMER_env", headlines also support "BEAMER_act" and
+;; "BEAMER_opt" properties. The former is translated as an
+;; overlay/action specification (or a default overlay specification
+;; when enclosed within square brackets) whereas the latter specifies
+;; options for the current frame ("fragile" option is added
+;; automatically, though).
+;;
+;; Every plain list has support for `:overlay' attribute (through
+;; ATTR_BEAMER affiliated keyword). Also, ordered (resp. description)
+;; lists make use of `:template' (resp. `:long-text') attribute.
+;;
+;; Eventually, an export snippet with a value enclosed within angular
+;; brackets put at the beginning of an element or object whose type is
+;; among `bold', `item', `link', `radio-target' and `target' will
+;; control its overlay specifications.
+;;
+;; On the minor mode side, `org-e-beamer-select-environment' (bound by
+;; default to "C-c C-b") and `org-e-beamer-insert-options-template'
+;; are the two entry points.
+
+;;; Code:
+
+(require 'org-e-latex)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-e-beamer nil
+ "Options specific for using the beamer class in LaTeX export."
+ :tag "Org Beamer"
+ :group 'org-export
+ :version "24.2")
+
+(defcustom org-e-beamer-frame-level 1
+ "The level at which headlines become frames.
+
+Headlines at a lower level will be translated into a sectioning
+structure. At a higher level, they will be translated into
+blocks.
+
+If an headline with a \"BEAMER_env\" property set to \"frame\" is
+found within a tree, its level locally overrides this number.
+
+This variable has no effect on headlines with the \"BEAMER_env\"
+property set to either \"ignoreheading\", \"appendix\", or
+\"note\", which will respectively, be invisible, become an
+appendix or a note.
+
+This integer is relative to the minimal level of an headline
+within the parse tree, defined as 1."
+ :group 'org-export-e-beamer
+ :type 'integer)
+
+(defcustom org-e-beamer-frame-default-options ""
+ "Default options string to use for frames.
+For example, it could be set to \"allowframebreaks\"."
+ :group 'org-export-e-beamer
+ :type '(string :tag "[options]"))
+
+(defcustom org-e-beamer-column-view-format
+ "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)"
+ "Column view format that should be used to fill the template."
+ :group 'org-export-e-beamer
+ :type '(choice
+ (const :tag "Do not insert Beamer column view format" nil)
+ (string :tag "Beamer column view format")))
+
+(defcustom org-e-beamer-theme "default"
+ "Default theme used in Beamer presentations."
+ :group 'org-export-e-beamer
+ :type '(choice
+ (const :tag "Do not insert a Beamer theme" nil)
+ (string :tag "Beamer theme")))
+
+(defcustom org-e-beamer-environments-extra nil
+ "Environments triggered by tags in Beamer export.
+Each entry has 4 elements:
+
+name Name of the environment
+key Selection key for `org-e-beamer-select-environment'
+open The opening template for the environment, with the following escapes
+ %a the action/overlay specification
+ %A the default action/overlay specification
+ %o the options argument of the template
+ %h the headline text
+ %H if there is headline text, that text in {} braces
+ %U if there is headline text, that text in [] brackets
+close The closing string of the environment."
+ :group 'org-export-e-beamer
+ :type '(repeat
+ (list
+ (string :tag "Environment")
+ (string :tag "Selection key")
+ (string :tag "Begin")
+ (string :tag "End"))))
+
+(defcustom org-e-beamer-outline-frame-title "Outline"
+ "Default title of a frame containing an outline."
+ :group 'org-export-e-beamer
+ :type '(string :tag "Outline frame title"))
+
+(defcustom org-e-beamer-outline-frame-options ""
+ "Outline frame options appended after \\begin{frame}.
+You might want to put e.g. \"allowframebreaks=0.9\" here."
+ :group 'org-export-e-beamer
+ :type '(string :tag "Outline frame options"))
+
+
+
+;;; Internal Variables
+
+(defconst org-e-beamer-column-widths
+ "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
+"The column widths that should be installed as allowed property values.")
+
+(defconst org-e-beamer-environments-special
+ '(("appendix" "x")
+ ("column" "c")
+ ("frame" "f")
+ ("ignoreheading" "i")
+ ("note" "n")
+ ("noteNH" "N"))
+ "Alist of environments treated in a special way by the back-end.
+Keys are environment names, as strings, values are bindings used
+in `org-e-beamer-select-environment'. Environments listed here,
+along with their binding, are hard coded and cannot be modified
+through `org-e-beamer-environments-extra' variable.")
+
+(defconst org-e-beamer-environments-default
+ '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}")
+ ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}")
+ ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}")
+ ("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}")
+ ("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}")
+ ("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}")
+ ("theorem" "t" "\\begin{theorem}%a%U" "\\end{theorem}")
+ ("definition" "d" "\\begin{definition}%a%U" "\\end{definition}")
+ ("example" "e" "\\begin{example}%a%U" "\\end{example}")
+ ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}")
+ ("proof" "p" "\\begin{proof}%a%U" "\\end{proof}")
+ ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}"))
+ "Environments triggered by properties in Beamer export.
+These are the defaults - for user definitions, see
+`org-e-beamer-environments-extra'.")
+
+(defconst org-e-beamer-verbatim-elements
+ '(code example-block fixed-width inline-src-block src-block verbatim)
+ "List of element or object types producing verbatim text.
+This is used internally to determine when a frame should have the
+\"fragile\" option.")
+
+
+
+;;; Internal functions
+
+(defun org-e-beamer--normalize-argument (argument type)
+ "Return ARGUMENT string with proper boundaries.
+
+TYPE is a symbol among the following:
+`action' Return ARGUMENT within angular brackets.
+`defaction' Return ARGUMENT within both square and angular brackets.
+`option' Return ARGUMENT within square brackets."
+ (if (not (string-match "\\S-" argument)) ""
+ (case type
+ (action (if (string-match "\\`<.*>\\'" argument) argument
+ (format "<%s>" argument)))
+ (defaction (cond
+ ((string-match "\\`\\[<.*>\\]\\'" argument) argument)
+ ((string-match "\\`<.*>\\'" argument)
+ (format "[%s]" argument))
+ ((string-match "\\`\\[\\(.*\\)\\]\\'" argument)
+ (format "[<%s>]" (match-string 1 argument)))
+ (t (format "[<%s>]" argument))))
+ (option (if (string-match "\\`\\[.*\\]\\'" argument) argument
+ (format "[%s]" argument)))
+ (otherwise argument))))
+
+(defun org-e-beamer--element-has-overlay-p (element)
+ "Non-nil when ELEMENT has an overlay specified.
+An element has an overlay specification when it starts with an
+`e-beamer' export-snippet whose value is between angular
+brackets. Return overlay specification, as a string, or nil."
+ (let ((first-object (car (org-element-contents element))))
+ (when (eq (org-element-type first-object) 'export-snippet)
+ (let ((value (org-element-property :value first-object)))
+ (and (string-match "\\`<.*>\\'" value) value)))))
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend e-beamer e-latex
+ :export-block "BEAMER"
+ :options-alist
+ ((:beamer-theme "BEAMER_THEME" nil org-e-beamer-theme)
+ (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t)
+ (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t)
+ (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t)
+ (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t)
+ (:headline-levels nil "H" org-e-beamer-frame-level))
+ :translate-alist ((bold . org-e-beamer-bold)
+ (export-block . org-e-beamer-export-block)
+ (export-snippet . org-e-beamer-export-snippet)
+ (headline . org-e-beamer-headline)
+ (item . org-e-beamer-item)
+ (keyword . org-e-beamer-keyword)
+ (link . org-e-beamer-link)
+ (plain-list . org-e-beamer-plain-list)
+ (radio-target . org-e-beamer-radio-target)
+ (target . org-e-beamer-target)
+ (template . org-e-beamer-template)))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-e-beamer-bold (bold contents info)
+ "Transcode BLOCK object into Beamer code.
+CONTENTS is the text being bold. INFO is a plist used as
+a communication channel."
+ (format "\\alert%s{%s}"
+ (or (org-e-beamer--element-has-overlay-p bold) "")
+ contents))
+
+
+;;;; Export Block
+
+(defun org-e-beamer-export-block (export-block contents info)
+ "Transcode an EXPORT-BLOCK element into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (when (member (org-element-property :type export-block) '("BEAMER" "LATEX"))
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-e-beamer-export-snippet (export-snippet contents info)
+ "Transcode an EXPORT-SNIPPET object into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((backend (org-export-snippet-backend export-snippet))
+ (value (org-element-property :value export-snippet)))
+ ;; Only "e-latex" and "e-beamer" snippets are retained.
+ (cond ((eq backend 'e-latex) value)
+ ;; Ignore "e-beamer" snippets specifying overlays.
+ ((and (eq backend 'e-beamer)
+ (or (org-export-get-previous-element export-snippet info)
+ (not (string-match "\\`<.*>\\'" value))))
+ value))))
+
+
+;;;; Headline
+;;
+;; The main function to translate an headline is
+;; `org-e-beamer-headline'.
+;;
+;; Depending on the level at which an headline is considered as
+;; a frame (given by `org-e-beamer--frame-level'), the headline is
+;; either a section (`org-e-beamer--format-section'), a frame
+;; (`org-e-beamer--format-frame') or a block
+;; (`org-e-beamer--format-block').
+;;
+;; `org-e-beamer-headline' also takes care of special environments
+;; like "ignoreheading", "note", "noteNH" and "appendix".
+
+(defun org-e-beamer--frame-level (headline info)
+ "Return frame level in subtree containing HEADLINE.
+INFO is a plist used as a communication channel."
+ (or
+ ;; 1. Look for "frame" environment in parents, starting from the
+ ;; farthest.
+ (catch 'exit
+ (mapc (lambda (parent)
+ (when (equal (org-element-property :beamer-env parent) "frame")
+ (throw 'exit (org-export-get-relative-level parent info))))
+ (reverse (org-export-get-genealogy headline)))
+ nil)
+ ;; 2. Look for "frame" environment in HEADLINE.
+ (and (equal (org-element-property :beamer-env headline) "frame")
+ (org-export-get-relative-level headline info))
+ ;; 3. Look for "frame" environment in sub-tree.
+ (org-element-map
+ headline 'headline
+ (lambda (hl)
+ (when (equal (org-element-property :beamer-env hl) "frame")
+ (org-export-get-relative-level hl info)))
+ info 'first-match)
+ ;; 4. No "frame" environment in tree: use default value.
+ (plist-get info :headline-levels)))
+
+(defun org-e-beamer--format-section (headline contents info)
+ "Format HEADLINE as a sectioning part.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ ;; Use `e-latex' back-end output, inserting overlay specifications
+ ;; if possible.
+ (let ((latex-headline
+ (funcall (cdr (assq 'headline org-e-latex-translate-alist))
+ headline contents info))
+ (mode-specs (org-element-property :beamer-act headline)))
+ (if (and mode-specs
+ (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{"
+ latex-headline))
+ (replace-match (concat (match-string 1 latex-headline)
+ (format "<%s>" mode-specs))
+ nil nil latex-headline 1)
+ latex-headline)))
+
+(defun org-e-beamer--format-frame (headline contents info)
+ "Format HEADLINE as a frame.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ (let ((fragilep
+ ;; FRAGILEP is non-nil when HEADLINE contains an element
+ ;; among `org-e-beamer-verbatim-elements'.
+ (org-element-map headline org-e-beamer-verbatim-elements 'identity
+ info 'first-match)))
+ (concat "\\begin{frame}"
+ ;; Overlay specification, if any. If is surrounded by square
+ ;; brackets, consider it as a default specification.
+ (let ((action (org-element-property :beamer-act headline)))
+ (cond
+ ((not action) "")
+ ((string-match "\\`\\[.*\\]\\'" action )
+ (org-e-beamer--normalize-argument action 'defaction))
+ (t (org-e-beamer--normalize-argument action 'action))))
+ ;; Options, if any.
+ (let ((options
+ ;; Collect options from default value and headline's
+ ;; properties. Also add a label for links.
+ (append
+ (org-split-string org-e-beamer-frame-default-options
+ ",")
+ (let ((opt (org-element-property :beamer-opt headline)))
+ (and opt (org-split-string
+ ;; Remove square brackets if user
+ ;; provided them.
+ (and (string-match "^\\[?\\(.*\\)\\]?$" opt)
+ (match-string 1 opt))
+ ",")))
+ (list
+ (format "label=sec-%s"
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number headline info)
+ "-"))))))
+ ;; Change options list into a string.
+ (org-e-beamer--normalize-argument
+ (mapconcat
+ 'identity
+ (if (or (not fragilep) (member "fragile" options)) options
+ (cons "fragile" options))
+ ",")
+ 'option))
+ ;; Title.
+ (format "{%s}"
+ (org-export-data (org-element-property :title headline)
+ info))
+ "\n"
+ ;; The following workaround is required in fragile frames
+ ;; as Beamer will append "\par" to the beginning of the
+ ;; contents. So we need to make sure the command is
+ ;; separated from the contents by at least one space. If
+ ;; it isn't, it will create "\parfirst-word" command and
+ ;; remove the first word from the contents in the PDF
+ ;; output.
+ (if (not fragilep) contents
+ (replace-regexp-in-string "\\`\n*" "\\& " contents))
+ "\\end{frame}")))
+
+(defun org-e-beamer--format-block (headline contents info)
+ "Format HEADLINE as a block.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ (let* ((column-width (org-element-property :beamer-col headline))
+ ;; Environment defaults to "block" if none is specified and
+ ;; there is no column specification. If there is a column
+ ;; specified but still no explicit environment, ENVIRONMENT
+ ;; is nil.
+ (environment (let ((env (org-element-property :beamer-env headline)))
+ (cond
+ ;; "block" is the fallback environment.
+ ((and (not env) (not column-width)) "block")
+ ;; "column" only.
+ ((not env) nil)
+ ;; Use specified environment.
+ (t (downcase env)))))
+ (env-format (when environment
+ (assoc environment
+ (append org-e-beamer-environments-special
+ org-e-beamer-environments-extra
+ org-e-beamer-environments-default))))
+ (title (org-export-data (org-element-property :title headline) info))
+ ;; Start a columns environment when there is no previous
+ ;; headline or the previous headline do not have
+ ;; a BEAMER_column property.
+ (start-columns-p
+ (and column-width
+ (or (org-export-first-sibling-p headline info)
+ (not (org-element-property
+ :beamer-col
+ (org-export-get-previous-element headline info))))))
+ ;; Ends a columns environment when there is no next headline
+ ;; or the next headline do not have a BEAMER_column property.
+ (end-columns-p
+ (and column-width
+ (or (org-export-last-sibling-p headline info)
+ (not (org-element-property
+ :beamer-col
+ (org-export-get-next-element headline info)))))))
+ (concat
+ (when start-columns-p "\\begin{columns}\n")
+ (when column-width
+ (format "\\begin{column}%s{%s}\n"
+ ;; One can specify placement for column only when
+ ;; HEADLINE stands for a column on its own.
+ (if (not environment) ""
+ (let ((options (org-element-property :beamer-opt headline)))
+ (if (not options) ""
+ (org-e-beamer--normalize-argument options 'option))))
+ (format "%s\\textwidth" column-width)))
+ ;; Block's opening string.
+ (when env-format
+ (concat
+ (org-fill-template
+ (nth 2 env-format)
+ (nconc
+ ;; If BEAMER_act property has its value enclosed in square
+ ;; brackets, it is a default overlay specification and
+ ;; overlay specification is empty. Otherwise, it is an
+ ;; overlay specification and the default one is nil.
+ (let ((action (org-element-property :beamer-act headline)))
+ (cond
+ ((not action) (list (cons "a" "") (cons "A" "")))
+ ((string-match "\\`\\[.*\\]\\'" action)
+ (list
+ (cons "A"
+ (org-e-beamer--normalize-argument action 'defaction))
+ (cons "a" "")))
+ (t
+ (list
+ (cons "a"
+ (org-e-beamer--normalize-argument action 'action))
+ (cons "A" "")))))
+ (list (cons "o"
+ (let ((options
+ (org-element-property :beamer-opt headline)))
+ (if (not options) ""
+ (org-e-beamer--normalize-argument options 'option))))
+ (cons "h" title)
+ (cons "H" (if (equal title "") "" (format "{%s}" title)))
+ (cons "U" (if (equal title "") "" (format "[%s]" title))))))
+ "\n"))
+ contents
+ ;; Block's closing string.
+ (when environment (concat (nth 3 env-format) "\n"))
+ (when column-width "\\end{column}\n")
+ (when end-columns-p "\\end{columns}"))))
+
+(defun org-e-beamer-headline (headline contents info)
+ "Transcode HEADLINE element into Beamer code.
+CONTENTS is the contents of the headline. INFO is a plist used
+as a communication channel."
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info))
+ (frame-level (org-e-beamer--frame-level headline info))
+ (environment (let ((env (org-element-property :beamer-env headline)))
+ (if (stringp env) (downcase env) "block"))))
+ (cond
+ ;; Creation of an appendix is requested.
+ ((equal environment "appendix")
+ (concat "\\appendix"
+ (org-element-property :beamer-act headline)
+ "\n"
+ (make-string (org-element-property :pre-blank headline) ?\n)
+ contents))
+ ((equal environment "ignoreheading")
+ (concat (make-string (org-element-property :pre-blank headline) ?\n)
+ contents))
+ ;; HEADLINE is a note.
+ ((member environment '("note" "noteNH"))
+ (format "\\note{%s}"
+ (concat (and (equal environment "note")
+ (concat
+ (org-export-data
+ (org-element-property :title headline) info)
+ "\n"))
+ (org-trim contents))))
+ ;; HEADLINE is a frame.
+ ((or (equal environment "frame") (= level frame-level))
+ (org-e-beamer--format-frame headline contents info))
+ ;; Regular section, extracted from `org-e-latex-classes'.
+ ((< level frame-level)
+ (org-e-beamer--format-section headline contents info))
+ ;; Otherwise, HEADLINE is a block.
+ (t (org-e-beamer--format-block headline contents info))))))
+
+
+;;;; Item
+
+(defun org-e-beamer-item (item contents info)
+ "Transcode an ITEM element into Beamer code.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let ((action (let ((first-element (car (org-element-contents item))))
+ (and (eq (org-element-type first-element) 'paragraph)
+ (org-e-beamer--element-has-overlay-p first-element))))
+ (output (funcall (cdr (assq 'item org-e-latex-translate-alist))
+ item contents info)))
+ (if (not action) output
+ ;; If the item starts with a paragraph and that paragraph starts
+ ;; with an export snippet specifying an overlay, insert it after
+ ;; \item command.
+ (replace-regexp-in-string "\\\\item" (concat "\\\\item" action) output))))
+
+
+;;;; Keyword
+
+(defun org-e-beamer-keyword (keyword contents info)
+ "Transcode a KEYWORD element into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ ;; Handle specifically BEAMER and TOC (headlines only) keywords.
+ ;; Otherwise, fallback to `e-latex' back-end.
+ (cond
+ ((equal key "BEAMER") value)
+ ((and (equal key "TOC") (string-match "\\<headlines\\>" value))
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc)))
+ (options (and (string-match "\\[.*?\\]" value)
+ (match-string 0 value))))
+ (concat
+ "\\begin{frame}"
+ (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth))
+ "\\tableofcontents" options "\n"
+ "\\end{frame}")))
+ (t (funcall (cdr (assq 'keyword org-e-latex-translate-alist))
+ keyword contents info)))))
+
+
+;;;; Link
+
+(defun org-e-beamer-link (link contents info)
+ "Transcode a LINK object into Beamer code.
+CONTENTS is the description part of the link. INFO is a plist
+used as a communication channel."
+ (let ((type (org-element-property :type link))
+ (path (org-element-property :path link)))
+ ;; Use \hyperlink command for all internal links.
+ (cond
+ ((equal type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-e-beamer--element-has-overlay-p link) "")
+ (org-export-solidify-link-text path)
+ (org-export-data (org-element-contents destination) info)))))
+ ((and (member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ (headline
+ (let ((label
+ (format "sec-%s"
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number
+ destination info)
+ "-"))))
+ (if (and (plist-get info :section-numbers) (not contents))
+ (format "\\ref{%s}" label)
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-e-beamer--element-has-overlay-p link) "")
+ label
+ contents))))
+ (target
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not contents) (format "\\ref{%s}" path)
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-e-beamer--element-has-overlay-p link) "")
+ path
+ contents))))))))
+ ;; Otherwise, use `e-latex' back-end.
+ (t (funcall (cdr (assq 'link org-e-latex-translate-alist))
+ link contents info)))))
+
+
+;;;; Plain List
+;;
+;; Plain lists support `:overlay' (for any type), `:template' (for
+;; ordered lists only) and `:long-text' (for description lists only)
+;; attributes.
+
+(defun org-e-beamer-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element into Beamer code.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (attributes (org-export-read-attribute :attr_beamer plain-list))
+ (latex-type (cond ((eq type 'ordered) "enumerate")
+ ((eq type 'descriptive) "description")
+ (t "itemize"))))
+ (org-e-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s%s\n%s\\end{%s}"
+ latex-type
+ ;; Default overlay specification, if any.
+ (let ((overlay (plist-get attributes :overlay)))
+ (if (not overlay) ""
+ (org-e-beamer--normalize-argument overlay 'defaction)))
+ ;; Second optional argument depends on the list type.
+ (case type
+ (ordered
+ (let ((template (plist-get attributes :template)))
+ (if (not template) ""
+ (org-e-beamer--normalize-argument template 'option))))
+ (descriptive
+ (let ((long-text (plist-get attributes :long-text)))
+ (if (not long-text) ""
+ (org-e-beamer--normalize-argument long-text 'option))))
+ ;; There's no second argument for un-ordered lists.
+ (otherwise ""))
+ ;; Eventually insert contents and close environment.
+ contents
+ latex-type))))
+
+
+;;;; Radio Target
+
+(defun org-e-beamer-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object into Beamer code.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "\\hypertarget%s{%s}{%s}"
+ (or (org-e-beamer--element-has-overlay-p radio-target) "")
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+
+;;;; Target
+
+(defun org-e-beamer-target (target contents info)
+ "Transcode a TARGET object into Beamer code.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\hypertarget{%s}{}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Template
+;;
+;; Template used is similar to the one used in `e-latex' back-end,
+;; excepted for the table of contents and Beamer themes.
+
+(defun org-e-beamer-template (contents info)
+ "Return complete document string after Beamer conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let ((title (org-export-data (plist-get info :title) info)))
+ (concat
+ ;; 1. Time-stamp.
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; 2. Document class and packages.
+ (let ((class (plist-get info :latex-class))
+ (class-options (plist-get info :latex-class-options)))
+ (org-element-normalize-string
+ (let* ((header (nth 1 (assoc class org-e-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if class-options
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)"
+ class-options header t nil 1)
+ header))))
+ (when document-class-string
+ (org-e-latex--guess-babel-language
+ (org-e-latex--guess-inputenc
+ (org-splice-latex-header
+ document-class-string
+ org-export-latex-default-packages-alist ; defined in org.el
+ org-export-latex-packages-alist nil ; defined in org.el
+ (plist-get info :latex-header-extra)))
+ info)))))
+ ;; 3. Insert themes.
+ (let ((format-theme
+ (function
+ (lambda (prop command)
+ (let ((theme (plist-get info prop)))
+ (when theme
+ (concat command
+ (if (not (string-match "\\[.*\\]" theme))
+ (format "{%s}\n" theme)
+ (format "%s{%s}\n"
+ (match-string 0 theme)
+ (org-trim
+ (replace-match "" nil nil theme)))))))))))
+ (mapconcat (lambda (args) (apply format-theme args))
+ '((:beamer-theme "\\usetheme")
+ (:beamer-color-theme "\\usecolortheme")
+ (:beamer-font-theme "\\usefonttheme")
+ (:beamer-inner-theme "\\useinnertheme")
+ (:beamer-outer-theme "\\useoutertheme"))
+ ""))
+ ;; 4. Possibly limit depth for headline numbering.
+ (let ((sec-num (plist-get info :section-numbers)))
+ (when (integerp sec-num)
+ (format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
+ ;; 5. Author.
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info))))
+ (cond ((and author email (not (string= "" email)))
+ (format "\\author{%s\\thanks{%s}}\n" author email))
+ (author (format "\\author{%s}\n" author))
+ (t "\\author{}\n")))
+ ;; 6. Date.
+ (format "\\date{%s}\n" (org-export-data (plist-get info :date) info))
+ ;; 7. Title
+ (format "\\title{%s}\n" title)
+ ;; 8. Hyperref options.
+ (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
+ (or (plist-get info :keywords) "")
+ (or (plist-get info :description) "")
+ (if (not (plist-get info :with-creator)) ""
+ (plist-get info :creator)))
+ ;; 9. Document start.
+ "\\begin{document}\n\n"
+ ;; 10. Title command.
+ (org-element-normalize-string
+ (cond ((string= "" title) nil)
+ ((not (stringp org-e-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-e-latex-title-command)
+ (format org-e-latex-title-command title))
+ (t org-e-latex-title-command)))
+ ;; 11. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (format "\\begin{frame}%s{%s}\n"
+ (org-e-beamer--normalize-argument
+ org-e-beamer-outline-frame-options 'option)
+ org-e-beamer-outline-frame-title)
+ (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%d}\n" depth))
+ "\\tableofcontents\n"
+ "\\end{frame}\n\n")))
+ ;; 12. Document's body.
+ contents
+ ;; 13. Creator.
+ (let ((creator-info (plist-get info :with-creator)))
+ (cond
+ ((not creator-info) "")
+ ((eq creator-info 'comment)
+ (format "%% %s\n" (plist-get info :creator)))
+ (t (concat (plist-get info :creator) "\n"))))
+ ;; 14. Document end.
+ "\\end{document}")))
+
+
+
+;;; Minor Mode
+
+
+(defvar org-e-beamer-mode-map (make-sparse-keymap)
+ "The keymap for `org-e-beamer-mode'.")
+(define-key org-e-beamer-mode-map "\C-c\C-b" 'org-e-beamer-select-environment)
+
+;;;###autoload
+(define-minor-mode org-e-beamer-mode
+ "Support for editing Beamer oriented Org mode files."
+ nil " Bm" 'org-e-beamer-mode-map)
+
+(when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords
+ 'org-mode
+ '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-e-beamer-tag prepend))
+ 'prepend))
+
+(defface org-e-beamer-tag '((t (:box (:line-width 1 :color grey40))))
+ "The special face for beamer tags."
+ :group 'org-export-e-beamer)
+
+(defun org-e-beamer-property-changed (property value)
+ "Track the BEAMER_env property with tags.
+PROPERTY is the name of the modified property. VALUE is its new
+value."
+ (cond
+ ((equal property "BEAMER_env")
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((tags (org-get-tags)))
+ (setq tags (delq nil (mapcar (lambda (x)
+ (if (string-match "^B_" x) nil x))
+ tags)))
+ (org-set-tags-to tags))
+ (when (org-string-nw-p value) (org-toggle-tag (concat "B_" value) 'on))))
+ ((equal property "BEAMER_col")
+ (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
+
+(add-hook 'org-property-changed-functions 'org-e-beamer-property-changed)
+
+(defun org-e-beamer-allowed-property-values (property)
+ "Supply allowed values for PROPERTY."
+ (cond
+ ((and (equal property "BEAMER_env")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_env have been defined,
+ ;; supply all defined environments
+ (mapcar 'car (append org-e-beamer-environments-special
+ org-e-beamer-environments-extra
+ org-e-beamer-environments-default)))
+ ((and (equal property "BEAMER_col")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_col have been defined,
+ ;; supply some
+ (org-split-string org-e-beamer-column-widths " "))))
+
+(add-hook 'org-property-allowed-value-functions
+ 'org-e-beamer-allowed-property-values)
+
+
+
+;;; Commands
+
+;;;###autoload
+(defun org-e-beamer-export-as-latex
+ (&optional subtreep visible-only body-only ext-plist)
+ "Export current buffer as a Beamer buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org E-BEAMER Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (let ((outbuf (org-export-to-buffer
+ 'e-beamer "*Org E-BEAMER Export*"
+ subtreep visible-only body-only ext-plist)))
+ (with-current-buffer outbuf (LaTeX-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf))))
+
+;;;###autoload
+(defun org-e-beamer-export-to-latex
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer as a Beamer presentation (tex).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-beamer outfile subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-e-beamer-export-to-pdf
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer as a Beamer presentation (PDF).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return PDF file's name."
+ (interactive)
+ (org-e-latex-compile
+ (org-e-beamer-export-to-latex
+ subtreep visible-only body-only ext-plist pub-dir)))
+
+;;;###autoload
+(defun org-e-beamer-select-environment ()
+ "Select the environment to be used by beamer for this entry.
+While this uses (for convenience) a tag selection interface, the
+result of this command will be that the BEAMER_env *property* of
+the entry is set.
+
+In addition to this, the command will also set a tag as a visual
+aid, but the tag does not have any semantic meaning."
+ (interactive)
+ ;; Make sure `org-e-beamer-environments-special' has a higher
+ ;; priority than `org-e-beamer-environments-extra'.
+ (let* ((envs (append org-e-beamer-environments-special
+ org-e-beamer-environments-extra
+ org-e-beamer-environments-default))
+ (org-tag-alist
+ (append '((:startgroup))
+ (mapcar (lambda (e) (cons (concat "B_" (car e))
+ (string-to-char (nth 1 e))))
+ envs)
+ '((:endgroup))
+ '(("BMCOL" . ?|))))
+ (org-fast-tag-selection-single-key t))
+ (org-set-tags)
+ (let ((tags (or (ignore-errors (org-get-tags-string)) "")))
+ (cond
+ ((eq org-last-tag-selection-key ?|)
+ (if (string-match ":BMCOL:" tags)
+ (org-set-property "BEAMER_col" (read-string "Column width: "))
+ (org-delete-property "BEAMER_col")))
+ ((string-match (concat ":B_\\("
+ (mapconcat 'car envs "\\|")
+ "\\):")
+ tags)
+ (org-entry-put nil "BEAMER_env" (match-string 1 tags)))
+ (t (org-entry-delete nil "BEAMER_env"))))))
+
+;;;###autoload
+(defun org-e-beamer-insert-options-template (&optional kind)
+ "Insert a settings template, to make sure users do this right."
+ (interactive (progn
+ (message "Current [s]ubtree or [g]lobal?")
+ (if (eq (read-char-exclusive) ?g) (list 'global)
+ (list 'subtree))))
+ (if (eq kind 'subtree)
+ (progn
+ (org-back-to-heading t)
+ (org-reveal)
+ (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer")
+ (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]")
+ (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
+ (when org-e-beamer-column-view-format
+ (org-entry-put nil "COLUMNS" org-e-beamer-column-view-format))
+ (org-entry-put nil "BEAMER_col_ALL" org-e-beamer-column-widths))
+ (insert "#+LaTeX_CLASS: beamer\n")
+ (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
+ (when org-e-beamer-theme
+ (insert "#+BEAMER_THEME: " org-e-beamer-theme "\n"))
+ (when org-e-beamer-column-view-format
+ (insert "#+COLUMNS: " org-e-beamer-column-view-format "\n"))
+ (insert "#+PROPERTY: BEAMER_col_ALL " org-e-beamer-column-widths "\n")))
+
+
+(provide 'org-e-beamer)
+;;; org-e-beamer.el ends here
diff --git a/contrib/lisp/org-e-groff.el b/contrib/lisp/org-e-groff.el
new file mode 100644
index 0000000..756a818
--- /dev/null
+++ b/contrib/lisp/org-e-groff.el
@@ -0,0 +1,2090 @@
+;; org-e-groff.el --- Groff Back-End For Org Export Engine
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;; Commentary:
+;;
+;; This library implements a Groff Memorandum Macro back-end for
+;; Org generic exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'e-groff "*Test e-Groff*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the Groff
+;; export. See contrib/lisp/org-export.el for more details on how
+;; this exporter works.
+;;
+;; It introduces two new buffer keywords: "GROFF_CLASS" and
+;; "GROFF_CLASS_OPTIONS".
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar org-export-groff-default-packages-alist)
+(defvar org-export-groff-packages-alist)
+
+(require 'org-export)
+
+
+;;; Define Back-End
+
+(defvar org-e-groff-translate-alist
+ '((babel-call . org-e-groff-babel-call)
+ (bold . org-e-groff-bold)
+ (center-block . org-e-groff-center-block)
+ (clock . org-e-groff-clock)
+ (code . org-e-groff-code)
+ (comment . org-e-groff-comment)
+ (comment-block . org-e-groff-comment-block)
+ (drawer . org-e-groff-drawer)
+ (dynamic-block . org-e-groff-dynamic-block)
+ (entity . org-e-groff-entity)
+ (example-block . org-e-groff-example-block)
+ (export-block . org-e-groff-export-block)
+ (export-snippet . org-e-groff-export-snippet)
+ (fixed-width . org-e-groff-fixed-width)
+ (footnote-definition . org-e-groff-footnote-definition)
+ (footnote-reference . org-e-groff-footnote-reference)
+ (headline . org-e-groff-headline)
+ (horizontal-rule . org-e-groff-horizontal-rule)
+ (inline-babel-call . org-e-groff-inline-babel-call)
+ (inline-src-block . org-e-groff-inline-src-block)
+ (inlinetask . org-e-groff-inlinetask)
+ (italic . org-e-groff-italic)
+ (item . org-e-groff-item)
+ (keyword . org-e-groff-keyword)
+ (groff-environment . org-e-groff-groff-environment)
+ (groff-fragment . org-e-groff-groff-fragment)
+ (line-break . org-e-groff-line-break)
+ (link . org-e-groff-link)
+ (macro . org-e-groff-macro)
+ (paragraph . org-e-groff-paragraph)
+ (plain-list . org-e-groff-plain-list)
+ (plain-text . org-e-groff-plain-text)
+ (planning . org-e-groff-planning)
+ (property-drawer . org-e-groff-property-drawer)
+ (quote-block . org-e-groff-quote-block)
+ (quote-section . org-e-groff-quote-section)
+ (radio-target . org-e-groff-radio-target)
+ (section . org-e-groff-section)
+ (special-block . org-e-groff-special-block)
+ (src-block . org-e-groff-src-block)
+ (statistics-cookie . org-e-groff-statistics-cookie)
+ (strike-through . org-e-groff-strike-through)
+ (subscript . org-e-groff-subscript)
+ (superscript . org-e-groff-superscript)
+ (table . org-e-groff-table)
+ (table-cell . org-e-groff-table-cell)
+ (table-row . org-e-groff-table-row)
+ (target . org-e-groff-target)
+ (template . org-e-groff-template)
+ (timestamp . org-e-groff-timestamp)
+ (underline . org-e-groff-underline)
+ (verbatim . org-e-groff-verbatim)
+ (verse-block . org-e-groff-verse-block))
+ "Alist between element or object types and translators.")
+
+(defconst org-e-groff-options-alist
+ '((:date "DATE" nil org-e-groff-date-format t)
+ (:groff-class "GROFF_CLASS" nil org-e-groff-default-class t)
+ (:groff-class-options "GROFF_CLASS_OPTIONS" nil nil t)
+ (:groff-header-extra "GROFF_HEADER" nil nil newline))
+"Alist between Groff export properties and ways to set them.
+See `org-export-options-alist' for more information on the
+structure of the values.")
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-e-groff nil
+ "Options for exporting Org mode files to Groff."
+ :tag "Org Export Groff"
+ :group 'org-export)
+
+;;; Preamble
+
+(defcustom org-e-groff-default-class "internal"
+ "The default Groff class."
+ :group 'org-export-e-groff
+ :type '(string :tag "Groff class"))
+
+(defcustom org-e-groff-classes
+ '(("file" ".MT 1"
+ (:heading 'default :type "memo" :last-section "toc"))
+ ("internal" ".MT 0"
+ (:heading 'default :type "memo" :last-section "toc"))
+ ("programmer" ".MT 2"
+ (:heading 'default :type "memo" :last-section "toc"))
+ ("engineer" ".MT 3"
+ (:heading 'default :type "memo" :last-section "toc"))
+ ("external" ".MT 4"
+ (:heading 'default :type "memo" :last-section "toc"))
+ ("letter" ".MT 5"
+ (:heading 'default :type "memo" :last-section "sign"))
+ ("custom" ".so file"
+ (:heading custom-function :type "custom" :last-section "toc"))
+ ("dummy" ""
+ (:heading 'default :type "memo"))
+ ("ms" "ms"
+ (:heading 'default :type "cover" :last-section "toc"))
+ ("se_ms" "se_ms"
+ (:heading 'default :type "cover" :last-section "toc"))
+ ("block" "BL"
+ (:heading 'default :type "letter" :last-section "sign"))
+ ("semiblock" "SB"
+ (:heading 'default :type "letter" :last-section "sign"))
+ ("fullblock" "FB"
+ (:heading 'default :type "letter" :last-section "sign"))
+ ("simplified" "SP"
+ (:heading 'default :type "letter" :last-section "sign"))
+ ("none" "" (:heading 'default :type "custom")))
+
+ ;; none means, no Cover or Memorandum Type and no calls to AU, AT, ND and TL
+ ;; This is to facilitate the creation of custom pages.
+
+ ;; dummy means, no Cover or Memorandum Type but calls to AU, AT, ND and TL
+ ;; are made. This is to facilitate Abstract Insertion.
+
+ "This list describes the attributes for the documents being created.
+ It allows for the creation of new "
+ :group 'org-export-e-groff
+ :type '(repeat
+ (list (string :tag "Document Type")
+ (string :tag "Header")
+ (repeat :tag "Options" :inline t
+ (choice
+ (list :tag "Heading")
+ (function :tag "Hook computing sectioning"))))))
+
+
+(defcustom org-e-groff-date-format
+ (format-time-string "%Y-%m-%d")
+ "Format string for .ND "
+ :group 'org-export-e-groff
+ :type 'boolean)
+
+;;; Headline
+
+(defconst org-e-groff-special-tags
+ '("FROM" "TO" "ABSTRACT" "APPENDIX" "BODY" "NS"))
+
+(defcustom org-e-groff-format-headline-function nil
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags as a list of strings (list of strings or nil).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-e-groff-format-headline (todo todo-type priority text tags)
+ \"Default format function for an headline.\"
+ \(concat (when todo
+ \(format \"\\fB%s\\fP \" todo))
+ \(when priority
+ \(format \"[\\#%c] \" priority))
+ text
+ \(when tags
+ \(format \" %s \"
+ \(mapconcat 'identity tags \":\"))))"
+ :group 'org-export-e-groff
+ :type 'function)
+
+;;; Timestamps
+
+(defcustom org-e-groff-active-timestamp-format "\\fI%s\\fP"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-e-groff
+ :type 'string)
+
+(defcustom org-e-groff-inactive-timestamp-format "\\fI%s\\fP"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-e-groff
+ :type 'string)
+
+(defcustom org-e-groff-diary-timestamp-format "\\fI%s\\fP"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-e-groff
+ :type 'string)
+
+;;; Links
+
+(defcustom org-e-groff-inline-image-rules
+ '(("file" . "\\.\\(pdf\\|ps\\|eps\\|pic\\)\\'")
+ ("fuzzy" . "\\.\\(pdf\\|ps\\|eps\\|pic\\)\\'"))
+ "Rules characterizing image files that can be inlined into Groff.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path.
+
+Note that, by default, the image extensions actually allowed
+depend on the way the Groff file is processed. When used with
+pdfgroff, pdf, jpg and png images are OK. When processing
+through dvi to Postscript, only ps and eps are allowed. The
+default we use here encompasses both."
+ :group 'org-export-e-groff
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-e-groff-link-with-unknown-path-format "\\fI%s\\fP"
+ "Format string for links with unknown path type."
+ :group 'org-export-groff
+ :type 'string)
+
+;;; Tables
+
+(defcustom org-e-groff-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-e-groff
+ :type 'boolean)
+
+(defcustom org-e-groff-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-e-groff
+ :type 'boolean)
+
+(defcustom org-e-groff-table-scientific-notation "%sE%s"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-e-groff
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+;;; Text markup
+
+(defcustom org-e-groff-text-markup-alist
+ '((bold . "\\fB%s\\fP")
+ (code . "\\fC%s\\fP")
+ (italic . "\\fI%s\\fP")
+ (strike-through . "\\fC%s\\fP") ; Strike through and underline
+ (underline . "\\fI%s\\fP") ; need to be revised.
+ (verbatim . "protectedtexttt"))
+ "Alist of Groff expressions to convert text markup.
+
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underline' and `verbatim'. The value is
+a formatting string to wrap fontified text with it.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-e-groff
+ :type 'alist
+ :options '(bold code italic strike-through underline verbatim))
+
+;;; Drawers
+
+(defcustom org-e-groff-format-drawer-function nil
+ "Function called to format a drawer in Groff code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-groff-format-drawer-default \(name contents\)
+ \"Format a drawer element for Groff export.\"
+ contents\)"
+ :group 'org-export-e-groff
+ :type 'function)
+
+;;; Inlinetasks
+
+(defcustom org-e-groff-format-inlinetask-function nil
+ "Function called to format an inlinetask in Groff code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-groff-format-inlinetask \(todo type priority name tags contents\)
+\"Format an inline task element for Groff export.\"
+ \(let ((full-title
+ \(concat
+ \(when todo
+ \(format \"\\fB%s\\fP \" todo))
+ \(when priority (format \"[\\#%c] \" priority))
+ title
+ \(when tags
+ \(format \":%s:\"
+ \(mapconcat 'identity tags \":\")))))
+ \(format (concat \".DS L\\n\"
+ \"%s\\n\\n\"
+ \"%s\"
+ \".DE\")
+ full-title contents))"
+ :group 'org-export-e-groff
+ :type 'function)
+
+;; Src blocks
+
+(defcustom org-e-groff-source-highlight nil
+ "Use GNU source highlight to embellish source blocks "
+ :group 'org-export-e-groff
+ :type 'boolean)
+
+(defcustom org-e-groff-source-highlight-langs
+ '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
+ (scheme "scheme")
+ (c "c") (cc "cpp") (csharp "csharp") (d "d")
+ (fortran "fortran") (cobol "cobol") (pascal "pascal")
+ (ada "ada") (asm "asm")
+ (perl "perl") (cperl "perl")
+ (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
+ (java "java") (javascript "javascript")
+ (tex "latex")
+ (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
+ (ocaml "caml") (caml "caml")
+ (sql "sql") (sqlite "sql")
+ (html "html") (css "css") (xml "xml")
+ (bat "bat") (bison "bison") (clipper "clipper")
+ (ldap "ldap") (opa "opa")
+ (php "php") (postscript "postscript") (prolog "prolog")
+ (properties "properties") (makefile "makefile")
+ (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the listings package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present."
+ :group 'org-export-e-groff
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+(defcustom org-e-groff-source-highlight-options nil
+ "Association list of options for the groff listings package.
+
+These options are supplied as a comma-separated list to the
+\\lstset command. Each element of the association list should be
+a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-e-groff-source-highlight-options
+ '((\"basicstyle\" \"\\small\")
+ (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
+
+will typeset the code in a small size font with underlined, bold
+black keywords.
+
+Note that the same options will be applied to blocks of all
+languages."
+ :group 'org-export-e-groff
+ :type '(repeat
+ (list
+ (string :tag "Listings option name ")
+ (string :tag "Listings option value"))))
+
+(defvar org-e-groff-custom-lang-environments nil
+ "Alist mapping languages to language-specific Groff environments.
+
+It is used during export of src blocks by the listings and
+groff packages. For example,
+
+ \(setq org-e-groff-custom-lang-environments
+ '\(\(python \"pythoncode\"\)\)\)
+
+would have the effect that if org encounters begin_src python
+during groff export it will use pythoncode as the source-highlight
+language.")
+
+;;; Plain text
+
+(defcustom org-e-groff-quotes
+ '(("fr"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~")
+ ("\\(\\S-\\)\"" . "~»")
+ ("\\(\\s-\\|(\\|^\\)'" . "'"))
+ ("en"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "``")
+ ("\\(\\S-\\)\"" . "''")
+ ("\\(\\s-\\|(\\|^\\)'" . "`")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-groff
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+(defcustom org-e-groff-special-char
+ '(("(c)" . "\\\\(co")
+ ("(tm)" . "\\\\(tm")
+ ("(rg)" . "\\\\(rg"))
+ "CONS list in which the value of the car
+ is replace on the value of the CDR. "
+ :group 'org-export-e-groff
+ :type '(list
+ (cons :tag "Character Subtitute"
+ (string :tag "Original Character Group")
+ (string :tag "Replacement Character"))))
+
+;;; Compilation
+
+(defcustom org-e-groff-pdf-process
+ '("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")
+
+ "Commands to process a Groff file to a PDF file.
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+full file name, %b by the file base name \(i.e. without
+extension) and %o by the base directory of the file."
+ :group 'org-export-pdf
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdfgroff"
+ ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
+ (const :tag "3 runs of pdfgroff"
+ ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
+ (function)))
+
+(defcustom org-e-groff-logfiles-extensions
+ '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ "The list of file extensions to consider as Groff logfiles."
+ :group 'org-export-e-groff
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-e-groff-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+These are the .aux, .log, .out, and .toc files."
+ :group 'org-export-e-groff
+ :type 'boolean)
+
+(defcustom org-e-groff-organization "Org User"
+ "Name of the organization used to populate the .AF command."
+ :group 'org-export-e-groff
+ :type 'string)
+
+
+;; Adding GROFF as a block parser to make sure that its contents
+;; does not execute
+
+(add-to-list 'org-element-block-name-alist
+ '("GROFF" . org-element-export-block-parser))
+
+(defvar org-e-groff-registered-references nil)
+(defvar org-e-groff-special-content nil)
+
+
+
+;;; Internal Functions
+
+(defun org-e-groff--caption/label-string (caption label info)
+ "Return caption and label Groff string for floats.
+
+CAPTION is a cons cell of secondary strings, the car being the
+standard caption and the cdr its short form. LABEL is a string
+representing the label. INFO is a plist holding contextual
+information.
+
+If there's no caption nor label, return the empty string.
+
+For non-floats, see `org-e-groff--wrap-label'."
+ (let ((label-str ""))
+ (cond
+ ((and (not caption) (not label)) "")
+ ((not caption) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ ((cdr caption)
+ (format "%s\n.br\n%s - %s\n"
+ (org-export-data (cdr caption) info)
+ label-str
+ (org-export-data (car caption) info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP"
+ (org-export-data (car caption) info))))))
+
+(defun org-e-groff--quotation-marks (text info)
+ "Export quotation marks depending on language conventions.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr (or (assoc (plist-get info :language) org-e-groff-quotes)
+ ;; Falls back on English.
+ (assoc "en" org-e-groff-quotes))))
+ text)
+
+(defun org-e-groff--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-e-groff--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (or (not output) (not label) (string= output "") (string= label ""))
+ output
+ (concat (format "%s\n.br\n" label) output))))
+
+(defun org-e-groff--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-e-groff-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-e-groff-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ((string= "protectedtexttt" fmt)
+ (let ((start 0)
+ (trans '(("\\" . "\\")))
+ (rtn "")
+ char)
+ (while (string-match "[\\{}$%&_#~^]" text)
+ (setq char (match-string 0 text))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
+ (setq text (substring text (1+ (match-beginning 0))))
+ (setq char (or (cdr (assoc char trans)) (concat "\\" char))
+ rtn (concat rtn char)))
+ (setq text (concat rtn text))
+ (format "\\fC%s\\fP" text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
+
+
+(defun org-e-groff--get-tagged-content (tag info)
+ (cdr (assoc tag org-e-groff-special-content)))
+
+(defun org-e-groff--mt-head (title contents attr info)
+ (concat
+
+ ;; 1. Insert Organization
+ (let ((firm-option (plist-get attr :firm)))
+ (cond
+ ((stringp firm-option)
+ (format ".AF \"%s\" \n" firm-option))
+ (t (format ".AF \"%s\" \n" (or org-e-groff-organization "")))))
+
+ ;; 2. Title
+ (let ((subtitle1 (plist-get attr :subtitle1))
+ (subtitle2 (plist-get attr :subtitle2)))
+
+ (cond
+ ((string= "" title)
+ (format ".TL \"%s\" \"%s\" \n%s\n"
+ (or subtitle1 "")
+ (or subtitle2 "") " "))
+
+ ((not (or subtitle1 subtitle2))
+ (format ".TL\n%s\n"
+ (or title "")))
+ (t
+ (format ".TL \"%s\" \"%s \" \n%s\n"
+ (or subtitle1 "")
+ (or subtitle2 "") title))))
+
+ ;; 3. Author.
+ ;; In Groff, .AU *MUST* be placed after .TL
+ ;; If From, populate with data from From else
+ ;;
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info)))
+ (from-data (org-e-groff--get-tagged-content "FROM" info))
+
+ (to-data (org-e-groff--get-tagged-content "TO" info)))
+
+ (cond
+ ((and author from-data)
+ (let ((au-line
+ (mapconcat
+ (lambda (from-line)
+ (format " \"%s\" " from-line))
+ (split-string
+ (setq from-data
+ (replace-regexp-in-string "\\.P\n" "" from-data)) "\n") "")))
+
+ (concat
+ (format ".AU \"%s\" " author) au-line "\n")))
+
+ ((and author email (not (string= "" email)))
+ (format ".AU \"%s\" \"%s\"\n" author email))
+
+ (author (format ".AU \"%s\"\n" author))
+
+ (t ".AU \"\" \n")))
+
+
+ ;; 4. Author Title, if present
+ (let ((at-item (plist-get attr :author-title)))
+ (if (and at-item (stringp at-item))
+ (format ".AT \"%s\" \n" at-item)
+ ""))
+
+ ;; 5. Date.
+ (let ((date (org-export-data (plist-get info :date) info)))
+ (and date (format ".ND \"%s\"\n" date)))
+
+ ;;
+ ;; If Abstract, then Populate Abstract
+ ;;
+
+ (let ((abstract-data (org-e-groff--get-tagged-content "ABSTRACT" info))
+ (to-data (org-e-groff--get-tagged-content "TO" info)))
+ (cond
+ (abstract-data
+ (format ".AS\n%s\n.AE\n" abstract-data))
+ (to-data
+ (format ".AS\n%s\n.AE\n" to-data))))))
+
+(defun org-e-groff--letter-head (title contents attr info)
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info)))
+ (from-data (org-e-groff--get-tagged-content "FROM" info))
+ (at-item (plist-get attr :author-title))
+ (to-data (org-e-groff--get-tagged-content "TO" info)))
+
+
+ ;; If FROM then get data from FROM
+ (setq from-data
+ (replace-regexp-in-string "\\.P\n" "" from-data))
+
+ (setq to-data
+ (replace-regexp-in-string "\\.P\n" "" to-data))
+
+ (concat
+ (cond
+ (from-data
+ (format ".WA \"%s\" \"%s\" \n%s\n.WE\n" author (or at-item "") from-data))
+ ((and author email (not (string= "" email)))
+ (format ".WA \"%s\"\n \"%s\"\n.WE\n" author email))
+ (author (format ".WA \"%s\"\n.WE\n" author))
+ (t ".WA \"\" \n.WE\n"))
+
+ ;; If TO then get data from TO
+
+ (when to-data
+ (format ".IA \n%s\n.IE\n" to-data)))))
+
+
+;;; Template
+
+(defun org-e-groff-template (contents info)
+ "Return complete document string after Groff conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (attr (read
+ (format "(%s)"
+ (mapconcat
+ #'identity
+ (list (plist-get info :groff-class-options))
+ " "))))
+ (class (plist-get info :groff-class))
+ (class-options (plist-get info :groff-class-options))
+ (classes (assoc class org-e-groff-classes))
+ (classes-options (car (last classes)))
+ (heading-option (plist-get classes-options :heading))
+ (type-option (plist-get classes-options :type))
+ (last-option (plist-get classes-options :last-section))
+ (hyphenate (plist-get attr :hyphenate))
+ (justify-right (plist-get attr :justify-right))
+
+ (document-class-string
+ (progn
+ (org-element-normalize-string
+ (let* ((header (nth 1 (assoc class org-e-groff-classes)))
+ (document-class-item (if (stringp header) header "")))
+ document-class-item)))))
+
+
+ (concat
+ (if justify-right
+ (case justify-right
+ ('yes ".SA 1 \n")
+ ('no ".SA 0 \n")
+ (t ""))
+ "")
+
+ (if hyphenate
+ (case hyphenate
+ ('yes ".nr Hy 1 \n")
+ ('no ".nr Hy 0 \n")
+ (t ""))
+ "")
+
+ (cond
+ ((string= type-option "custom") "")
+
+ ((and (stringp document-class-string)
+ (string= type-option "cover"))
+
+ (concat
+ (format ".COVER %s\n" document-class-string)
+ (org-e-groff--mt-head title contents attr info)
+ ".COVEND\n"))
+
+ ((string= type-option "memo")
+ (concat
+ (org-e-groff--mt-head title contents attr info)
+ document-class-string))
+ ((string= type-option "letter")
+ (concat
+ (org-e-groff--letter-head title contents attr info)
+ (let ((sa-item (plist-get attr :salutation))
+ (cn-item (plist-get attr :confidential))
+ (sj-item (plist-get attr :subject))
+ (rn-item (plist-get attr :reference))
+ (at-item (plist-get attr :attention)))
+
+ (concat
+
+ (if (stringp sa-item)
+ (format ".LO SA \"%s\" \n" sa-item)
+ ".LO SA\n")
+
+ (when cn-item
+ (if (stringp cn-item)
+ (format ".LO CN \"%s\"\n" cn-item)
+ ".LO CN\n"))
+
+ (when (and at-item (stringp at-item))
+ (format ".LO AT \"%s\" \n" at-item))
+ (when (and title rn-item)
+ (format ".LO RN \"%s\"\n" title))
+
+ (when (and sj-item (stringp sj-item))
+ (format ".LO SJ \"%s\" \n" sj-item))
+
+
+ ".LT " document-class-string "\n"))))
+
+ (t ""))
+
+ contents
+
+ (cond
+ ((string= last-option "toc")
+ ".TC")
+ ((string= last-option "sign")
+ (let ((fc-item (plist-get attr :closing)))
+ (concat (if (stringp fc-item)
+ (format ".FC \"%s\" \n" fc-item)
+ ".FC\n")
+ ".SG\n")))
+ (t ""))
+
+ (progn
+ (mapconcat
+ (lambda (item)
+ (when (string= (car item) "NS")
+ (replace-regexp-in-string
+ "\\.P\n" "" (cdr item))))
+ (reverse org-e-groff-special-content) "\n")))))
+
+
+
+;;; Transcode Functions
+
+;;; Babel Call
+;;
+;; Babel Calls are ignored.
+
+
+;;; Bold
+
+(defun org-e-groff-bold (bold contents info)
+ "Transcode BOLD from Org to Groff.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (org-e-groff--text-markup contents 'bold))
+
+;;; Center Block
+
+(defun org-e-groff-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-e-groff--wrap-label
+ center-block
+ (format ".DS C \n%s\n.DE" contents)))
+
+;;; Clock
+
+(defun org-e-groff-clock (clock contents info)
+ "Transcode a CLOCK element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ (format "\\fB%s\\fP " org-clock-string)
+ (format org-e-groff-inactive-timestamp-format
+ (concat (org-translate-time (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time (format " (%s)" time)))))))
+
+;;; Code
+
+(defun org-e-groff-code (code contents info)
+ "Transcode a CODE object from Org to Groff.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-groff--text-markup (org-element-property :value code) 'code))
+
+;;; Comments and Comment Blocks are ignored.
+
+;;; Drawer
+
+(defun org-e-groff-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to Groff.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (if (functionp org-e-groff-format-drawer-function)
+ (funcall org-e-groff-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ (org-e-groff--wrap-label drawer output)))
+
+;;; Dynamic Block
+
+(defun org-e-groff-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-e-groff--wrap-label dynamic-block contents))
+
+;;; Entity
+
+(defun org-e-groff-entity (entity contents info)
+ "Transcode an ENTITY object from Org to Groff.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :utf8 entity))) ent))
+
+;;; Example Block
+
+(defun org-e-groff-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-e-groff--wrap-label
+ example-block
+ (format ".DS L\n%s\n.DE"
+ (org-export-format-code-default example-block info))))
+
+;;; Export Block
+
+(defun org-e-groff-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "GROFF")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+;;; Export Snippet
+
+(defun org-e-groff-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-groff)
+ (org-element-property :value export-snippet)))
+
+;;; Fixed Width
+
+(defun org-e-groff-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-groff--wrap-label
+ fixed-width
+ (format "\\fC\n%s\\fP"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+;;; Footnote Definition
+;;
+;; Footnote Definitions are ignored.
+;;
+;; Footnotes are handled automatically in GROFF. Although manual
+;; references can be added, not really required.
+
+(defun org-e-groff-footnote-reference (footnote-reference contents info)
+ ;; Changing from info to footnote-reference
+ (let* ((raw (org-export-get-footnote-definition footnote-reference info))
+ (n (org-export-get-footnote-number footnote-reference info))
+ (data (org-trim (org-export-data raw info)))
+ (ref-id (plist-get (nth 1 footnote-reference) :label)))
+ ;; It is a reference
+ (if (string-match "fn:rl" ref-id)
+ (if (member ref-id org-e-groff-registered-references)
+ (format "\\*[%s]" ref-id)
+ (progn
+ (push ref-id org-e-groff-registered-references)
+ (format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data)))
+ ;; else it is a footnote
+ (format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data))))
+
+;;; Headline
+
+(defun org-e-groff-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to Groff.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((class (plist-get info :groff-class))
+ (level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (classes (assoc class org-e-groff-classes))
+ (classes-options (car (last classes)))
+ (heading-option (plist-get classes-options :heading))
+ (section-fmt
+ (progn
+ (cond
+ ((and (symbolp heading-option)
+ (fboundp heading-option))
+ (funcall heading-option level numberedp))
+ ((> level 7) nil)
+ (t (if numberedp
+ (concat ".H " (number-to-string level) " \"%s\"\n%s")
+ ".HU \"%s\"\n%s")))))
+ ;; End of section-fmt
+ (text (org-export-data (org-element-property :title headline) info))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ ;; Create the headline text along with a no-tag version. The
+ ;; latter is required to remove tags from table of contents.
+ (full-text (if (functionp org-e-groff-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-groff-format-headline-function
+ todo todo-type priority text tags)
+ ;; Default formatting.
+ (concat
+ (when todo
+ (format "\\fB%s\\fP " todo))
+ (when priority (format " [\\#%c] " priority))
+ text
+ (when tags
+ (format " \\fC:%s:\\fP "
+ (mapconcat 'identity tags ":"))))))
+ (full-text-no-tag
+ (if (functionp org-e-groff-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-groff-format-headline-function
+ todo todo-type priority text nil)
+ ;; Default formatting.
+ (concat
+ (when todo (format "\\fB%s\\fP " todo))
+ (when priority (format " [\\#%c] " priority))
+ text)))
+ ;; Associate some \label to the headline for internal links.
+ ;; (headline-label
+ ;; (format "\\label{sec-%s}\n"
+ ;; (mapconcat 'number-to-string
+ ;; (org-export-get-headline-number headline info)
+ ;; "-")))
+ (headline-label "")
+ (pre-blanks
+ (make-string (org-element-property :pre-blank headline) 10)))
+
+ (cond
+ ;; Case 1: Special Tag
+ ((member (car tags) org-e-groff-special-tags)
+ (cond
+ ((string= (car tags) "BODY") contents)
+
+ ((string= (car tags) "NS")
+ (progn
+ (push (cons (car tags)
+ (format ".NS \"%s\" 1 \n%s"
+ (car (org-element-property :title headline))
+ (or contents " ")))
+ org-e-groff-special-content) nil))
+
+ (t
+ (progn
+ (push (cons (car tags) contents) org-e-groff-special-content)
+ nil))))
+
+ ;; Case 2: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+
+ ;; Case 3: This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (let ((low-level-body
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "%s\n" (if numberedp ".AL 1\n" ".DL \n")))
+ ;; Itemize headline
+ ".LI\n" full-text "\n" headline-label pre-blanks contents)))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ (concat "\n.LE")
+ low-level-body))))
+
+ ;; Case 4. Standard headline. Export it as a section.
+ (t
+ (format section-fmt full-text
+ (concat headline-label pre-blanks contents))))))
+
+;;; Horizontal Rule
+;; Not supported
+
+;;; Inline Babel Call
+;;
+;; Inline Babel Calls are ignored.
+
+;;; Inline Src Block
+
+(defun org-e-groff-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block)))
+ (cond
+ (org-e-groff-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory))
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+ (org-lang (org-element-property :language inline-src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-groff-source-highlight-langs)))
+
+ (cmd (concat (expand-file-name "source-highlight")
+ " -s " lst-lang
+ " -f groff_mm_color "
+ " -i " in-file
+ " -o " out-file)))
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
+ code))))
+
+ ;; Do not use a special package: transcode it verbatim.
+ (t
+ (concat ".DS I\n" "\\fC" code "\\fP\n.DE\n")))))
+
+;;; Inlinetask
+
+(defun org-e-groff-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to Groff.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((title (org-export-data (org-element-property :title inlinetask) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (org-element-property :todo-type inlinetask))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))))
+ ;; If `org-e-groff-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-e-groff-format-inlinetask-function)
+ (funcall org-e-groff-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (org-e-groff--wrap-label
+ inlinetask
+ (let ((full-title
+ (concat
+ (when todo (format "\\fB%s\\fP " todo))
+ (when priority (format " [\\#%c] " priority))
+ title
+ (when tags (format " \\fC:%s:\\fP "
+ (mapconcat 'identity tags ":"))))))
+ (format (concat "\n.DS I\n"
+ "%s\n"
+ ".sp"
+ "%s\n"
+ ".DE")
+ full-title contents))))))
+
+;;; Italic
+
+(defun org-e-groff-italic (italic contents info)
+ "Transcode ITALIC from Org to Groff.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (org-e-groff--text-markup contents 'italic))
+
+;;; Item
+
+(defun org-e-groff-item (item contents info)
+ "Transcode an ITEM element from Org to Groff.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((bullet (org-element-property :bullet item))
+ (type (org-element-property
+ :type (org-element-property :parent item)))
+ (checkbox (case (org-element-property :checkbox item)
+ (on "\\o'\\(sq\\(mu'")
+ (off "\\(sq")
+ (trans "\\o'\\(sq\\(mi'")))
+ (tag (let ((tag (org-element-property :tag item)))
+ ;; Check-boxes must belong to the tag.
+ (and tag (format "%s"
+ (concat checkbox
+ (org-export-data tag info)))))))
+
+ (cond
+ ((or checkbox tag)
+ (concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
+ "\n"
+ (org-trim (or contents " "))))
+ ((eq type 'ordered)
+ (concat ".LI"
+ "\n"
+ (org-trim (or contents " "))))
+ (t
+ (let* ((bullet (org-trim bullet))
+ (marker (cond ((string= "-" bullet) "\\(em")
+ ((string= "*" bullet) "\\(bu")
+ (t "\\(dg"))))
+ (concat ".LI " marker "\n"
+ (org-trim (or contents " "))))))))
+
+;;; Keyword
+
+(defun org-e-groff-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "GROFF") value)
+ (t nil))))
+
+;;; Groff Environment
+
+(defun org-e-groff-groff-environment (groff-environment contents info)
+ "Transcode a GROFF-ENVIRONMENT element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((label (org-element-property :name groff-environment))
+ (value (org-remove-indentation
+ (org-element-property :value groff-environment))))
+ (if (not (org-string-nw-p label)) value
+ ;; Environment is labelled: label must be within the environment
+ ;; (otherwise, a reference pointing to that element will count
+ ;; the section instead).
+ (with-temp-buffer
+ (insert value)
+ (goto-char (point-min))
+ (forward-line)
+ (insert (format "%s\n" label))
+ (buffer-string)))))
+
+;;; Groff Fragment
+
+(defun org-e-groff-groff-fragment (groff-fragment contents info)
+ "Transcode a GROFF-FRAGMENT object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value groff-fragment))
+
+;;; Line Break
+
+(defun org-e-groff-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ".br\n")
+
+;;; Link
+;; Inline images just place a call to .PSPIC or .PS/.PE
+;; and load the graph.
+
+(defun org-e-groff-link--inline-image (link info)
+ "Return Groff code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (let* ((parent (org-export-get-parent-element link))
+ (path (let ((raw-path (org-element-property :path link)))
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (expand-file-name raw-path))))
+ (attr (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (org-element-property :attr_groff parent)
+ " "))))
+ (placement
+ (case (plist-get attr :position)
+ ('center "")
+ ('left "-L")
+ ('right "-R")
+ (t "")))
+ (width (or (plist-get attr :width) ""))
+ (height (or (plist-get attr :height) ""))
+
+ (disable-caption (plist-get attr :disable-caption))
+
+ (caption
+ (org-e-groff--caption/label-string
+ (org-element-property :caption parent)
+ (org-element-property :name parent)
+ info)))
+
+ ;; Now clear ATTR from any special keyword and set a default value
+ ;; if nothing is left. Return proper string.
+
+ (concat
+ (cond
+ ((string-match ".\.pic$" path)
+ (format "\n.PS\ncopy \"%s\"\n.PE" path))
+ (t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
+ placement path width height)))
+ (unless disable-caption (format "\n.FG \"%s\"" caption)))))
+
+(defun org-e-groff-link (link desc info)
+ "Transcode a LINK object from Org to Groff.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (imagep (org-export-inline-image-p
+ link org-e-groff-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; Image file.
+ (imagep (org-e-groff-link--inline-image link info))
+ ;; import groff files
+ ((and (string= type "file")
+ (string-match ".\.groff$" raw-path))
+ (concat ".so " raw-path "\n"))
+ ;; Radio link: transcode target's contents and use them as link's
+ ;; description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (format "\\fI [%s] \\fP"
+ (org-export-solidify-link-text path)))))
+
+ ;; Links pointing to an headline: find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination)
+ (format "\\fI file://%s \\fP" destination)))
+ ;; Fuzzy link points nowhere.
+ ('nil
+ (format org-e-groff-link-with-unknown-path-format
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; Fuzzy link points to an invisible target.
+ (keyword nil)
+ ;; LINK points to an headline. If headlines are numbered
+ ;; and the link has no description, display headline's
+ ;; number. Otherwise, display description or headline's
+ ;; title.
+ (headline
+ (let ((label ""))
+ (if (and (plist-get info :section-numbers) (not desc))
+ (format "\\fI%s\\fP" label)
+ (format "\\fI%s\\fP"
+ (or desc
+ (org-export-data
+ (org-element-property :title destination) info))))))
+ ;; Fuzzy link points to a target. Do as above.
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "\\fI%s\\fP" path)
+ (format "%s \\fBat\\fP \\fI%s\\fP" desc path)))))))
+ ;; External link with a description part.
+ ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
+ ;; External link without a description part.
+ (path (format "\\fI%s\\fP" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format org-e-groff-link-with-unknown-path-format desc)))))
+
+;;; Macro
+
+(defun org-e-groff-macro (macro contents info)
+ "Transcode a MACRO element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+;;; Paragraph
+
+(defun org-e-groff-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to Groff.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let ((parent (plist-get (nth 1 paragraph) :parent)))
+ (when parent
+ (let* ((parent-type (car parent))
+ (fixed-paragraph "")
+ (class (plist-get info :groff-class))
+ (class-options (plist-get info :groff-class-options))
+ (classes (assoc class org-e-groff-classes))
+ (classes-options (car (last classes)))
+ (paragraph-option (plist-get classes-options :paragraph)))
+ (cond
+ ((and (symbolp paragraph-option)
+ (fboundp paragraph-option))
+ (funcall paragraph-option parent-type parent contents))
+ ((and (eq parent-type 'item)
+ (plist-get (nth 1 parent) :bullet))
+ (setq fixed-paragraph (concat "" contents)))
+ ((eq parent-type 'section)
+ (setq fixed-paragraph (concat ".P\n" contents)))
+ ((eq parent-type 'footnote-definition)
+ (setq fixed-paragraph (concat "" contents)))
+ (t (setq fixed-paragraph (concat "" contents))))
+ fixed-paragraph))))
+
+;;; Plain List
+
+(defun org-e-groff-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to Groff.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (attr (mapconcat #'identity
+ (org-element-property :attr_groff plain-list)
+ " "))
+ (groff-type (cond
+ ((eq type 'ordered) ".AL")
+ ((eq type 'unordered) ".BL")
+ ((eq type 'descriptive) ".VL 2.0i"))))
+ (org-e-groff--wrap-label
+ plain-list
+ (format "%s\n%s\n.LE" groff-type contents))))
+
+;;; Plain Text
+
+(defun org-e-groff-plain-text (text info)
+ "Transcode a TEXT string from Org to Groff.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect
+ (setq text (replace-regexp-in-string
+ "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
+ "$\\" text nil t 1))
+ ;; Handle quotation marks
+ (setq text (org-e-groff--quotation-marks text info))
+ ;; Handle Special Characters
+ (if org-e-groff-special-char
+ (dolist (special-char-list org-e-groff-special-char)
+ (setq text
+ (replace-regexp-in-string (car special-char-list)
+ (cdr special-char-list) text))))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" text)))
+ ;; Return value.
+ text)
+
+;;; Planning
+
+(defun org-e-groff-planning (planning contents info)
+ "Transcode a PLANNING element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "\\fR %s \\fP" org-closed-string)
+ (format org-e-groff-inactive-timestamp-format
+ (org-translate-time closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "\\fB %s \\fP" org-deadline-string)
+ (format org-e-groff-active-timestamp-format
+ (org-translate-time deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "\\fR %s \\fP" org-scheduled-string)
+ (format org-e-groff-active-timestamp-format
+ (org-translate-time scheduled)))))))
+ "")
+ ""))
+
+;;; Property Drawer
+
+(defun org-e-groff-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+;;; Quote Block
+
+(defun org-e-groff-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-groff--wrap-label
+ quote-block
+ (format ".DS I\n.I\n%s\n.R\n.DE" contents)))
+
+;;; Quote Section
+
+(defun org-e-groff-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format ".DS L\n\\fI%s\\fP\n.DE\n" value))))
+
+;;; Radio Target
+
+(defun org-e-groff-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to Groff.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "%s - %s"
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+;;; Section
+
+(defun org-e-groff-section (section contents info)
+ "Transcode a SECTION element from Org to Groff.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+;;; Special Block
+
+(defun org-e-groff-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block))))
+ (org-e-groff--wrap-label
+ special-block
+ (format "%s\n" contents))))
+
+;;; Src Block
+
+(defun org-e-groff-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to Groff.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (label (org-element-property :name src-block))
+ (code (org-element-property :value src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-e-groff-custom-lang-environments))))
+ (num-start (case (org-element-property :number-lines src-block)
+ (continued (org-export-get-loc src-block info))
+ (new 0)))
+ (retain-labels (org-element-property :retain-labels src-block))
+ (attr
+ (read (format "(%s)"
+ (mapconcat #'identity
+ (org-element-property :attr_groff src-block)
+ " "))))
+ (disable-caption (plist-get attr :disable-caption)))
+
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-e-groff-source-highlight)
+ (let ((caption-str (org-e-groff--caption/label-string caption label info)))
+ (concat
+ (format ".DS I\n\\fC%s\\fP\n.DE\n"
+ (org-export-format-code-default src-block info))
+ (unless disable-caption (format ".EX \"%s\" " caption-str)))))
+
+ ;; Case 2. Source fontification.
+ (org-e-groff-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory))
+ (caption-str (org-e-groff--caption/label-string caption label info))
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+
+ (org-lang (org-element-property :language src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-groff-source-highlight-langs)))
+
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_mm_color "
+ " -i " in-file
+ " -o " out-file)))
+
+ (concat
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ (format "%s\n" code-block))
+ (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
+ code))
+ (unless disable-caption (format ".EX \"%s\" " caption-str))))))))
+
+
+;;; Statistics Cookie
+
+(defun org-e-groff-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+
+;;; Strike-Through
+
+(defun org-e-groff-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Groff.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (org-e-groff--text-markup contents 'strike-through))
+
+;;; Subscript
+
+(defun org-e-groff-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to Groff.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\d\\s-2%s\\s+2\\u" contents))
+
+;;; Superscript "^_%s$
+
+(defun org-e-groff-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to Groff.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\u\\s-2%s\\s+2\\d" contents))
+
+
+;;; Table
+;;
+;; `org-e-groff-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" attribute. Otherwise, it
+;; delegates the job to `org-e-groff-table--org-table' function,
+;; depending of the type of the table.
+;;
+;; `org-e-groff-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-e-groff-table (table contents info)
+ "Transcode a TABLE element from Org to Groff.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (cond
+ ;; Case 1: verbatim table.
+ ((or org-e-groff-tables-verbatim
+ (let ((attr (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (org-element-property :attr_groff table) " ")))))
+ (and attr (plist-get attr :verbatim))))
+
+ (format ".DS L\n\\fC%s\\fP\n.DE"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+
+ ;; Case 2: Standard table.
+ (t (org-e-groff-table--org-table table contents info))))
+
+(defun org-e-groff-table--align-string (divider table info)
+ "Return an appropriate Groff alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (let (alignment)
+ ;; Extract column groups and alignment from first (non-rule)
+ ;; row.
+ (org-element-map
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row) 'standard) row))
+ info 'first-match)
+ 'table-cell
+ (lambda (cell)
+ (let* ((borders (org-export-table-cell-borders cell info))
+ (raw-width (org-export-table-cell-width cell info))
+ (width-cm (when raw-width (/ raw-width 5)))
+ (width (if raw-width (format "w(%dc)"
+ (if (< width-cm 1) 1 width-cm)) "")))
+ ;; Check left border for the first cell only.
+ ;; Alignment is nil on assignment
+
+ (when (and (memq 'left borders) (not alignment))
+ (push "|" alignment))
+ (push
+ (case (org-export-table-cell-alignment cell info)
+ (left (concat "l" width divider))
+ (right (concat "r" width divider))
+ (center (concat "c" width divider)))
+ alignment)
+ (when (memq 'right borders) (push "|" alignment))))
+ info)
+ (apply 'concat (reverse alignment))))
+
+(defun org-e-groff-table--org-table (table contents info)
+ "Return appropriate Groff code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' attribute."
+ (let* ((label (org-element-property :name table))
+ (caption (org-e-groff--caption/label-string
+ (org-element-property :caption table) label info))
+ (attr (read (format "(%s)"
+ (mapconcat #'identity
+ (org-element-property :attr_groff table)
+ " "))))
+ (divider (if (plist-get attr :divider) "|" " "))
+
+ ;; Determine alignment string.
+ (alignment (org-e-groff-table--align-string divider table info))
+
+ ;; Extract others display options.
+
+ (lines (org-split-string contents "\n"))
+
+ (attr-list
+ (let (result-list)
+ (dolist (attr-item
+ (list
+ (if (plist-get attr :expand)
+ "expand" nil)
+
+ (case (plist-get attr :placement)
+ ('center "center")
+ ('left nil)
+ (t
+ (if org-e-groff-tables-centered
+ "center" "")))
+
+ (case (plist-get attr :boxtype)
+ ('box "box")
+ ('doublebox "doublebox")
+ ('allbox "allbox")
+ ('none nil)
+ (t "box"))))
+
+ (if (not (null attr-item))
+ (add-to-list 'result-list attr-item)))
+ result-list))
+
+ (title-line (plist-get attr :title-line))
+ (disable-caption (plist-get attr :disable-caption))
+ (long-cells (plist-get attr :long-cells))
+
+ (table-format
+ (concat
+ (format "%s"
+ (or (car attr-list) ""))
+ (or
+ (let (output-list)
+ (when (cdr attr-list)
+ (dolist (attr-item (cdr attr-list))
+ (setq output-list (concat output-list
+ (format ",%s" attr-item)))))
+ output-list) "")))
+ (first-line
+ (when lines (org-split-string (car lines) "\t"))))
+ ;; Prepare the final format string for the table.
+
+
+ (cond
+ ;; Others.
+ (lines
+ (concat ".TS\n " table-format ";\n"
+ (format "%s.\n"
+ (let ((final-line ""))
+ (when title-line
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "cb" divider))))
+
+ (setq final-line (concat final-line "\n"))
+
+ (if alignment
+ (setq final-line (concat final-line alignment))
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "c" divider))))
+ final-line))
+
+ (format "%s\n.TE\n"
+ (let ((final-line "")
+ (long-line "")
+ (lines (org-split-string contents "\n")))
+
+ (dolist (line-item lines)
+ (setq long-line "")
+
+ (if long-cells
+ (progn
+ (if (string= line-item "_")
+ (setq long-line (format "%s\n" line-item))
+ ;; else string =
+ (let ((cell-item-list (org-split-string line-item "\t")))
+ (dolist (cell-item cell-item-list)
+
+ (cond ((eq cell-item (car (last cell-item-list)))
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t\n" cell-item))))
+ (t
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t" cell-item))))))
+ long-line))
+ ;; else long cells
+ (setq final-line (concat final-line long-line)))
+
+ (setq final-line (concat final-line line-item "\n"))))
+ final-line))
+
+ (if (not disable-caption)
+ (format ".TB \"%s\""
+ caption) ""))))))
+
+;;; Table Cell
+
+(defun org-e-groff-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to Groff
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (progn
+ (concat (if (and contents
+ org-e-groff-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-e-groff-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) "\t"))))
+
+
+;;; Table Row
+
+(defun org-e-groff-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to Groff
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((attr (mapconcat 'identity
+ (org-element-property
+ :attr_groff (org-export-get-parent table-row))
+ " "))
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (borders
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (concat
+ ;; Mark horizontal lines
+ (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
+ contents
+ (cond
+ ;; When BOOKTABS are activated enforce bottom rule even when
+ ;; no hline was specifically marked.
+ ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
+ ((memq 'below borders) "\n_"))))))
+
+;;; Target
+
+(defun org-e-groff-target (target contents info)
+ "Transcode a TARGET object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\fI%s\\fP"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+;;; Timestamp
+
+(defun org-e-groff-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to Groff.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-translate-time (org-element-property :value timestamp)))
+ (type (org-element-property :type timestamp)))
+ (cond ((memq type '(active active-range))
+ (format org-e-groff-active-timestamp-format value))
+ ((memq type '(inactive inactive-range))
+ (format org-e-groff-inactive-timestamp-format value))
+ (t (format org-e-groff-diary-timestamp-format value)))))
+
+;;; Underline
+
+(defun org-e-groff-underline (underline contents info)
+ "Transcode UNDERLINE from Org to Groff.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (org-e-groff--text-markup contents 'underline))
+
+;;; Verbatim
+
+(defun org-e-groff-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to Groff.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-groff--text-markup (org-element-property :value verbatim) 'verbatim))
+
+;;; Verse Block
+
+(defun org-e-groff-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to Groff.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (format ".DS C\n.ft HI\n%s\n.ft\n.DE" contents))
+
+
+;;; Interactive functions
+
+(defun org-e-groff-export-to-groff
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a Groff file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (setq org-e-groff-registered-references nil)
+ (setq org-e-groff-special-content nil)
+ (let ((outfile (org-export-output-file-name ".groff" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-groff outfile subtreep visible-only body-only ext-plist)))
+
+(defun org-e-groff-export-to-pdf
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to Groff then process through to PDF.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return PDF file's name."
+ (interactive)
+ (org-e-groff-compile
+ (org-e-groff-export-to-groff
+ subtreep visible-only body-only ext-plist pub-dir)))
+
+(defun org-e-groff-compile (grofffile)
+ "Compile a Groff file.
+
+GROFFFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-e-groff-pdf-process'.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((wconfig (current-window-configuration))
+ (grofffile (file-truename grofffile))
+ (base (file-name-sans-extension grofffile))
+ errors)
+ (message (format "Processing Groff file %s ..." grofffile))
+ (unwind-protect
+ (progn
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-e-groff-pdf-process)
+ (funcall org-e-groff-pdf-process (shell-quote-argument grofffile)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org PDF Groff Output*" buffer.
+ ((consp org-e-groff-pdf-process)
+ (let* ((out-dir (or (file-name-directory grofffile) "./"))
+ (outbuf (get-buffer-create "*Org PDF Groff Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument grofffile)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t)
+ t t) t t)
+ outbuf))
+ org-e-groff-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-e-groff-collect-errors outbuf))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat base ".pdf")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p pdffile))
+ (error (concat (format "PDF file %s wasn't produced" pdffile)
+ (when errors (concat ": " errors))))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when org-e-groff-remove-logfiles
+ (dolist (ext org-e-groff-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))
+ (set-window-configuration wconfig))))
+
+(defun org-e-groff-collect-errors (buffer)
+ "Collect some kind of errors from \"groff\" output
+BUFFER is the buffer containing output.
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ ;; Find final run
+ nil)))
+
+
+(provide 'org-e-groff)
+;;; org-e-groff.el ends here
diff --git a/contrib/lisp/org-e-html.el b/contrib/lisp/org-e-html.el
new file mode 100644
index 0000000..f0ba5f9
--- /dev/null
+++ b/contrib/lisp/org-e-html.el
@@ -0,0 +1,3044 @@
+;;; org-e-html.el --- HTML Back-End For Org Export Engine
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a HTML back-end for Org generic exporter.
+
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'e-html "*Test e-HTML*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the HTML
+;; export. See contrib/lisp/org-export.el for more details on how
+;; this exporter works.
+
+;;; Code:
+
+;;; org-e-html.el
+;;; Dependencies
+
+(require 'org-export)
+(require 'format-spec)
+(eval-when-compile (require 'cl) (require 'table))
+
+
+
+;;; Function Declarations
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function htmlize-region "ext:htmlize" (beg end))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+
+;;; Define Back-End
+
+(org-export-define-backend e-html
+ ((bold . org-e-html-bold)
+ (center-block . org-e-html-center-block)
+ (clock . org-e-html-clock)
+ (code . org-e-html-code)
+ (drawer . org-e-html-drawer)
+ (dynamic-block . org-e-html-dynamic-block)
+ (entity . org-e-html-entity)
+ (example-block . org-e-html-example-block)
+ (export-block . org-e-html-export-block)
+ (export-snippet . org-e-html-export-snippet)
+ (fixed-width . org-e-html-fixed-width)
+ (footnote-definition . org-e-html-footnote-definition)
+ (footnote-reference . org-e-html-footnote-reference)
+ (headline . org-e-html-headline)
+ (horizontal-rule . org-e-html-horizontal-rule)
+ (inline-src-block . org-e-html-inline-src-block)
+ (inlinetask . org-e-html-inlinetask)
+ (italic . org-e-html-italic)
+ (item . org-e-html-item)
+ (keyword . org-e-html-keyword)
+ (latex-environment . org-e-html-latex-environment)
+ (latex-fragment . org-e-html-latex-fragment)
+ (line-break . org-e-html-line-break)
+ (link . org-e-html-link)
+ (macro . org-e-html-macro)
+ (paragraph . org-e-html-paragraph)
+ (plain-list . org-e-html-plain-list)
+ (plain-text . org-e-html-plain-text)
+ (planning . org-e-html-planning)
+ (property-drawer . org-e-html-property-drawer)
+ (quote-block . org-e-html-quote-block)
+ (quote-section . org-e-html-quote-section)
+ (radio-target . org-e-html-radio-target)
+ (section . org-e-html-section)
+ (special-block . org-e-html-special-block)
+ (src-block . org-e-html-src-block)
+ (statistics-cookie . org-e-html-statistics-cookie)
+ (strike-through . org-e-html-strike-through)
+ (subscript . org-e-html-subscript)
+ (superscript . org-e-html-superscript)
+ (table . org-e-html-table)
+ (table-cell . org-e-html-table-cell)
+ (table-row . org-e-html-table-row)
+ (target . org-e-html-target)
+ (template . org-e-html-template)
+ (timestamp . org-e-html-timestamp)
+ (underline . org-e-html-underline)
+ (verbatim . org-e-html-verbatim)
+ (verse-block . org-e-html-verse-block))
+ :export-block "HTML"
+ :filters-alist ((:filter-final-output . org-e-html-final-function))
+ :options-alist
+ ;; FIXME: Prefix KEYWORD and OPTION with "HTML_". Prefix
+ ;; corresponding properties with `:html-". If such a renaming is
+ ;; taken up, some changes will be required in `org-jsinfo.el',
+ ;; I think. So defer renaming for now.
+ ((:agenda-style nil nil org-agenda-export-html-style)
+ (:creator "CREATOR" nil org-e-html-creator-string)
+ (:convert-org-links nil nil org-e-html-link-org-files-as-html)
+ ;; (:expand-quoted-html nil "@" org-e-html-expand)
+ (:inline-images nil nil org-e-html-inline-images)
+ (:link-home "LINK_HOME" nil org-e-html-link-home)
+ (:link-up "LINK_UP" nil org-e-html-link-up)
+ (:style nil nil org-e-html-style)
+ (:style-extra "STYLE" nil org-e-html-style-extra newline)
+ (:style-include-default nil nil org-e-html-style-include-default)
+ (:style-include-scripts nil nil org-e-html-style-include-scripts)
+ ;; (:timestamp nil nil org-e-html-with-timestamp)
+ (:html-extension nil nil org-e-html-extension)
+ (:html-postamble nil nil org-e-html-postamble)
+ (:html-preamble nil nil org-e-html-preamble)
+ (:html-table-tag nil nil org-e-html-table-tag)
+ (:xml-declaration nil nil org-e-html-xml-declaration)
+ (:LaTeX-fragments nil "LaTeX" org-export-with-LaTeX-fragments)
+ (:mathjax "MATHJAX" nil "" space)))
+
+
+
+;;; Internal Variables
+
+;; FIXME: it already exists in org-e-html.el
+(defconst org-e-html-cvt-link-fn
+ nil
+ "Function to convert link URLs to exportable URLs.
+Takes two arguments, TYPE and PATH.
+Returns exportable url as (TYPE PATH), or nil to signal that it
+didn't handle this case.
+Intended to be locally bound around a call to `org-export-as-html'." )
+
+(defvar org-e-html-format-table-no-css)
+(defvar htmlize-buffer-places) ; from htmlize.el
+(defvar body-only) ; dynamically scoped into this.
+
+(defconst org-e-html-special-string-regexps
+ '(("\\\\-" . "&shy;")
+ ("---\\([^-]\\)" . "&mdash;\\1")
+ ("--\\([^-]\\)" . "&ndash;\\1")
+ ("\\.\\.\\." . "&hellip;"))
+ "Regular expressions for special string conversion.")
+
+
+(defconst org-e-html-scripts
+"<script type=\"text/javascript\">
+<!--/*--><![CDATA[/*><!--*/
+ function CodeHighlightOn(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.cacheClassElem = elem.className;
+ elem.cacheClassTarget = target.className;
+ target.className = \"code-highlighted\";
+ elem.className = \"code-highlighted\";
+ }
+ }
+ function CodeHighlightOff(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(elem.cacheClassElem)
+ elem.className = elem.cacheClassElem;
+ if(elem.cacheClassTarget)
+ target.className = elem.cacheClassTarget;
+ }
+/*]]>*///-->
+</script>"
+"Basic JavaScript that is needed by HTML files produced by Org-mode.")
+
+
+(defconst org-e-html-style-default
+"<style type=\"text/css\">
+ <!--/*--><![CDATA[/*><!--*/
+ html { font-family: Times, serif; font-size: 12pt; }
+ .title { text-align: center; }
+ .todo { color: red; }
+ .done { color: green; }
+ .tag { background-color: #add8e6; font-weight:normal }
+ .target { }
+ .timestamp { color: #bebebe; }
+ .timestamp-kwd { color: #5f9ea0; }
+ .right {margin-left:auto; margin-right:0px; text-align:right;}
+ .left {margin-left:0px; margin-right:auto; text-align:left;}
+ .center {margin-left:auto; margin-right:auto; text-align:center;}
+ p.verse { margin-left: 3% }
+ pre {
+ border: 1pt solid #AEBDCC;
+ background-color: #F3F5F7;
+ padding: 5pt;
+ font-family: courier, monospace;
+ font-size: 90%;
+ overflow:auto;
+ }
+ table { border-collapse: collapse; }
+ td, th { vertical-align: top; }
+ th.right { text-align:center; }
+ th.left { text-align:center; }
+ th.center { text-align:center; }
+ td.right { text-align:right; }
+ td.left { text-align:left; }
+ td.center { text-align:center; }
+ dt { font-weight: bold; }
+ div.figure { padding: 0.5em; }
+ div.figure p { text-align: center; }
+ div.inlinetask {
+ padding:10px;
+ border:2px solid gray;
+ margin:10px;
+ background: #ffffcc;
+ }
+ textarea { overflow-x: auto; }
+ .linenr { font-size:smaller }
+ .code-highlighted {background-color:#ffff00;}
+ .org-info-js_info-navigation { border-style:none; }
+ #org-info-js_console-label { font-size:10px; font-weight:bold;
+ white-space:nowrap; }
+ .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
+ font-weight:bold; }
+ /*]]>*/-->
+</style>"
+ "The default style specification for exported HTML files.
+Please use the variables `org-e-html-style' and
+`org-e-html-style-extra' to add to this style. If you wish to not
+have the default style included, customize the variable
+`org-e-html-style-include-default'.")
+
+
+
+(defvar org-e-html-content-div "content"
+ "The name of the container DIV that holds all the page contents.
+
+This variable is obsolete since Org version 7.7.
+Please set `org-e-html-divs' instead.")
+
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-e-html nil
+ "Options for exporting Org mode files to HTML."
+ :tag "Org Export HTML"
+ :group 'org-export)
+
+(defgroup org-export-e-htmlize nil
+ "Options for processing examples with htmlize.el."
+ :tag "Org Export Htmlize"
+ :group 'org-export-e-html)
+
+
+;;;; Bold etc
+
+(defcustom org-e-html-text-markup-alist
+ '((bold . "<b>%s</b>")
+ (code . "<code>%s</code>")
+ (italic . "<i>%s</i>")
+ (strike-through . "<del>%s</del>")
+ (underline . "<span style=\"text-decoration:underline;\">%s</span>")
+ (verbatim . "<code>%s</code>"))
+ "Alist of HTML expressions to convert text markup
+
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underline' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-e-html
+ :type '(alist :key-type (symbol :tag "Markup type")
+ :value-type (string :tag "Format string"))
+ :options '(bold code italic strike-through underline verbatim))
+
+
+;;;; Debugging
+
+(defcustom org-e-html-pretty-output nil
+ "Enable this to generate pretty HTML."
+ :group 'org-export-e-html
+ :type 'boolean)
+
+
+;;;; Drawers
+
+(defcustom org-e-html-format-drawer-function nil
+ "Function called to format a drawer in HTML code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-html-format-drawer-default \(name contents\)
+ \"Format a drawer element for HTML export.\"
+ contents\)"
+ :group 'org-export-e-html
+ :type 'function)
+
+
+;;;; Footnotes
+
+(defcustom org-e-html-footnotes-section "<div id=\"footnotes\">
+<h2 class=\"footnotes\">%s: </h2>
+<div id=\"text-footnotes\">
+%s
+</div>
+</div>"
+ "Format for the footnotes section.
+Should contain a two instances of %s. The first will be replaced with the
+language-specific word for \"Footnotes\", the second one will be replaced
+by the footnotes themselves."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-footnote-format "<sup>%s</sup>"
+ "The format for the footnote reference.
+%s will be replaced by the footnote reference itself."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-footnote-separator "<sup>, </sup>"
+ "Text used to separate footnotes."
+ :group 'org-export-e-html
+ :type 'string)
+
+
+;;;; Headline
+
+(defcustom org-e-html-toplevel-hlevel 2
+ "The <H> level for level 1 headings in HTML export.
+This is also important for the classes that will be wrapped around headlines
+and outline structure. If this variable is 1, the top-level headlines will
+be <h1>, and the corresponding classes will be outline-1, section-number-1,
+and outline-text-1. If this is 2, all of these will get a 2 instead.
+The default for this variable is 2, because we use <h1> for formatting the
+document title."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-format-headline-function nil
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags (string or nil).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-e-html-format-headline \(todo todo-type priority text tags)
+ \"Default format function for an headline.\"
+ \(concat \(when todo
+ \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
+ \(when priority
+ \(format \"\\\\framebox{\\\\#%c} \" priority))
+ text
+ \(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags))))"
+ :group 'org-export-e-html
+ :type 'function)
+
+
+;;;; HTML-specific
+
+(defcustom org-e-html-allow-name-attribute-in-anchors t
+ "When nil, do not set \"name\" attribute in anchors.
+By default, anchors are formatted with both \"id\" and \"name\"
+attributes, when appropriate."
+ :group 'org-export-e-html
+ :type 'boolean)
+
+
+;;;; Inlinetasks
+
+(defcustom org-e-html-format-inlinetask-function nil
+ "Function called to format an inlinetask in HTML code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-html-format-inlinetask \(todo type priority name tags contents\)
+\"Format an inline task element for HTML export.\"
+ \(let \(\(full-title
+ \(concat
+ \(when todo
+ \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
+ \(when priority (format \"\\\\framebox{\\\\#%c} \" priority))
+ title
+ \(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags)))))
+ \(format (concat \"\\\\begin{center}\\n\"
+ \"\\\\fbox{\\n\"
+ \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
+ \"%s\\n\\n\"
+ \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
+ \"%s\"
+ \"\\\\end{minipage}}\"
+ \"\\\\end{center}\")
+ full-title contents))"
+ :group 'org-export-e-html
+ :type 'function)
+
+
+;;;; Links :: Generic
+
+(defcustom org-e-html-link-org-files-as-html t
+ "Non-nil means make file links to `file.org' point to `file.html'.
+When org-mode is exporting an org-mode file to HTML, links to
+non-html files are directly put into a href tag in HTML.
+However, links to other Org-mode files (recognized by the
+extension `.org.) should become links to the corresponding html
+file, assuming that the linked org-mode file will also be
+converted to HTML.
+When nil, the links still point to the plain `.org' file."
+ :group 'org-export-e-html
+ :type 'boolean)
+
+
+;;;; Links :: Inline images
+
+(defcustom org-e-html-inline-images 'maybe
+ "Non-nil means inline images into exported HTML pages.
+This is done using an <img> tag. When nil, an anchor with href is used to
+link to the image. If this option is `maybe', then images in links with
+an empty description will be inlined, while images with a description will
+be linked only."
+ :group 'org-export-e-html
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When there is no description" maybe)))
+
+(defcustom org-e-html-inline-image-rules
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
+ ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
+ ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
+ "Rules characterizing image files that can be inlined into HTML.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path.
+
+Note that, by default, the image extension *actually* allowed
+depend on the way the HTML file is processed. When used with
+pdflatex, pdf, jpg and png images are OK. When processing
+through dvi to Postscript, only ps and eps are allowed. The
+default we use here encompasses both."
+ :group 'org-export-e-html
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+
+;;;; Plain Text
+
+(defcustom org-e-html-protect-char-alist
+ '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;"))
+ "Alist of characters to be converted by `org-e-html-protect'."
+ :group 'org-export-e-html
+ :type '(repeat (cons (string :tag "Character")
+ (string :tag "HTML equivalent"))))
+
+(defcustom org-e-html-quotes
+ '(("fr"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "&laquo;&nbsp;")
+ ("\\(\\S-\\)\"" . "&nbsp;&raquo;")
+ ("\\(\\s-\\|(\\|^\\)'" . "&rsquo;"))
+ ("en"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "&ldquo;")
+ ("\\(\\S-\\)\"" . "&rdquo;")
+ ("\\(\\s-\\|(\\|^\\)'" . "&lsquo;")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-html
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+
+;;;; Src Block
+
+(defcustom org-export-e-htmlize-output-type 'inline-css
+ "Output type to be used by htmlize when formatting code snippets.
+Choices are `css', to export the CSS selectors only, or `inline-css', to
+export the CSS attribute values inline in the HTML. We use as default
+`inline-css', in order to make the resulting HTML self-containing.
+
+However, this will fail when using Emacs in batch mode for export, because
+then no rich font definitions are in place. It will also not be good if
+people with different Emacs setup contribute HTML files to a website,
+because the fonts will represent the individual setups. In these cases,
+it is much better to let Org/Htmlize assign classes only, and to use
+a style file to define the look of these classes.
+To get a start for your css file, start Emacs session and make sure that
+all the faces you are interested in are defined, for example by loading files
+in all modes you want. Then, use the command
+\\[org-export-e-htmlize-generate-css] to extract class definitions."
+ :group 'org-export-e-htmlize
+ :type '(choice (const css) (const inline-css)))
+
+(defcustom org-export-e-htmlize-css-font-prefix "org-"
+ "The prefix for CSS class names for htmlize font specifications."
+ :group 'org-export-e-htmlize
+ :type 'string)
+
+(defcustom org-export-e-htmlized-org-css-url nil
+ "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer, htmlize will
+create CSS to define the font colors. However, this does not work when
+converting in batch mode, and it also can look bad if different people
+with different fontification setup work on the same website.
+When this variable is non-nil, creating an htmlized version of an Org buffer
+using `org-export-as-org' will remove the internal CSS section and replace it
+with a link to this URL."
+ :group 'org-export-e-htmlize
+ :type '(choice
+ (const :tag "Keep internal css" nil)
+ (string :tag "URL or local href")))
+
+
+;;;; Table
+
+(defcustom org-e-html-table-tag
+ "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
+ "The HTML tag that is used to start a table.
+This must be a <table> tag, but you may change the options like
+borders and spacing."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
+ "The opening tag for table header fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-e-html-table-use-header-tags-for-first-column'.
+See also the variable `org-e-html-table-align-individual-fields'."
+ :group 'org-export-tables ; FIXME: change group?
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-e-html-table-data-tags '("<td%s>" . "</td>")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-e-html-table-align-individual-fields'."
+ :group 'org-export-tables
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-e-html-table-row-tags '("<tr>" . "</tr>")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+Instead of strings, these can be Lisp forms that will be evaluated
+for each row in order to construct the table row tags. During evaluation,
+the variable `head' will be true when this is a header line, nil when this
+is a body line. And the variable `nline' will contain the line number,
+starting from 1 in the first header line. For example
+
+ (setq org-e-html-table-row-tags
+ (cons '(if head
+ \"<tr>\"
+ (if (= (mod nline 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\"))
+ \"</tr>\"))
+
+will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
+ :group 'org-export-tables
+ :type '(cons
+ (choice :tag "Opening tag"
+ (string :tag "Specify")
+ (sexp))
+ (choice :tag "Closing tag"
+ (string :tag "Specify")
+ (sexp))))
+
+(defcustom org-e-html-table-align-individual-fields t
+ "Non-nil means attach style attributes for alignment to each table field.
+When nil, alignment will only be specified in the column tags, but this
+is ignored by some browsers (like Firefox, Safari). Opera does it right
+though."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-e-html-table-use-header-tags-for-first-column nil
+ "Non-nil means format column one in tables with header tags.
+When nil, also column one will use data tags."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-e-html-table-caption-above t
+ "When non-nil, place caption string at the beginning of the table.
+Otherwise, place it near the end."
+ :group 'org-export-e-html
+ :type 'boolean)
+
+
+;;;; Tags
+
+(defcustom org-e-html-tag-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each tag gets a class given by the tag itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-e-html
+ :type 'string)
+
+
+;;;; Template :: Generic
+
+(defcustom org-e-html-extension "html"
+ "The extension for exported HTML files."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-xml-declaration
+ '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
+ ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
+ "The extension for exported HTML files.
+%s will be replaced with the charset of the exported file.
+This may be a string, or an alist with export extensions
+and corresponding declarations."
+ :group 'org-export-e-html
+ :type '(choice
+ (string :tag "Single declaration")
+ (repeat :tag "Dependent on extension"
+ (cons (string :tag "Extension")
+ (string :tag "Declaration")))))
+
+(defcustom org-e-html-coding-system 'utf-8
+ "Coding system for HTML export.
+Use utf-8 as the default value."
+ :group 'org-export-e-html
+ :type 'coding-system)
+
+(defcustom org-e-html-divs '("preamble" "content" "postamble")
+ "The name of the main divs for HTML export.
+This is a list of three strings, the first one for the preamble
+DIV, the second one for the content DIV and the third one for the
+postamble DIV."
+ :group 'org-export-e-html
+ :type '(list
+ (string :tag " Div for the preamble:")
+ (string :tag " Div for the content:")
+ (string :tag "Div for the postamble:")))
+
+
+;;;; Template :: Mathjax
+
+(defcustom org-e-html-mathjax-options
+ '((path "http://orgmode.org/mathjax/MathJax.js")
+ (scale "100")
+ (align "center")
+ (indent "2em")
+ (mathml nil))
+ "Options for MathJax setup.
+
+path The path where to find MathJax
+scale Scaling for the HTML-CSS backend, usually between 100 and 133
+align How to align display math: left, center, or right
+indent If align is not center, how far from the left/right side?
+mathml Should a MathML player be used if available?
+ This is faster and reduces bandwidth use, but currently
+ sometimes has lower spacing quality. Therefore, the default is
+ nil. When browsers get better, this switch can be flipped.
+
+You can also customize this for each buffer, using something like
+
+#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+ :group 'org-export-e-html
+ :type '(list :greedy t
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "mathml (should MathML display be used is possible)"
+ (const :format " " mathml) (boolean))))
+
+(defcustom org-e-html-mathjax-template
+ "<script type=\"text/javascript\" src=\"%PATH\">
+<!--/*--><![CDATA[/*><!--*/
+ MathJax.Hub.Config({
+ // Only one of the two following lines, depending on user settings
+ // First allows browser-native MathML display, second forces HTML/CSS
+ :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
+ :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
+ extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
+ \"TeX/noUndefined.js\"],
+ tex2jax: {
+ inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
+ displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
+ skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
+ ignoreClass: \"tex2jax_ignore\",
+ processEscapes: false,
+ processEnvironments: true,
+ preview: \"TeX\"
+ },
+ showProcessingMessages: true,
+ displayAlign: \"%ALIGN\",
+ displayIndent: \"%INDENT\",
+
+ \"HTML-CSS\": {
+ scale: %SCALE,
+ availableFonts: [\"STIX\",\"TeX\"],
+ preferredFont: \"TeX\",
+ webFont: \"TeX\",
+ imageFont: \"TeX\",
+ showMathMenu: true,
+ },
+ MMLorHTML: {
+ prefer: {
+ MSIE: \"MML\",
+ Firefox: \"MML\",
+ Opera: \"HTML\",
+ other: \"HTML\"
+ }
+ }
+ });
+/*]]>*///-->
+</script>"
+ "The MathJax setup for XHTML files."
+ :group 'org-export-e-html
+ :type 'string)
+
+
+;;;; Template :: Postamble
+
+(defcustom org-e-html-postamble 'auto
+ "Non-nil means insert a postamble in HTML export.
+
+When `t', insert a string as defined by the formatting string in
+`org-e-html-postamble-format'. When set to a string, this
+string overrides `org-e-html-postamble-format'. When set to
+'auto, discard `org-e-html-postamble-format' and honor
+`org-export-author/email/creator-info' variables. When set to a
+function, apply this function and insert the returned string.
+The function takes the property list of export options as its
+only argument.
+
+Setting :html-postamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-e-html
+ :type '(choice (const :tag "No postamble" nil)
+ (const :tag "Auto preamble" 'auto)
+ (const :tag "Default formatting string" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-e-html-postamble-format
+ '(("en" "<p class=\"author\">Author: %a (%e)</p>
+<p class=\"date\">Date: %d</p>
+<p class=\"creator\">Generated by %c</p>
+<p class=\"xhtml-validation\">%v</p>
+"))
+ "The format for the HTML postamble.
+
+%a stands for the author's name.
+%e stands for the author's email.
+%d stands for the date.
+%c will be replaced by information about Org/Emacs versions.
+%v will be replaced by `org-e-html-validation-link'.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-validation-link
+ "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
+ "Link to HTML validation service."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-creator-string
+ (format "Generated by <a href=\"http://orgmode.org\">Org</a> mode %s in <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s."
+ (if (fboundp 'org-version) (org-version) "(Unknown)")
+ emacs-version)
+ "String to insert at the end of the HTML document."
+ :group 'org-export-e-html
+ :type '(string :tag "Creator string"))
+
+
+;;;; Template :: Preamble
+
+(defcustom org-e-html-preamble t
+ "Non-nil means insert a preamble in HTML export.
+
+When `t', insert a string as defined by one of the formatting
+strings in `org-e-html-preamble-format'. When set to a
+string, this string overrides `org-e-html-preamble-format'.
+When set to a function, apply this function and insert the
+returned string. The function takes the property list of export
+options as its only argument.
+
+Setting :html-preamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-e-html
+ :type '(choice (const :tag "No preamble" nil)
+ (const :tag "Default preamble" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-e-html-preamble-format '(("en" ""))
+ "The format for the HTML preamble.
+
+%t stands for the title.
+%a stands for the author's name.
+%e stands for the author's email.
+%d stands for the date.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-e-html
+ :type 'string)
+
+(defcustom org-e-html-link-up ""
+ "Where should the \"UP\" link of exported HTML pages lead?"
+ :group 'org-export-e-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-e-html-link-home ""
+ "Where should the \"HOME\" link of exported HTML pages lead?"
+ :group 'org-export-e-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-e-html-home/up-format
+ "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
+ <a accesskey=\"h\" href=\"%s\"> UP </a>
+ |
+ <a accesskey=\"H\" href=\"%s\"> HOME </a>
+</div>"
+ "Snippet used to insert the HOME and UP links.
+This is a format string, the first %s will receive the UP link,
+the second the HOME link. If both `org-e-html-link-up' and
+`org-e-html-link-home' are empty, the entire snippet will be
+ignored."
+ :group 'org-export-e-html
+ :type 'string)
+
+
+;;;; Template :: Scripts
+
+(defcustom org-e-html-style-include-scripts t
+ "Non-nil means include the JavaScript snippets in exported HTML files.
+The actual script is defined in `org-e-html-scripts' and should
+not be modified."
+ :group 'org-export-e-html
+ :type 'boolean)
+
+
+;;;; Template :: Styles
+
+(defcustom org-e-html-style-include-default t
+ "Non-nil means include the default style in exported HTML files.
+The actual style is defined in `org-e-html-style-default' and should
+not be modified. Use the variables `org-e-html-style' to add
+your own style information."
+ :group 'org-export-e-html
+ :type 'boolean)
+;;;###autoload
+(put 'org-e-html-style-include-default 'safe-local-variable 'booleanp)
+
+(defcustom org-e-html-style ""
+ "Org-wide style definitions for exported HTML files.
+
+This variable needs to contain the full HTML structure to provide a style,
+including the surrounding HTML tags. If you set the value of this variable,
+you should consider to include definitions for the following classes:
+ title, todo, done, timestamp, timestamp-kwd, tag, target.
+
+For example, a valid value would be:
+
+ <style type=\"text/css\">
+ <![CDATA[
+ p { font-weight: normal; color: gray; }
+ h1 { color: black; }
+ .title { text-align: center; }
+ .todo, .timestamp-kwd { color: red; }
+ .done { color: green; }
+ ]]>
+ </style>
+
+If you'd like to refer to an external style file, use something like
+
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
+
+As the value of this option simply gets inserted into the HTML <head> header,
+you can \"misuse\" it to add arbitrary text to the header.
+See also the variable `org-e-html-style-extra'."
+ :group 'org-export-e-html
+ :type 'string)
+;;;###autoload
+(put 'org-e-html-style 'safe-local-variable 'stringp)
+
+(defcustom org-e-html-style-extra ""
+ "Additional style information for HTML export.
+The value of this variable is inserted into the HTML buffer right after
+the value of `org-e-html-style'. Use this variable for per-file
+settings of style information, and do not forget to surround the style
+settings with <style>...</style> tags."
+ :group 'org-export-e-html
+ :type 'string)
+;;;###autoload
+(put 'org-e-html-style-extra 'safe-local-variable 'stringp)
+
+
+;;;; Todos
+
+(defcustom org-e-html-todo-kwd-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each TODO keyword gets a class given by the keyword itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-e-html
+ :type 'string)
+
+
+
+;;; Internal Functions
+
+(defun org-e-html-format-inline-image (src &optional
+ caption label attr standalone-p)
+ (let* ((id (if (not label) ""
+ (format " id=\"%s\"" (org-export-solidify-link-text label))))
+ (attr (concat attr
+ (cond
+ ((string-match "\\<alt=" (or attr "")) "")
+ ((string-match "^ltxpng/" src)
+ (format " alt=\"%s\""
+ (org-e-html-encode-plain-text
+ (org-find-text-property-in-string
+ 'org-latex-src src))))
+ (t (format " alt=\"%s\""
+ (file-name-nondirectory src)))))))
+ (cond
+ (standalone-p
+ (let ((img (format "<img src=\"%s\" %s/>" src attr)))
+ (format "\n<div%s class=\"figure\">%s%s\n</div>"
+ id (format "\n<p>%s</p>" img)
+ (when caption (format "\n<p>%s</p>" caption)))))
+ (t (format "<img src=\"%s\" %s/>" src (concat attr id))))))
+
+;;;; Bibliography
+
+(defun org-e-html-bibliography ()
+ "Find bibliography, cut it out and return it."
+ (catch 'exit
+ (let (beg end (cnt 1) bib)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
+ (setq beg (match-beginning 0))
+ (while (re-search-forward "</?div\\>" nil t)
+ (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
+ (when (= cnt 0)
+ (and (looking-at ">") (forward-char 1))
+ (setq bib (buffer-substring beg (point)))
+ (delete-region beg (point))
+ (throw 'exit bib))))
+ nil))))
+
+;;;; Table
+
+(defun org-e-html-splice-attributes (tag attributes)
+ "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
+ (if (not attributes)
+ tag
+ (let (oldatt newatt)
+ (setq oldatt (org-extract-attributes-from-string tag)
+ tag (pop oldatt)
+ newatt (cdr (org-extract-attributes-from-string attributes)))
+ (while newatt
+ (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
+ (if (string-match ">" tag)
+ (setq tag
+ (replace-match (concat (org-attributes-to-string oldatt) ">")
+ t t tag)))
+ tag)))
+
+(defun org-export-splice-style (style extra)
+ "Splice EXTRA into STYLE, just before \"</style>\"."
+ (if (and (stringp extra)
+ (string-match "\\S-" extra)
+ (string-match "</style>" style))
+ (concat (substring style 0 (match-beginning 0))
+ "\n" extra "\n"
+ (substring style (match-beginning 0)))
+ style))
+
+(defun org-export-e-htmlize-region-for-paste (beg end)
+ "Convert the region to HTML, using htmlize.el.
+This is much like `htmlize-region-for-paste', only that it uses
+the settings define in the org-... variables."
+ (let* ((htmlize-output-type org-export-e-htmlize-output-type)
+ (htmlize-css-name-prefix org-export-e-htmlize-css-font-prefix)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+;;;###autoload
+(defun org-export-e-htmlize-generate-css ()
+ "Create the CSS for all font definitions in the current Emacs session.
+Use this to create face definitions in your CSS style file that can then
+be used by code snippets transformed by htmlize.
+This command just produces a buffer that contains class definitions for all
+faces used in the current Emacs session. You can copy and paste the ones you
+need into your CSS file.
+
+If you then set `org-export-e-htmlize-output-type' to `css', calls to
+the function `org-export-e-htmlize-region-for-paste' will produce code
+that uses these same face definitions."
+ (interactive)
+ (require 'htmlize)
+ (and (get-buffer "*html*") (kill-buffer "*html*"))
+ (with-temp-buffer
+ (let ((fl (face-list))
+ (htmlize-css-name-prefix "org-")
+ (htmlize-output-type 'css)
+ f i)
+ (while (setq f (pop fl)
+ i (and f (face-attribute f :inherit)))
+ (when (and (symbolp f) (or (not i) (not (listp i))))
+ (insert (org-add-props (copy-sequence "1") nil 'face f))))
+ (htmlize-region (point-min) (point-max))))
+ (org-pop-to-buffer-same-window "*html*")
+ (goto-char (point-min))
+ (if (re-search-forward "<style" nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (if (re-search-forward "</style>" nil t)
+ (delete-region (1+ (match-end 0)) (point-max)))
+ (beginning-of-line 1)
+ (if (looking-at " +") (replace-match ""))
+ (goto-char (point-min)))
+
+(defun org-e-html-make-string (n string)
+ (let (out) (dotimes (i n out) (setq out (concat string out)))))
+
+(defun org-e-html-toc-text (toc-entries)
+ (let* ((prev-level (1- (nth 1 (car toc-entries))))
+ (start-level prev-level))
+ (concat
+ (mapconcat
+ (lambda (entry)
+ (let ((headline (nth 0 entry))
+ (level (nth 1 entry)))
+ (concat
+ (let* ((cnt (- level prev-level))
+ (times (if (> cnt 0) (1- cnt) (- cnt)))
+ rtn)
+ (setq prev-level level)
+ (concat
+ (org-e-html-make-string
+ times (cond ((> cnt 0) "\n<ul>\n<li>")
+ ((< cnt 0) "</li>\n</ul>\n")))
+ (if (> cnt 0) "\n<ul>\n<li>" "</li>\n<li>")))
+ headline)))
+ toc-entries "")
+ (org-e-html-make-string
+ (- prev-level start-level) "</li>\n</ul>\n"))))
+
+(defun* org-e-html-format-toc-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (let ((headline (concat
+ section-number (and section-number ". ")
+ text
+ (and tags "&nbsp;&nbsp;&nbsp;") (org-e-html--tags tags))))
+ (format "<a href=\"#%s\">%s</a>"
+ (org-export-solidify-link-text headline-label)
+ (if (not nil) headline
+ (format "<span class=\"%s\">%s</span>" todo-type headline)))))
+
+(defun org-e-html-toc (depth info)
+ (let* ((headlines (org-export-collect-headlines info depth))
+ (toc-entries
+ (loop for headline in headlines collect
+ (list (org-e-html-format-headline--wrap
+ headline info 'org-e-html-format-toc-headline)
+ (org-export-get-relative-level headline info)))))
+ (when toc-entries
+ (concat
+ "<div id=\"table-of-contents\">\n"
+ (format "<h%d>%s</h%d>\n"
+ org-e-html-toplevel-hlevel
+ (org-e-html--translate "Table of Contents" info)
+ org-e-html-toplevel-hlevel)
+ "<div id=\"text-table-of-contents\">"
+ (org-e-html-toc-text toc-entries)
+ "</div>\n"
+ "</div>\n"))))
+
+(defun org-e-html-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword into a valid class name.
+Replaces invalid characters with \"_\"."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ kwd)
+
+(defun org-e-html-format-footnote-reference (n def refcnt)
+ (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt))))
+ (format org-e-html-footnote-format
+ (let* ((id (format "fnr.%s%s" n extra))
+ (href (format " href=\"#fn.%s\"" n))
+ (attributes (concat " class=\"footref\"" href)))
+ (org-e-html--anchor id n attributes)))))
+
+(defun org-e-html-format-footnotes-section (section-name definitions)
+ (if (not definitions) ""
+ (format org-e-html-footnotes-section section-name definitions)))
+
+(defun org-e-html-format-footnote-definition (fn)
+ (let ((n (car fn)) (def (cdr fn)))
+ (format
+ "<tr>\n<td>%s</td>\n<td>%s</td>\n</tr>\n"
+ (format org-e-html-footnote-format
+ (let* ((id (format "fn.%s" n))
+ (href (format " href=\"#fnr.%s\"" n))
+ (attributes (concat " class=\"footnum\"" href)))
+ (org-e-html--anchor id n attributes)))
+ def)))
+
+(defun org-e-html-footnote-section (info)
+ (let* ((fn-alist (org-export-collect-footnote-definitions
+ (plist-get info :parse-tree) info))
+
+ (fn-alist
+ (loop for (n type raw) in fn-alist collect
+ (cons n (if (eq (org-element-type raw) 'org-data)
+ (org-trim (org-export-data raw info))
+ (format "<p>%s</p>"
+ (org-trim (org-export-data raw info))))))))
+ (when fn-alist
+ (org-e-html-format-footnotes-section
+ (org-e-html--translate "Footnotes" info)
+ (format
+ "<table>\n%s\n</table>\n"
+ (mapconcat 'org-e-html-format-footnote-definition fn-alist "\n"))))))
+
+(defun org-e-html-format-date (info)
+ (let ((date (org-export-data (plist-get info :date) info)))
+ (cond
+ ((and date (string-match "%" date))
+ (format-time-string date))
+ (date date)
+ (t (format-time-string "%Y-%m-%d %T %Z")))))
+
+(defun org-e-html--caption/label-string (caption label info)
+ "Return caption and label HTML string for floats.
+
+CAPTION is a cons cell of secondary strings, the car being the
+standard caption and the cdr its short form. LABEL is a string
+representing the label. INFO is a plist holding contextual
+information.
+
+If there's no caption nor label, return the empty string.
+
+For non-floats, see `org-e-html--wrap-label'."
+ (setq label nil) ;; FIXME
+
+ (let ((label-str (if label (format "\\label{%s}" label) "")))
+ (cond
+ ((and (not caption) (not label)) "")
+ ((not caption) (format "\\label{%s}\n" label))
+ ;; Option caption format with short name.
+ ((cdr caption)
+ (format "\\caption[%s]{%s%s}\n"
+ (org-export-data (cdr caption) info)
+ label-str
+ (org-export-data (car caption) info)))
+ ;; Standard caption format.
+ ;; (t (format "\\caption{%s%s}\n"
+ ;; label-str
+ ;; (org-export-data (car caption) info)))
+ (t (org-export-data (car caption) info)))))
+
+(defun org-e-html--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-e-html--quotation-marks (text info)
+ "Export quotation marks depending on language conventions.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr (or (assoc (plist-get info :language) org-e-html-quotes)
+ ;; Falls back on English.
+ (assoc "en" org-e-html-quotes))))
+ text)
+
+(defun org-e-html--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-e-html--caption/label-string'."
+ ;; (let ((label (org-element-property :name element)))
+ ;; (if (or (not output) (not label) (string= output "") (string= label ""))
+ ;; output
+ ;; (concat (format "\\label{%s}\n" label) output)))
+ output)
+
+
+
+;;; Template
+
+(defun org-e-html-meta-info (info)
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (description (plist-get info :description))
+ (keywords (plist-get info :keywords)))
+ (concat
+ (format "\n<title>%s</title>\n" title)
+ (format
+ "\n<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>"
+ (or (and org-e-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-e-html-coding-system
+ 'mime-charset))
+ "iso-8859-1"))
+ (format "\n<meta name=\"title\" content=\"%s\"/>" title)
+ (format "\n<meta name=\"generator\" content=\"Org-mode\"/>")
+ (format "\n<meta name=\"generated\" content=\"%s\"/>"
+ (org-e-html-format-date info))
+ (format "\n<meta name=\"author\" content=\"%s\"/>" author)
+ (format "\n<meta name=\"description\" content=\"%s\"/>" description)
+ (format "\n<meta name=\"keywords\" content=\"%s\"/>" keywords))))
+
+(defun org-e-html-style (info)
+ (concat
+ "\n" (when (plist-get info :style-include-default) org-e-html-style-default)
+ (plist-get info :style)
+ (plist-get info :style-extra)
+ "\n"
+ (when (plist-get info :style-include-scripts)
+ org-e-html-scripts)))
+
+(defun org-e-html-mathjax-config (info)
+ "Insert the user setup into the matchjax template."
+ (when (member (plist-get info :LaTeX-fragments) '(mathjax t))
+ (let ((template org-e-html-mathjax-template)
+ (options org-e-html-mathjax-options)
+ (in-buffer (or (plist-get info :mathjax) ""))
+ name val (yes " ") (no "// ") x)
+ (mapc
+ (lambda (e)
+ (setq name (car e) val (nth 1 e))
+ (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ (if (not (stringp val)) (setq val (format "%s" val)))
+ (if (string-match (concat "%" (upcase (symbol-name name))) template)
+ (setq template (replace-match val t t template))))
+ options)
+ (setq val (nth 1 (assq 'mathml options)))
+ (if (string-match (concat "\\<mathml:") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ ;; Exchange prefixes depending on mathml setting
+ (if (not val) (setq x yes yes no no x))
+ ;; Replace cookies to turn on or off the config/jax lines
+ (if (string-match ":MMLYES:" template)
+ (setq template (replace-match yes t t template)))
+ (if (string-match ":MMLNO:" template)
+ (setq template (replace-match no t t template)))
+ ;; Return the modified template
+ template)))
+
+(defun org-e-html-preamble (info)
+ (when (plist-get info :html-preamble)
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (date (org-e-html-format-date info))
+ (author (org-export-data (plist-get info :author) info))
+ (email (plist-get info :email))
+ (html-pre-real-contents
+ (cond
+ ((functionp (plist-get info :html-preamble))
+ (with-temp-buffer
+ (funcall (plist-get info :html-preamble))
+ (buffer-string)))
+ ((stringp (plist-get info :html-preamble))
+ (format-spec (plist-get info :html-preamble)
+ `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email))))
+ (t
+ (format-spec
+ (or (cadr (assoc (plist-get info :language)
+ org-e-html-preamble-format))
+ (cadr (assoc "en" org-e-html-preamble-format)))
+ `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email)))))))
+ (when (not (equal html-pre-real-contents ""))
+ (concat
+ (format "
+<div id=\"%s\"> " (nth 0 org-e-html-divs))
+ "
+"
+ html-pre-real-contents
+ "
+</div>")))))
+
+(defun org-e-html-postamble (info)
+ (concat
+ (when (and (not body-only)
+ (plist-get info :html-postamble))
+ (let* ((html-post (plist-get info :html-postamble))
+ (date (org-e-html-format-date info))
+ (author (let ((author (plist-get info :author)))
+ (and author (org-export-data author info))))
+ (email
+ (mapconcat (lambda(e)
+ (format "<a href=\"mailto:%s\">%s</a>" e e))
+ (split-string (plist-get info :email) ",+ *")
+ ", "))
+ (html-validation-link (or org-e-html-validation-link ""))
+ (creator-info org-export-creator-string))
+ (concat
+ ;; begin postamble
+ "
+<div id=\"" (nth 2 org-e-html-divs) "\">"
+ (cond
+ ;; auto postamble
+ ((eq (plist-get info :html-postamble) 'auto)
+ (concat
+ (when (plist-get info :time-stamp-file)
+ (format "
+<p class=\"date\"> %s: %s </p> " (org-e-html--translate "Date" info) date))
+ (when (and (plist-get info :with-author) author)
+ (format "
+<p class=\"author\"> %s : %s</p>" (org-e-html--translate "Author" info) author))
+ (when (and (plist-get info :with-email) email)
+ (format "
+<p class=\"email\"> %s </p>" email))
+ (when (plist-get info :with-creator)
+ (format "
+<p class=\"creator\"> %s </p>" creator-info))
+ html-validation-link "\n"))
+ ;; postamble from a string
+ ((stringp (plist-get info :html-postamble))
+ (format-spec (plist-get info :html-postamble)
+ `((?a . ,author) (?e . ,email)
+ (?d . ,date) (?c . ,creator-info)
+ (?v . ,html-validation-link))))
+
+ ;; postamble from a function
+ ((functionp (plist-get info :html-postamble))
+ (with-temp-buffer
+ (funcall (plist-get info :html-postamble))
+ (buffer-string)))
+ ;; default postamble
+ (t
+ (format-spec
+ (or (cadr (assoc (plist-get info :language)
+ org-e-html-postamble-format))
+ (cadr (assoc "en" org-e-html-postamble-format)))
+ `((?a . ,author) (?e . ,email)
+ (?d . ,date) (?c . ,creator-info)
+ (?v . ,html-validation-link)))))
+ "
+</div>")))
+ ;; org-e-html-html-helper-timestamp
+ ))
+
+(defun org-e-html-template (contents info)
+ "Return complete document string after HTML conversion.
+CONTENTS is the transcoded contents string. RAW-DATA is the
+original parsed data. INFO is a plist holding export options."
+ (concat
+ (format
+ (or (and (stringp org-e-html-xml-declaration)
+ org-e-html-xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ org-e-html-xml-declaration))
+ (cdr (assoc "html" org-e-html-xml-declaration))
+
+ "")
+ (or (and org-e-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-e-html-coding-system
+ 'mime-charset))
+ "iso-8859-1"))
+ "
+<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
+ \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
+ (format "
+<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"> "
+ (plist-get info :language) (plist-get info :language))
+ "
+<head>"
+ (org-e-html-meta-info info) ; meta
+ (org-e-html-style info) ; style
+ (org-e-html-mathjax-config info) ; mathjax
+ "
+</head>"
+
+ "
+<body>"
+ (let ((link-up (org-trim (plist-get info :link-up)))
+ (link-home (org-trim (plist-get info :link-home))))
+ (unless (and (string= link-up "") (string= link-up ""))
+ (format org-e-html-home/up-format
+ (or link-up link-home)
+ (or link-home link-up))))
+ ;; preamble
+ (org-e-html-preamble info)
+ ;; begin content
+ (format "
+<div id=\"%s\">" (or org-e-html-content-div
+ (nth 1 org-e-html-divs)))
+ ;; document title
+ (format "
+<h1 class=\"title\">%s</h1>\n" (org-export-data (plist-get info :title) info))
+ ;; table of contents
+ (let ((depth (plist-get info :with-toc)))
+ (when depth (org-e-html-toc depth info)))
+ ;; document contents
+ contents
+ ;; footnotes section
+ (org-e-html-footnote-section info)
+ ;; bibliography
+ (org-e-html-bibliography)
+ ;; end content
+ (unless body-only
+ "
+</div>")
+
+ ;; postamble
+ (org-e-html-postamble info)
+
+ (unless body-only
+ "
+</body>")
+ "
+</html>"))
+
+(defun org-e-html--translate (s info)
+ "Transcode string S in to HTML.
+INFO is a plist used as a communication channel.
+
+Lookup utf-8 equivalent of S in `org-export-dictionary' and
+replace all non-ascii characters with its numeric reference."
+ (let ((s (org-export-translate s :utf-8 info)))
+ ;; Protect HTML metacharacters.
+ (setq s (org-e-html-encode-plain-text s))
+ ;; Replace non-ascii characters with their numeric equivalents.
+ (replace-regexp-in-string
+ "[[:nonascii:]]"
+ (lambda (m) (format "&#%d;" (encode-char (string-to-char m) 'ucs)))
+ s t t)))
+
+;;;; Anchor
+
+(defun org-e-html--anchor (&optional id desc attributes)
+ (let* ((name (and org-e-html-allow-name-attribute-in-anchors id))
+ (attributes (concat (and id (format " id=\"%s\"" id))
+ (and name (format " name=\"%s\"" name))
+ attributes)))
+ (format "<a%s>%s</a>" attributes (or desc ""))))
+
+;;;; Todo
+
+(defun org-e-html--todo (todo)
+ (when todo
+ (format "<span class=\"%s %s%s\">%s</span>"
+ (if (member todo org-done-keywords) "done" "todo")
+ org-e-html-todo-kwd-class-prefix (org-e-html-fix-class-name todo)
+ todo)))
+
+;;;; Tags
+
+(defun org-e-html--tags (tags)
+ (when tags
+ (format "<span class=\"tag\">%s</span>"
+ (mapconcat
+ (lambda (tag)
+ (format "<span class=\"%s\">%s</span>"
+ (concat org-e-html-tag-class-prefix
+ (org-e-html-fix-class-name tag))
+ tag))
+ tags "&nbsp;"))))
+
+;;;; Headline
+
+(defun* org-e-html-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (let ((section-number
+ (when section-number
+ (format "<span class=\"section-number-%d\">%s</span> "
+ level section-number)))
+ (todo (org-e-html--todo todo))
+ (tags (org-e-html--tags tags)))
+ (concat section-number todo (and todo " ") text
+ (and tags "&nbsp;&nbsp;&nbsp;") tags)))
+
+;;;; Src Code
+
+(defun org-e-html-fontify-code (code lang)
+ (when code
+ (cond
+ ;; Case 1: No lang. Possibly an example block.
+ ((not lang)
+ ;; Simple transcoding.
+ (org-e-html-encode-plain-text code))
+ ;; Case 2: No htmlize or an inferior version of htmlize
+ ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste)))
+ ;; Emit a warning.
+ (message "Cannot fontify src block (htmlize.el >= 1.34 required)")
+ ;; Simple transcoding.
+ (org-e-html-encode-plain-text code))
+ (t
+ ;; Map language
+ (setq lang (or (assoc-default lang org-src-lang-modes) lang))
+ (let* ((lang-mode (and lang (intern (format "%s-mode" lang)))))
+ (cond
+ ;; Case 1: Language is not associated with any Emacs mode
+ ((not (functionp lang-mode))
+ ;; Simple transcoding.
+ (org-e-html-encode-plain-text code))
+ ;; Case 2: Default. Fontify code.
+ (t
+ ;; htmlize
+ (setq code (with-temp-buffer
+ (insert code)
+ ;; Switch to language-specific mode.
+ (funcall lang-mode)
+ ;; Fontify buffer.
+ (font-lock-fontify-buffer)
+ ;; Remove formatting on newline characters.
+ (save-excursion
+ (let ((beg (point-min))
+ (end (point-max)))
+ (goto-char beg)
+ (while (progn (end-of-line) (< (point) end))
+ (put-text-property (point) (1+ (point)) 'face nil)
+ (forward-char 1))))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ ;; Htmlize region.
+ (org-export-e-htmlize-region-for-paste
+ (point-min) (point-max))))
+ ;; Strip any encolosing <pre></pre> tags.
+ (if (string-match "<pre[^>]*>\n*\\([^\000]*\\)</pre>" code)
+ (match-string 1 code)
+ code))))))))
+
+(defun org-e-html-do-format-code
+ (code &optional lang refs retain-labels num-start textarea-p)
+ (when textarea-p
+ (setq num-start nil refs nil lang nil))
+ (let* ((code-lines (org-split-string code "\n"))
+ (code-length (length code-lines))
+ (num-fmt
+ (and num-start
+ (format "%%%ds: "
+ (length (number-to-string (+ code-length num-start))))))
+ (code (org-e-html-fontify-code code lang)))
+ (assert (= code-length (length (org-split-string code "\n"))))
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (setq loc
+ (concat
+ ;; Add line number, if needed.
+ (when num-start
+ (format "<span class=\"linenr\">%s</span>"
+ (format num-fmt line-num)))
+ ;; Transcoded src line.
+ loc
+ ;; Add label, if needed.
+ (when (and ref retain-labels) (format " (%s)" ref))))
+ ;; Mark transcoded line as an anchor, if needed.
+ (if (not ref) loc
+ (format "<span id=\"coderef-%s\" class=\"coderef-off\">%s</span>"
+ ref loc)))
+ num-start refs)))
+
+(defun org-e-html-format-code (element info)
+ (let* ((lang (org-element-property :language element))
+ ;; (switches (org-element-property :switches element))
+ (switches nil) ; FIXME
+ (textarea-p (and switches (string-match "-t\\>" switches)))
+ ;; Extract code and references.
+ (code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (refs (cdr code-info))
+ ;; Does the src block contain labels?
+ (retain-labels (org-element-property :retain-labels element))
+ ;; Does it have line numbers?
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0))))
+ (org-e-html-do-format-code
+ code lang refs retain-labels num-start textarea-p)))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-e-html-bold (bold contents info)
+ "Transcode BOLD from Org to HTML.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format (or (cdr (assq 'bold org-e-html-text-markup-alist)) "%s")
+ contents))
+
+
+;;;; Center Block
+
+(defun org-e-html-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-html--wrap-label
+ center-block
+ (format "<div style=\"text-align: center\">\n%s</div>" contents)))
+
+
+;;;; Clock
+
+(defun org-e-html-clock (clock contents info)
+ "Transcode a CLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<p>
+<span class=\"timestamp-wrapper\">
+<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>%s
+</span>
+</p>"
+ org-clock-string
+ (org-translate-time (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
+
+
+;;;; Code
+
+(defun org-e-html-code (code contents info)
+ "Transcode CODE from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format (or (cdr (assq 'code org-e-html-text-markup-alist)) "%s")
+ (org-element-property :value code)))
+
+
+;;;; Comment
+
+;; Comments are ignored.
+
+
+;;;; Comment Block
+
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-e-html-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (if (functionp org-e-html-format-drawer-function)
+ (funcall org-e-html-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ (org-e-html--wrap-label drawer output)))
+
+
+;;;; Dynamic Block
+
+(defun org-e-html-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-e-html--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-e-html-entity (entity contents info)
+ "Transcode an ENTITY object from Org to HTML.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property :html entity))
+
+
+;;;; Example Block
+
+(defun org-e-html-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let* ((options (or (org-element-property :options example-block) ""))
+ (lang (org-element-property :language example-block))
+ (caption (org-element-property :caption example-block))
+ (label (org-element-property :name example-block))
+ (caption-str (org-e-html--caption/label-string caption label info))
+ (attr (mapconcat #'identity
+ (org-element-property :attr_html example-block)
+ " "))
+ ;; (switches (org-element-property :switches example-block))
+ (switches nil) ; FIXME
+ (textarea-p (and switches (string-match "-t\\>" switches)))
+ (code (org-e-html-format-code example-block info)))
+ (cond
+ (textarea-p
+ (let ((cols (if (not (string-match "-w[ \t]+\\([0-9]+\\)" switches))
+ 80 (string-to-number (match-string 1 switches))))
+ (rows (if (string-match "-h[ \t]+\\([0-9]+\\)" switches)
+ (string-to-number (match-string 1 switches))
+ (org-count-lines code))))
+ (format
+ "<p>\n<textarea cols=\"%d\" rows=\"%d\">\n%s</textarea>\n</p>"
+ cols rows code)))
+ (t (format "<pre class=\"example\">\n%s</pre>" code)))))
+
+
+;;;; Export Snippet
+
+(defun org-e-html-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-html)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-e-html-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "HTML")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Fixed Width
+
+(defun org-e-html-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-html--wrap-label
+ fixed-width
+ (format "<pre class=\"example\">\n%s</pre>"
+ (org-e-html-do-format-code
+ (org-remove-indentation
+ (org-element-property :value fixed-width))))))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored.
+
+
+;;;; Footnote Reference
+
+(defun org-e-html-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ org-e-html-footnote-separator))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (org-e-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 100))
+ ;; Inline definitions are secondary strings.
+ ((eq (org-element-property :type footnote-reference) 'inline)
+ (org-e-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1))
+ ;; Non-inline footnotes definitions are full Org data.
+ (t (org-e-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1)))))
+
+
+;;;; Headline
+
+(defun org-e-html-format-headline--wrap (headline info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode an HEADLINE element from Org to HTML.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((level (+ (org-export-get-relative-level headline info)
+ (1- org-e-html-toplevel-hlevel)))
+ (headline-number (org-export-get-headline-number headline info))
+ (section-number (and (org-export-numbered-headline-p headline info)
+ (mapconcat 'number-to-string
+ headline-number ".")))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (headline-label (or (org-element-property :custom-id headline)
+ (concat "sec-" (mapconcat 'number-to-string
+ headline-number "-"))))
+ (format-function (cond
+ ((functionp format-function) format-function)
+ ((functionp org-e-html-format-headline-function)
+ (function*
+ (lambda (todo todo-type priority text tags
+ &allow-other-keys)
+ (funcall org-e-html-format-headline-function
+ todo todo-type priority text tags))))
+ (t 'org-e-html-format-headline))))
+ (apply format-function
+ todo todo-type priority text tags
+ :headline-label headline-label :level level
+ :section-number section-number extra-keys)))
+
+(defun org-e-html-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to HTML.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ ;; Empty contents?
+ (setq contents (or contents ""))
+ (let* ((numberedp (org-export-numbered-headline-p headline info))
+ (level (org-export-get-relative-level headline info))
+ (text (org-export-data (org-element-property :title headline) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (section-number (and (org-export-numbered-headline-p headline info)
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) ".")))
+ ;; Create the headline text.
+ (full-text (org-e-html-format-headline--wrap headline info)))
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((org-export-low-level-p headline info) ; FIXME (or (not section-fmt))
+ ;; Build the real contents of the sub-tree.
+ (let* ((type (if numberedp 'unordered 'unordered)) ; FIXME
+ (itemized-body (org-e-html-format-list-item
+ contents type nil nil full-text)))
+ (concat
+ (and (org-export-first-sibling-p headline info)
+ (org-e-html-begin-plain-list type))
+ itemized-body
+ (and (org-export-last-sibling-p headline info)
+ (org-e-html-end-plain-list type)))))
+ ;; Case 3. Standard headline. Export it as a section.
+ (t
+ (let* ((section-number (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-"))
+ (ids (remove 'nil
+ (list (org-element-property :custom-id headline)
+ (concat "sec-" section-number)
+ (org-element-property :id headline))))
+ (preferred-id (car ids))
+ (extra-ids (cdr ids))
+ (extra-class (org-element-property :html-container-class headline))
+ (level1 (+ level (1- org-e-html-toplevel-hlevel))))
+ (format "<div id=\"%s\" class=\"%s\">%s%s</div>\n"
+ (format "outline-container-%s"
+ (or (org-element-property :custom-id headline)
+ section-number))
+ (concat (format "outline-%d" level1) (and extra-class " ")
+ extra-class)
+ (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
+ level1
+ preferred-id
+ (mapconcat
+ (lambda (x)
+ (let ((id (org-export-solidify-link-text
+ (if (org-uuidgen-p x) (concat "ID-" x)
+ x))))
+ (org-e-html--anchor id)))
+ extra-ids "")
+ full-text
+ level1)
+ contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-e-html-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((attr (mapconcat #'identity
+ (org-element-property :attr_html horizontal-rule)
+ " ")))
+ (org-e-html--wrap-label horizontal-rule "<hr/>")))
+
+
+;;;; Inline Babel Call
+
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-e-html-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (code (org-element-property :value inline-src-block))
+ (separator (org-e-html--find-verb-separator code)))
+ (error "FIXME")))
+
+
+;;;; Inlinetask
+
+(defun org-e-html-format-section (text class &optional id)
+ (let ((extra (concat (when id (format " id=\"%s\"" id)))))
+ (concat (format "<div class=\"%s\"%s>\n" class extra) text "</div>\n")))
+
+(defun org-e-html-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (cond
+ ;; If `org-e-html-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ ((functionp org-e-html-format-inlinetask-function)
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-e-html-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-e-html-format-headline--wrap
+ inlinetask info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t (org-e-html--wrap-label
+ inlinetask
+ (format
+ "<div class=\"inlinetask\">\n<b>%s</b><br/>\n%s</div>"
+ (org-e-html-format-headline--wrap inlinetask info)
+ contents)))))
+
+
+;;;; Italic
+
+(defun org-e-html-italic (italic contents info)
+ "Transcode ITALIC from Org to HTML.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format (or (cdr (assq 'italic org-e-html-text-markup-alist)) "%s") contents))
+
+
+;;;; Item
+
+(defun org-e-html-checkbox (checkbox)
+ (case checkbox (on "<code>[X]</code>")
+ (off "<code>[&nbsp;]</code>")
+ (trans "<code>[-]</code>")
+ (t "")))
+
+(defun org-e-html-format-list-item (contents type checkbox
+ &optional term-counter-id
+ headline)
+ (let ((checkbox (concat (org-e-html-checkbox checkbox) (and checkbox " "))))
+ (concat
+ (case type
+ (ordered
+ (let* ((counter term-counter-id)
+ (extra (if counter (format " value=\"%s\"" counter) "")))
+ (format "<li%s>" extra)))
+ (unordered
+ (let* ((id term-counter-id)
+ (extra (if id (format " id=\"%s\"" id) "")))
+ (concat
+ (format "<li%s>" extra)
+ (when headline (concat headline "<br/>")))))
+ (descriptive
+ (let* ((term term-counter-id))
+ (setq term (or term "(no term)"))
+ ;; Check-boxes in descriptive lists are associated to tag.
+ (concat (format "<dt> %s </dt>"
+ (concat checkbox term))
+ "<dd>"))))
+ (unless (eq type 'descriptive) checkbox)
+ contents
+ (case type
+ (ordered "</li>")
+ (unordered "</li>")
+ (descriptive "</dd>")))))
+
+(defun org-e-html-item (item contents info)
+ "Transcode an ITEM element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((plain-list (org-export-get-parent item))
+ (type (org-element-property :type plain-list))
+ (counter (org-element-property :counter item))
+ (checkbox (org-element-property :checkbox item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag (org-export-data tag info)))))
+ (org-e-html-format-list-item
+ contents type checkbox (or tag counter))))
+
+
+;;;; Keyword
+
+(defun org-e-html-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "HTML") value)
+ ((string= key "INDEX") (format "\\index{%s}" value))
+ ;; Invisible targets.
+ ((string= key "TARGET") nil)
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (org-e-html-toc depth info)))
+ ((string= "tables" value) "\\listoftables")
+ ((string= "figures" value) "\\listoffigures")
+ ((string= "listings" value)
+ (cond
+ ;; At the moment, src blocks with a caption are wrapped
+ ;; into a figure environment.
+ (t "\\listoffigures")))))))))
+
+
+;;;; Latex Environment
+
+(defun org-e-html-format-latex (latex-frag processing-type)
+ (let* ((cache-relpath
+ (concat "ltxpng/" (file-name-sans-extension
+ (file-name-nondirectory (buffer-file-name)))))
+ (cache-dir (file-name-directory (buffer-file-name )))
+ (display-msg "Creating LaTeX Image..."))
+
+ (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-relpath cache-dir nil display-msg
+ nil nil processing-type)
+ (buffer-string))))
+
+(defun org-e-html-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-html--wrap-label
+ latex-environment
+ (let ((processing-type (plist-get info :LaTeX-fragments))
+ (latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (caption (org-e-html--caption/label-string
+ (org-element-property :caption latex-environment)
+ (org-element-property :name latex-environment)
+ info))
+ (attr nil) ; FIXME
+ (label (org-element-property :name latex-environment)))
+ (cond
+ ((memq processing-type '(t mathjax))
+ (org-e-html-format-latex latex-frag 'mathjax))
+ ((eq processing-type 'dvipng)
+ (let* ((formula-link (org-e-html-format-latex
+ latex-frag processing-type)))
+ (when (and formula-link
+ (string-match "file:\\([^]]*\\)" formula-link))
+ (org-e-html-format-inline-image
+ (match-string 1 formula-link) caption label attr t))))
+ (t latex-frag)))))
+
+
+;;;; Latex Fragment
+
+(defun org-e-html-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((latex-frag (org-element-property :value latex-fragment))
+ (processing-type (plist-get info :LaTeX-fragments)))
+ (case processing-type
+ ((t mathjax)
+ (org-e-html-format-latex latex-frag 'mathjax))
+ (dvipng
+ (let* ((formula-link (org-e-html-format-latex
+ latex-frag processing-type)))
+ (when (and formula-link
+ (string-match "file:\\([^]]*\\)" formula-link))
+ (org-e-html-format-inline-image
+ (match-string 1 formula-link)))))
+ (t latex-frag))))
+
+;;;; Line Break
+
+(defun org-e-html-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "<br/>")
+
+
+;;;; Link
+
+(defun org-e-html-link--inline-image (link desc info)
+ "Return HTML code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ (path (cond ((member type '("http" "https"))
+ (concat type ":" raw-path))
+ ((file-name-absolute-p raw-path)
+ (expand-file-name raw-path))
+ (t raw-path)))
+ (parent (org-export-get-parent-element link))
+ (caption (org-e-html--caption/label-string
+ (org-element-property :caption parent)
+ (org-element-property :name parent)
+ info))
+ (label (org-element-property :name parent))
+ ;; Retrieve latex attributes from the element around.
+ (attr (let ((raw-attr
+ (mapconcat #'identity
+ (org-element-property :attr_html parent)
+ " ")))
+ (unless (string= raw-attr "") raw-attr))))
+ ;; Now clear ATTR from any special keyword and set a default
+ ;; value if nothing is left.
+ (setq attr (if (not attr) "" (org-trim attr)))
+ ;; Return proper string, depending on DISPOSITION.
+ (org-e-html-format-inline-image
+ path caption label attr (org-e-html-standalone-image-p link info))))
+
+(defvar org-e-html-standalone-image-predicate)
+(defun org-e-html-standalone-image-p (element info &optional predicate)
+ "Test if ELEMENT is a standalone image for the purpose HTML export.
+INFO is a plist holding contextual information.
+
+Return non-nil, if ELEMENT is of type paragraph and it's sole
+content, save for whitespaces, is a link that qualifies as an
+inline image.
+
+Return non-nil, if ELEMENT is of type link and it's containing
+paragraph has no other content save for leading and trailing
+whitespaces.
+
+Return nil, otherwise.
+
+Bind `org-e-html-standalone-image-predicate' to constrain
+paragraph further. For example, to check for only captioned
+standalone images, do the following.
+
+ \(setq org-e-html-standalone-image-predicate
+ \(lambda \(paragraph\)
+ \(org-element-property :caption paragraph\)\)\)
+"
+ (let ((paragraph (case (org-element-type element)
+ (paragraph element)
+ (link (and (org-export-inline-image-p
+ element org-e-html-inline-image-rules)
+ (org-export-get-parent element)))
+ (t nil))))
+ (when paragraph
+ (assert (eq (org-element-type paragraph) 'paragraph))
+ (when (or (not (and (boundp 'org-e-html-standalone-image-predicate)
+ (functionp org-e-html-standalone-image-predicate)))
+ (funcall org-e-html-standalone-image-predicate paragraph))
+ (let ((contents (org-element-contents paragraph)))
+ (loop for x in contents
+ with inline-image-count = 0
+ always (cond
+ ((eq (org-element-type x) 'plain-text)
+ (not (org-string-nw-p x)))
+ ((eq (org-element-type x) 'link)
+ (when (org-export-inline-image-p
+ x org-e-html-inline-image-rules)
+ (= (incf inline-image-count) 1)))
+ (t nil))))))))
+
+(defun org-e-html-link (link desc info)
+ "Transcode a LINK object from Org to HTML.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((--link-org-files-as-html-maybe
+ (function
+ (lambda (raw-path info)
+ "Treat links to `file.org' as links to `file.html', if needed.
+ See `org-e-html-link-org-files-as-html'."
+ (cond
+ ((and org-e-html-link-org-files-as-html
+ (string= ".org"
+ (downcase (file-name-extension raw-path "."))))
+ (concat (file-name-sans-extension raw-path) "."
+ (plist-get info :html-extension)))
+ (t raw-path)))))
+ (type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ ;; Extract just the file path and strip all other
+ ;; components.
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ ;; Treat links to ".org" files as ".html", if needed.
+ (setq raw-path (funcall --link-org-files-as-html-maybe
+ raw-path info))
+ ;; If file path is absolute, prepend it with protocol
+ ;; component - "file://".
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (concat "file://" (expand-file-name raw-path))))
+ (t raw-path)))
+ ;; Extract attributes from parent's paragraph.
+ (attributes
+ (let ((attr (mapconcat
+ 'identity
+ (org-element-property
+ :attr_html (org-export-get-parent-element link))
+ " ")))
+ (if attr (concat " " attr) "")))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and (or (eq t org-e-html-inline-images)
+ (and org-e-html-inline-images (not desc)))
+ (org-export-inline-image-p link org-e-html-inline-image-rules))
+ (org-e-html-link--inline-image link desc info))
+ ;; Radio target: Transcode target's contents and use them as
+ ;; link's description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (format "<a href=\"#%s\"%s>%s</a>"
+ (org-export-solidify-link-text path)
+ attributes
+ (org-export-data (org-element-contents destination) info)))))
+ ;; Links pointing to an headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; ID link points to an external file.
+ (plain-text
+ (assert (org-uuidgen-p path))
+ (let ((fragment (concat "ID-" path))
+ ;; Treat links to ".org" files as ".html", if needed.
+ (path (funcall --link-org-files-as-html-maybe
+ destination info)))
+ (format "<a href=\"%s#%s\"%s>%s</a>"
+ path fragment attributes (or desc destination))))
+ ;; Fuzzy link points nowhere.
+ ((nil)
+ (format "<i>%s</i>"
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; Fuzzy link points to an invisible target.
+ (keyword nil)
+ ;; Link points to an headline.
+ (headline
+ (let ((href
+ ;; What href to use?
+ (cond
+ ;; Case 1: Headline is linked via it's CUSTOM_ID
+ ;; property. Use CUSTOM_ID.
+ ((string= type "custom-id")
+ (org-element-property :custom-id destination))
+ ;; Case 2: Headline is linked via it's ID property
+ ;; or through other means. Use the default href.
+ ((member type '("id" "fuzzy"))
+ (format "sec-%s"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) "-")))
+ (t (error "Shouldn't reach here"))))
+ ;; What description to use?
+ (desc
+ ;; Case 1: Headline is numbered and LINK has no
+ ;; description or LINK's description matches
+ ;; headline's title. Display section number.
+ (if (and (org-export-numbered-headline-p destination info)
+ (or (not desc)
+ (string= desc (org-element-property
+ :raw-value destination))))
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) ".")
+ ;; Case 2: Either the headline is un-numbered or
+ ;; LINK has a custom description. Display LINK's
+ ;; description or headline's title.
+ (or desc (org-export-data (org-element-property
+ :title destination) info)))))
+ (format "<a href=\"#%s\"%s>%s</a>"
+ (org-export-solidify-link-text href) attributes desc)))
+ ;; Fuzzy link points to a target. Do as above.
+ (t
+ (let ((path (org-export-solidify-link-text path)) number)
+ (unless desc
+ (setq number (cond
+ ((org-e-html-standalone-image-p destination info)
+ (org-export-get-ordinal
+ (assoc 'link (org-element-contents destination))
+ info 'link 'org-e-html-standalone-image-p))
+ (t (org-export-get-ordinal destination info))))
+ (setq desc (when number
+ (if (atom number) (number-to-string number)
+ (mapconcat 'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>"
+ path attributes (or desc "FIXME")))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (let ((fragment (concat "coderef-" path)))
+ (format "<a href=\"#%s\" %s%s>%s</a>"
+ fragment
+ (format (concat "class=\"coderef\""
+ " onmouseover=\"CodeHighlightOn(this, '%s');\""
+ " onmouseout=\"CodeHighlightOff(this, '%s');\"")
+ fragment fragment)
+ attributes
+ (format (org-export-get-coderef-format path desc)
+ (org-export-resolve-coderef path info)))))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'html))
+ ;; External link with a description part.
+ ((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
+ ;; External link without a description part.
+ (path (format "<a href=\"%s\"%s>%s</a>" path attributes path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "<i>%s</i>" desc)))))
+
+
+;;;; Babel Call
+
+;; Babel Calls are ignored.
+
+
+;;;; Macro
+
+(defun org-e-html-macro (macro contents info)
+ "Transcode a MACRO element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+
+;;;; Paragraph
+
+(defun org-e-html-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to HTML.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let* ((style nil) ; FIXME
+ (class (cdr (assoc style '((footnote . "footnote")
+ (verse . nil)))))
+ (extra (if class (format " class=\"%s\"" class) ""))
+ (parent (org-export-get-parent paragraph)))
+ (cond
+ ((and (eq (org-element-type parent) 'item)
+ (= (org-element-property :begin paragraph)
+ (org-element-property :contents-begin parent)))
+ ;; leading paragraph in a list item have no tags
+ contents)
+ ((org-e-html-standalone-image-p paragraph info)
+ ;; standalone image
+ contents)
+ (t (format "<p%s>\n%s</p>" extra contents)))))
+
+
+;;;; Plain List
+
+(defun org-e-html-begin-plain-list (type &optional arg1)
+ (case type
+ (ordered
+ (format "<ol%s>" (if arg1 ; FIXME
+ (format " start=\"%d\"" arg1)
+ "")))
+ (unordered "<ul>")
+ (descriptive "<dl>")))
+
+(defun org-e-html-end-plain-list (type)
+ (case type
+ (ordered "</ol>")
+ (unordered "</ul>")
+ (descriptive "</dl>")))
+
+(defun org-e-html-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to HTML.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* (arg1 ;; FIXME
+ (type (org-element-property :type plain-list))
+ (attr (mapconcat #'identity
+ (org-element-property :attr_html plain-list)
+ " ")))
+ (org-e-html--wrap-label
+ plain-list (format "%s\n%s%s"
+ (org-e-html-begin-plain-list type)
+ contents (org-e-html-end-plain-list type)))))
+
+;;;; Plain Text
+
+(defun org-e-html-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all org-e-html-special-string-regexps)
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (setq string (replace-match rpl t nil string))))
+ string))
+
+(defun org-e-html-encode-plain-text (text)
+ "Convert plain text characters to HTML equivalent.
+Possible conversions are set in `org-export-html-protect-char-alist'."
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
+ org-e-html-protect-char-alist)
+ text)
+
+(defun org-e-html-plain-text (text info)
+ "Transcode a TEXT string from Org to HTML.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect following characters: <, >, &.
+ (setq text (org-e-html-encode-plain-text text))
+ ;; Handle quotation marks.
+ (setq text (org-e-html--quotation-marks text info))
+ ;; Handle special strings.
+ (when (plist-get info :with-special-strings)
+ (setq text (org-e-html-convert-special-strings text)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n"
+ text)))
+ ;; Return value.
+ text)
+
+
+;; Planning
+
+(defun org-e-html-planning (planning contents info)
+ "Transcode a PLANNING element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>"))
+ (format
+ "<p><span class=\"timestamp-wrapper\">%s</span></p>"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (format span-fmt org-closed-string
+ (org-translate-time closed))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (format span-fmt org-deadline-string
+ (org-translate-time deadline))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (format span-fmt org-scheduled-string
+ (org-translate-time scheduled))))))
+ " "))))
+
+
+;;;; Property Drawer
+
+(defun org-e-html-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+
+;;;; Quote Block
+
+(defun org-e-html-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-html--wrap-label
+ quote-block (format "<blockquote>\n%s</blockquote>" contents)))
+
+
+;;;; Quote Section
+
+(defun org-e-html-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "<pre>\n%s</pre>" value))))
+
+
+;;;; Section
+
+(defun org-e-html-section (section contents info)
+ "Transcode a SECTION element from Org to HTML.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ (let ((parent (org-export-get-parent-headline section)))
+ ;; Before first headline: no container, just return CONTENTS.
+ (if (not parent) contents
+ ;; Get div's class and id references.
+ (let* ((class-num (+ (org-export-get-relative-level parent info)
+ (1- org-e-html-toplevel-hlevel)))
+ (section-number
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number parent info) "-")))
+ ;; Build return value.
+ (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>"
+ class-num
+ (or (org-element-property :custom-id parent) section-number)
+ contents)))))
+
+;;;; Radio Target
+
+(defun org-e-html-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to HTML.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (let ((id (org-export-solidify-link-text
+ (org-element-property :value radio-target))))
+ (org-e-html--anchor id text)))
+
+
+;;;; Special Block
+
+(defun org-e-html-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block))))
+ (org-e-html--wrap-label
+ special-block
+ (format "<div class=\"%s\">\n%s\n</div>" type contents))))
+
+
+;;;; Src Block
+
+(defun org-e-html-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (label (org-element-property :name src-block))
+ (caption-str (org-e-html--caption/label-string caption label info))
+ (attr (mapconcat #'identity
+ (org-element-property :attr_html src-block)
+ " "))
+ ;; (switches (org-element-property :switches src-block))
+ (switches nil) ; FIXME
+ (textarea-p (and switches (string-match "-t\\>" switches)))
+ (code (org-e-html-format-code src-block info)))
+ (cond
+ (lang (format
+ "<div class=\"org-src-container\">\n%s%s\n</div>"
+ (if (not caption) ""
+ (format "<label class=\"org-src-name\">%s</label>" caption-str))
+ (format "\n<pre class=\"src src-%s\">%s</pre>" lang code)))
+ (textarea-p
+ (let ((cols (if (not (string-match "-w[ \t]+\\([0-9]+\\)" switches))
+ 80 (string-to-number (match-string 1 switches))))
+ (rows (if (string-match "-h[ \t]+\\([0-9]+\\)" switches)
+ (string-to-number (match-string 1 switches))
+ (org-count-lines code))))
+ (format
+ "<p>\n<textarea cols=\"%d\" rows=\"%d\">\n%s</textarea>\n</p>"
+ cols rows code)))
+ (t (format "<pre class=\"example\">\n%s</pre>" code)))))
+
+;;;; Statistics Cookie
+
+(defun org-e-html-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((cookie-value (org-element-property :value statistics-cookie)))
+ (format "<code>%s</code>" cookie-value)))
+
+
+;;;; Strike-Through
+
+(defun org-e-html-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to HTML.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format (or (cdr (assq 'strike-through org-e-html-text-markup-alist)) "%s")
+ contents))
+
+
+;;;; Subscript
+
+(defun org-e-html-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to HTML.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<sub>%s</sub>" contents))
+
+
+;;;; Superscript
+
+(defun org-e-html-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to HTML.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<sup>%s</sup>" contents))
+
+
+;;;; Tabel Cell
+
+(defun org-e-html-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((table-row (org-export-get-parent table-cell))
+ (table (org-export-get-parent-table table-cell))
+ (cell-attrs
+ (if (not org-e-html-table-align-individual-fields) ""
+ (format (if (and (boundp 'org-e-html-format-table-no-css)
+ org-e-html-format-table-no-css)
+ " align=\"%s\"" " class=\"%s\"")
+ (org-export-table-cell-alignment table-cell info)))))
+ (when (or (not contents) (string= "" (org-trim contents)))
+ (setq contents "&nbsp;"))
+ (cond
+ ((and (org-export-table-has-header-p table info)
+ (= 1 (org-export-table-row-group table-row info)))
+ (concat "\n" (format (car org-e-html-table-header-tags) "col" cell-attrs)
+ contents (cdr org-e-html-table-header-tags)))
+ ((and org-e-html-table-use-header-tags-for-first-column
+ (zerop (cdr (org-export-table-cell-address table-cell info))))
+ (concat "\n" (format (car org-e-html-table-header-tags) "row" cell-attrs)
+ contents (cdr org-e-html-table-header-tags)))
+ (t (concat "\n" (format (car org-e-html-table-data-tags) cell-attrs)
+ contents (cdr org-e-html-table-data-tags))))))
+
+
+;;;; Table Row
+
+(defun org-e-html-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to HTML.
+CONTENTS is the contents of the row. INFO is a plist used as a
+communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((first-rowgroup-p (= 1 (org-export-table-row-group table-row info)))
+ (rowgroup-tags
+ (cond
+ ;; Case 1: Row belongs to second or subsequent rowgroups.
+ ((not (= 1 (org-export-table-row-group table-row info)))
+ '("<tbody>" . "\n</tbody>"))
+ ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups.
+ ((org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ '("<thead>" . "\n</thead>"))
+ ;; Case 2: Row is from first and only row group.
+ (t '("<tbody>" . "\n</tbody>")))))
+ (concat
+ ;; Begin a rowgroup?
+ (when (org-export-table-row-starts-rowgroup-p table-row info)
+ (car rowgroup-tags))
+ ;; Actual table row
+ (concat "\n" (eval (car org-e-html-table-row-tags))
+ contents
+ "\n"
+ (eval (cdr org-e-html-table-row-tags)))
+ ;; End a rowgroup?
+ (when (org-export-table-row-ends-rowgroup-p table-row info)
+ (cdr rowgroup-tags))))))
+
+
+;;;; Table
+
+(defun org-e-html-table-first-row-data-cells (table info)
+ (let ((table-row
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule) row))
+ info 'first-match))
+ (special-column-p (org-export-table-has-special-column-p table)))
+ (if (not special-column-p) (org-element-contents table-row)
+ (cdr (org-element-contents table-row)))))
+
+(defun org-e-html-table--table.el-table (table info)
+ (when (eq (org-element-property :type table) 'table.el)
+ (require 'table)
+ (let ((outbuf (with-current-buffer
+ (get-buffer-create "*org-export-table*")
+ (erase-buffer) (current-buffer))))
+ (with-temp-buffer
+ (insert (org-element-property :value table))
+ (goto-char 1)
+ (re-search-forward "^[ \t]*|[^|]" nil t)
+ (table-generate-source 'html outbuf))
+ (with-current-buffer outbuf
+ (prog1 (org-trim (buffer-string))
+ (kill-buffer) )))))
+
+(defun org-e-html-table (table contents info)
+ "Transcode a TABLE element from Org to HTML.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (case (org-element-property :type table)
+ ;; Case 1: table.el table. Convert it using appropriate tools.
+ (table.el (org-e-html-table--table.el-table table info))
+ ;; Case 2: Standard table.
+ (t
+ (let* ((label (org-element-property :name table))
+ (caption (org-e-html--caption/label-string
+ (org-element-property :caption table) label info))
+ (attributes (mapconcat #'identity
+ (org-element-property :attr_html table)
+ " "))
+ (alignspec
+ (if (and (boundp 'org-e-html-format-table-no-css)
+ org-e-html-format-table-no-css)
+ "align=\"%s\"" "class=\"%s\""))
+ (table-column-specs
+ (function
+ (lambda (table info)
+ (mapconcat
+ (lambda (table-cell)
+ (let ((alignment (org-export-table-cell-alignment
+ table-cell info)))
+ (concat
+ ;; Begin a colgroup?
+ (when (org-export-table-cell-starts-colgroup-p
+ table-cell info)
+ "\n<colgroup>")
+ ;; Add a column. Also specify it's alignment.
+ (format "\n<col %s/>" (format alignspec alignment))
+ ;; End a colgroup?
+ (when (org-export-table-cell-ends-colgroup-p
+ table-cell info)
+ "\n</colgroup>"))))
+ (org-e-html-table-first-row-data-cells table info) "\n"))))
+ (table-attributes
+ (let ((table-tag (plist-get info :html-table-tag)))
+ (concat
+ (and (string-match "<table\\(.*\\)>" table-tag)
+ (match-string 1 table-tag))
+ (and label (format " id=\"%s\""
+ (org-export-solidify-link-text label)))))))
+ ;; Remove last blank line.
+ (setq contents (substring contents 0 -1))
+ (format "<table%s>\n%s\n%s\n%s\n</table>"
+ table-attributes
+ (if (not caption) "" (format "<caption>%s</caption>" caption))
+ (funcall table-column-specs table info)
+ contents)))))
+
+;;;; Target
+
+(defun org-e-html-target (target contents info)
+ "Transcode a TARGET object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((id (org-export-solidify-link-text
+ (org-element-property :value target))))
+ (org-e-html--anchor id)))
+
+
+;;;; Timestamp
+
+(defun org-e-html-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let* ((f (if (eq (org-element-property :type timestamp) 'inactive) "[%s]" "<%s>"))
+ (value (org-translate-time (format f (org-element-property :value timestamp))))
+ (range-end (org-element-property :range-end timestamp)))
+ (format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
+ (if (not range-end) value
+ (concat value "&ndash;" (org-translate-time (format f range-end)))))))
+
+
+;;;; Underline
+
+(defun org-e-html-underline (underline contents info)
+ "Transcode UNDERLINE from Org to HTML.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format (or (cdr (assq 'underline org-e-html-text-markup-alist)) "%s")
+ contents))
+
+
+;;;; Verbatim
+
+(defun org-e-html-verbatim (verbatim contents info)
+ "Transcode VERBATIM from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format (or (cdr (assq 'verbatim org-e-html-text-markup-alist)) "%s")
+ (org-element-property :value verbatim)))
+
+
+;;;; Verse Block
+
+(defun org-e-html-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to HTML.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ ;; Replace each newline character with line break. Also replace
+ ;; each blank line with a line break.
+ (setq contents (replace-regexp-in-string
+ "^ *\\\\\\\\$" "<br/>\n"
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " <br/>\n" contents)))
+ ;; Replace each white space at beginning of a line with a
+ ;; non-breaking space.
+ (while (string-match "^[ \t]+" contents)
+ (let* ((num-ws (length (match-string 0 contents)))
+ (ws (let (out) (dotimes (i num-ws out)
+ (setq out (concat out "&nbsp;"))))))
+ (setq contents (replace-match ws nil t contents))))
+ (org-e-html--wrap-label
+ verse-block (format "<p class=\"verse\">\n%s</p>" contents)))
+
+
+
+
+;;; Filter Functions
+
+(defun org-e-html-final-function (contents backend info)
+ (if (not org-e-html-pretty-output) contents
+ (with-temp-buffer
+ (html-mode)
+ (insert contents)
+ (indent-region (point-min) (point-max))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+
+;;; Interactive functions
+
+;;;###autoload
+(defun org-e-html-export-as-html
+ (&optional subtreep visible-only body-only ext-plist)
+ "Export current buffer to an HTML buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"<body>\" and \"</body>\" tags.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org E-HTML Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (let ((outbuf
+ (org-export-to-buffer
+ 'e-html "*Org E-HTML Export*"
+ subtreep visible-only body-only ext-plist)))
+ ;; Set major mode.
+ (with-current-buffer outbuf (nxml-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf))))
+
+;;;###autoload
+(defun org-e-html-export-to-html
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a HTML file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"<body>\" and \"</body>\" tags.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let* ((extension (concat "." org-e-html-extension))
+ (file (org-export-output-file-name extension subtreep pub-dir))
+ (org-export-coding-system org-e-html-coding-system))
+ (org-export-to-file
+ 'e-html file subtreep visible-only body-only ext-plist)))
+
+
+
+;;; FIXME
+
+;;;; org-format-table-html
+;;;; org-format-org-table-html
+;;;; org-format-table-table-html
+;;;; org-table-number-fraction
+;;;; org-table-number-regexp
+;;;; org-e-html-table-caption-above
+
+;;;; org-e-html-with-timestamp
+;;;; org-e-html-html-helper-timestamp
+
+;;;; org-export-as-html-and-open
+;;;; org-export-as-html-batch
+;;;; org-export-as-html-to-buffer
+;;;; org-replace-region-by-html
+;;;; org-export-region-as-html
+;;;; org-export-as-html
+
+;;;; (org-export-directory :html opt-plist)
+;;;; (plist-get opt-plist :html-extension)
+;;;; org-e-html-toplevel-hlevel
+;;;; org-e-html-special-string-regexps
+;;;; org-e-html-inline-images
+;;;; org-e-html-inline-image-extensions
+;;;; org-e-html-protect-char-alist
+;;;; org-e-html-table-use-header-tags-for-first-column
+;;;; org-e-html-todo-kwd-class-prefix
+;;;; org-e-html-tag-class-prefix
+;;;; org-e-html-footnote-separator
+
+;;;; org-export-preferred-target-alist
+;;;; org-export-solidify-link-text
+;;;; class for anchors
+;;;; org-export-with-section-numbers, body-only
+;;;; org-export-mark-todo-in-toc
+
+;;;; org-e-html-format-org-link
+;;;; (caption (and caption (org-xml-encode-org-text caption)))
+;;;; alt = (file-name-nondirectory path)
+
+;;;; org-export-time-stamp-file'
+
+(provide 'org-e-html)
+;;; org-e-html.el ends here
diff --git a/contrib/lisp/org-e-latex.el b/contrib/lisp/org-e-latex.el
new file mode 100644
index 0000000..8712f5a
--- /dev/null
+++ b/contrib/lisp/org-e-latex.el
@@ -0,0 +1,2726 @@
+;;; org-e-latex.el --- LaTeX Back-End For Org Export Engine
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a LaTeX back-end for Org generic exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'e-latex "*Test e-LaTeX*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the LaTeX
+;; export. See contrib/lisp/org-export.el for more details on how
+;; this exporter works.
+;;
+;; It introduces three new buffer keywords: "LATEX_CLASS",
+;; "LATEX_CLASS_OPTIONS" and "LATEX_HEADER".
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-export)
+
+(defvar org-export-latex-default-packages-alist)
+(defvar org-export-latex-packages-alist)
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend e-latex
+ ((bold . org-e-latex-bold)
+ (center-block . org-e-latex-center-block)
+ (clock . org-e-latex-clock)
+ (code . org-e-latex-code)
+ (drawer . org-e-latex-drawer)
+ (dynamic-block . org-e-latex-dynamic-block)
+ (entity . org-e-latex-entity)
+ (example-block . org-e-latex-example-block)
+ (export-block . org-e-latex-export-block)
+ (export-snippet . org-e-latex-export-snippet)
+ (fixed-width . org-e-latex-fixed-width)
+ (footnote-definition . org-e-latex-footnote-definition)
+ (footnote-reference . org-e-latex-footnote-reference)
+ (headline . org-e-latex-headline)
+ (horizontal-rule . org-e-latex-horizontal-rule)
+ (inline-src-block . org-e-latex-inline-src-block)
+ (inlinetask . org-e-latex-inlinetask)
+ (italic . org-e-latex-italic)
+ (item . org-e-latex-item)
+ (keyword . org-e-latex-keyword)
+ (latex-environment . org-e-latex-latex-environment)
+ (latex-fragment . org-e-latex-latex-fragment)
+ (line-break . org-e-latex-line-break)
+ (link . org-e-latex-link)
+ (macro . org-e-latex-macro)
+ (paragraph . org-e-latex-paragraph)
+ (plain-list . org-e-latex-plain-list)
+ (plain-text . org-e-latex-plain-text)
+ (planning . org-e-latex-planning)
+ (property-drawer . org-e-latex-property-drawer)
+ (quote-block . org-e-latex-quote-block)
+ (quote-section . org-e-latex-quote-section)
+ (radio-target . org-e-latex-radio-target)
+ (section . org-e-latex-section)
+ (special-block . org-e-latex-special-block)
+ (src-block . org-e-latex-src-block)
+ (statistics-cookie . org-e-latex-statistics-cookie)
+ (strike-through . org-e-latex-strike-through)
+ (subscript . org-e-latex-subscript)
+ (superscript . org-e-latex-superscript)
+ (table . org-e-latex-table)
+ (table-cell . org-e-latex-table-cell)
+ (table-row . org-e-latex-table-row)
+ (target . org-e-latex-target)
+ (template . org-e-latex-template)
+ (timestamp . org-e-latex-timestamp)
+ (underline . org-e-latex-underline)
+ (verbatim . org-e-latex-verbatim)
+ (verse-block . org-e-latex-verse-block))
+ :export-block "LATEX"
+ :options-alist ((:date "DATE" nil org-e-latex-date-format t)
+ (:latex-class "LATEX_CLASS" nil org-e-latex-default-class t)
+ (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+ (:latex-header-extra "LATEX_HEADER" nil nil newline)))
+
+
+
+;;; Internal Variables
+
+(defconst org-e-latex-babel-language-alist
+ '(("af" . "afrikaans")
+ ("bg" . "bulgarian")
+ ("bt-br" . "brazilian")
+ ("ca" . "catalan")
+ ("cs" . "czech")
+ ("cy" . "welsh")
+ ("da" . "danish")
+ ("de" . "germanb")
+ ("de-at" . "naustrian")
+ ("de-de" . "ngerman")
+ ("el" . "greek")
+ ("en" . "english")
+ ("en-au" . "australian")
+ ("en-ca" . "canadian")
+ ("en-gb" . "british")
+ ("en-ie" . "irish")
+ ("en-nz" . "newzealand")
+ ("en-us" . "american")
+ ("es" . "spanish")
+ ("et" . "estonian")
+ ("eu" . "basque")
+ ("fi" . "finnish")
+ ("fr" . "frenchb")
+ ("fr-ca" . "canadien")
+ ("gl" . "galician")
+ ("hr" . "croatian")
+ ("hu" . "hungarian")
+ ("id" . "indonesian")
+ ("is" . "icelandic")
+ ("it" . "italian")
+ ("la" . "latin")
+ ("ms" . "malay")
+ ("nl" . "dutch")
+ ("no-no" . "nynorsk")
+ ("pl" . "polish")
+ ("pt" . "portuguese")
+ ("ro" . "romanian")
+ ("ru" . "russian")
+ ("sa" . "sanskrit")
+ ("sb" . "uppersorbian")
+ ("sk" . "slovak")
+ ("sl" . "slovene")
+ ("sq" . "albanian")
+ ("sr" . "serbian")
+ ("sv" . "swedish")
+ ("ta" . "tamil")
+ ("tr" . "turkish")
+ ("uk" . "ukrainian"))
+ "Alist between language code and corresponding Babel option.")
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-e-latex nil
+ "Options for exporting Org mode files to LaTeX."
+ :tag "Org Export LaTeX"
+ :group 'org-export)
+
+
+;;;; Preamble
+
+(defcustom org-e-latex-default-class "article"
+ "The default LaTeX class."
+ :group 'org-export-e-latex
+ :type '(string :tag "LaTeX class"))
+
+(defcustom org-e-latex-classes
+ '(("article"
+ "\\documentclass[11pt]{article}"
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
+ ("\\paragraph{%s}" . "\\paragraph*{%s}")
+ ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
+ ("report"
+ "\\documentclass[11pt]{report}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
+ ("book"
+ "\\documentclass[11pt]{book}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))
+ "Alist of LaTeX classes and associated header and structure.
+If #+LaTeX_CLASS is set in the buffer, use its value and the
+associated information. Here is the structure of each cell:
+
+ \(class-name
+ header-string
+ \(numbered-section . unnumbered-section\)
+ ...\)
+
+The header string
+-----------------
+
+The HEADER-STRING is the header that will be inserted into the
+LaTeX file. It should contain the \\documentclass macro, and
+anything else that is needed for this setup. To this header, the
+following commands will be added:
+
+- Calls to \\usepackage for all packages mentioned in the
+ variables `org-export-latex-default-packages-alist' and
+ `org-export-latex-packages-alist'. Thus, your header
+ definitions should avoid to also request these packages.
+
+- Lines specified via \"#+LaTeX_HEADER:\"
+
+If you need more control about the sequence in which the header
+is built up, or if you want to exclude one of these building
+blocks for a particular class, you can use the following
+macro-like placeholders.
+
+ [DEFAULT-PACKAGES] \\usepackage statements for default packages
+ [NO-DEFAULT-PACKAGES] do not include any of the default packages
+ [PACKAGES] \\usepackage statements for packages
+ [NO-PACKAGES] do not include the packages
+ [EXTRA] the stuff from #+LaTeX_HEADER
+ [NO-EXTRA] do not include #+LaTeX_HEADER stuff
+
+So a header like
+
+ \\documentclass{article}
+ [NO-DEFAULT-PACKAGES]
+ [EXTRA]
+ \\providecommand{\\alert}[1]{\\textbf{#1}}
+ [PACKAGES]
+
+will omit the default packages, and will include the
+#+LaTeX_HEADER lines, then have a call to \\providecommand, and
+then place \\usepackage commands based on the content of
+`org-export-latex-packages-alist'.
+
+If your header, `org-export-latex-default-packages-alist' or
+`org-export-latex-packages-alist' inserts
+\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be
+replaced with a coding system derived from
+`buffer-file-coding-system'. See also the variable
+`org-e-latex-inputenc-alist' for a way to influence this
+mechanism.
+
+The sectioning structure
+------------------------
+
+The sectioning structure of the class is given by the elements
+following the header string. For each sectioning level, a number
+of strings is specified. A %s formatter is mandatory in each
+section string and will be replaced by the title of the section.
+
+Instead of a cons cell \(numbered . unnumbered\), you can also
+provide a list of 2 or 4 elements,
+
+ \(numbered-open numbered-close\)
+
+or
+
+ \(numbered-open numbered-close unnumbered-open unnumbered-close\)
+
+providing opening and closing strings for a LaTeX environment
+that should represent the document section. The opening clause
+should have a %s to represent the section title.
+
+Instead of a list of sectioning commands, you can also specify
+a function name. That function will be called with two
+parameters, the \(reduced) level of the headline, and a predicate
+non-nil when the headline should be numbered. It must return
+a format string in which the section title will be added."
+ :group 'org-export-e-latex
+ :type '(repeat
+ (list (string :tag "LaTeX class")
+ (string :tag "LaTeX header")
+ (repeat :tag "Levels" :inline t
+ (choice
+ (cons :tag "Heading"
+ (string :tag " numbered")
+ (string :tag "unnumbered"))
+ (list :tag "Environment"
+ (string :tag "Opening (numbered)")
+ (string :tag "Closing (numbered)")
+ (string :tag "Opening (unnumbered)")
+ (string :tag "Closing (unnumbered)"))
+ (function :tag "Hook computing sectioning"))))))
+
+(defcustom org-e-latex-inputenc-alist nil
+ "Alist of inputenc coding system names, and what should really be used.
+For example, adding an entry
+
+ (\"utf8\" . \"utf8x\")
+
+will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
+are written as utf8 files."
+ :group 'org-export-e-latex
+ :type '(repeat
+ (cons
+ (string :tag "Derived from buffer")
+ (string :tag "Use this instead"))))
+
+(defcustom org-e-latex-date-format
+ "\\today"
+ "Format string for \\date{...}."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+(defcustom org-e-latex-title-command "\\maketitle"
+ "The command used to insert the title just after \\begin{document}.
+If this string contains the formatting specification \"%s\" then
+it will be used as a formatting string, passing the title as an
+argument."
+ :group 'org-export-e-latex
+ :type 'string)
+
+
+;;;; Headline
+
+(defcustom org-e-latex-format-headline-function nil
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags as a list of strings (list of strings or nil).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-e-latex-format-headline (todo todo-type priority text tags)
+ \"Default format function for an headline.\"
+ \(concat (when todo
+ \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
+ \(when priority
+ \(format \"\\\\framebox{\\\\#%c} \" priority))
+ text
+ \(when tags
+ \(format \"\\\\hfill{}\\\\textsc{%s}\"
+ \(mapconcat 'identity tags \":\"))))"
+ :group 'org-export-e-latex
+ :type 'function)
+
+
+;;;; Footnotes
+
+(defcustom org-e-latex-footnote-separator "\\textsuperscript{,}\\,"
+ "Text used to separate footnotes."
+ :group 'org-export-e-latex
+ :type 'string)
+
+
+;;;; Timestamps
+
+(defcustom org-e-latex-active-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-e-latex
+ :type 'string)
+
+(defcustom org-e-latex-inactive-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-e-latex
+ :type 'string)
+
+(defcustom org-e-latex-diary-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-e-latex
+ :type 'string)
+
+
+;;;; Links
+
+(defcustom org-e-latex-image-default-option "width=.9\\linewidth"
+ "Default option for images."
+ :group 'org-export-e-latex
+ :type 'string)
+
+(defcustom org-e-latex-default-figure-position "htb"
+ "Default position for latex figures."
+ :group 'org-export-e-latex
+ :type 'string)
+
+(defcustom org-e-latex-inline-image-rules
+ '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\)\\'"))
+ "Rules characterizing image files that can be inlined into LaTeX.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path.
+
+Note that, by default, the image extension *actually* allowed
+depend on the way the LaTeX file is processed. When used with
+pdflatex, pdf, jpg and png images are OK. When processing
+through dvi to Postscript, only ps and eps are allowed. The
+default we use here encompasses both."
+ :group 'org-export-e-latex
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-e-latex-link-with-unknown-path-format "\\texttt{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Tables
+
+(defcustom org-e-latex-default-table-environment "tabular"
+ "Default environment used to build tables."
+ :group 'org-export-e-latex
+ :type 'string)
+
+(defcustom org-e-latex-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+(defcustom org-e-latex-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+(defcustom org-e-latex-tables-booktabs nil
+ "When non-nil, display tables in a formal \"booktabs\" style.
+This option assumes that the \"booktabs\" package is properly
+loaded in the header of the document. This value can be ignored
+locally with \"booktabs=yes\" and \"booktabs=no\" LaTeX
+attributes."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+(defcustom org-e-latex-table-caption-above t
+ "When non-nil, place caption string at the beginning of the table.
+Otherwise, place it near the end."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+(defcustom org-e-latex-table-scientific-notation "%s\\,(%s)"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-e-latex
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+
+;;;; Text markup
+
+(defcustom org-e-latex-text-markup-alist '((bold . "\\textbf{%s}")
+ (code . verb)
+ (italic . "\\emph{%s}")
+ (strike-through . "\\st{%s}")
+ (underline . "\\underline{%s}")
+ (verbatim . protectedtexttt))
+ "Alist of LaTeX expressions to convert text markup.
+
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underline' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
+
+Value can also be set to the following symbols: `verb' and
+`protectedtexttt'. For the former, Org will use \"\\verb\" to
+create a format string and select a delimiter character that
+isn't in the string. For the latter, Org will use \"\\texttt\"
+to typeset and try to protect special characters.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-e-latex
+ :type 'alist
+ :options '(bold code italic strike-through underline verbatim))
+
+
+;;;; Drawers
+
+(defcustom org-e-latex-format-drawer-function nil
+ "Function called to format a drawer in LaTeX code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-latex-format-drawer-default \(name contents\)
+ \"Format a drawer element for LaTeX export.\"
+ contents\)"
+ :group 'org-export-e-latex
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-e-latex-format-inlinetask-function nil
+ "Function called to format an inlinetask in LaTeX code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-latex-format-inlinetask \(todo type priority name tags contents\)
+\"Format an inline task element for LaTeX export.\"
+ \(let ((full-title
+ \(concat
+ \(when todo
+ \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
+ \(when priority (format \"\\\\framebox{\\\\#%c} \" priority))
+ title
+ \(when tags
+ \(format \"\\\\hfill{}\\\\textsc{:%s:}\"
+ \(mapconcat 'identity tags \":\")))))
+ \(format (concat \"\\\\begin{center}\\n\"
+ \"\\\\fbox{\\n\"
+ \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
+ \"%s\\n\\n\"
+ \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
+ \"%s\"
+ \"\\\\end{minipage}}\"
+ \"\\\\end{center}\")
+ full-title contents))"
+ :group 'org-export-e-latex
+ :type 'function)
+
+
+;; Src blocks
+
+(defcustom org-e-latex-listings nil
+ "Non-nil means export source code using the listings package.
+This package will fontify source code, possibly even with color.
+If you want to use this, you also need to make LaTeX use the
+listings package, and if you want to have color, the color
+package. Just add these to `org-export-latex-packages-alist',
+for example using customize, or with something like:
+
+ \(require 'org-e-latex)
+ \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"listings\"))
+ \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"color\"))
+
+Alternatively,
+
+ \(setq org-e-latex-listings 'minted)
+
+causes source code to be exported using the minted package as
+opposed to listings. If you want to use minted, you need to add
+the minted package to `org-export-latex-packages-alist', for
+example using customize, or with
+
+ \(require 'org-e-latex)
+ \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"minted\"))
+
+In addition, it is necessary to install pygments
+\(http://pygments.org), and to configure the variable
+`org-e-latex-pdf-process' so that the -shell-escape option is
+passed to pdflatex."
+ :group 'org-export-e-latex
+ :type '(choice
+ (const :tag "Use listings" t)
+ (const :tag "Use minted" 'minted)
+ (const :tag "Export verbatim" nil)))
+
+(defcustom org-e-latex-listings-langs
+ '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
+ (c "C") (cc "C++")
+ (fortran "fortran")
+ (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
+ (html "HTML") (xml "XML")
+ (tex "TeX") (latex "TeX")
+ (shell-script "bash")
+ (gnuplot "Gnuplot")
+ (ocaml "Caml") (caml "Caml")
+ (sql "SQL") (sqlite "sql"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the listings package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present."
+ :group 'org-export-e-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+(defcustom org-e-latex-listings-options nil
+ "Association list of options for the latex listings package.
+
+These options are supplied as a comma-separated list to the
+\\lstset command. Each element of the association list should be
+a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-e-latex-listings-options
+ '((\"basicstyle\" \"\\small\")
+ (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
+
+will typeset the code in a small size font with underlined, bold
+black keywords.
+
+Note that the same options will be applied to blocks of all
+languages."
+ :group 'org-export-e-latex
+ :type '(repeat
+ (list
+ (string :tag "Listings option name ")
+ (string :tag "Listings option value"))))
+
+(defcustom org-e-latex-minted-langs
+ '((emacs-lisp "common-lisp")
+ (cc "c++")
+ (cperl "perl")
+ (shell-script "bash")
+ (caml "ocaml"))
+ "Alist mapping languages to their minted language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the minted package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present.
+
+Note that minted uses all lower case for language identifiers,
+and that the full list of language identifiers can be obtained
+with:
+
+ pygmentize -L lexers"
+ :group 'org-export-e-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Minted language"))))
+
+(defcustom org-e-latex-minted-options nil
+ "Association list of options for the latex minted package.
+
+These options are supplied within square brackets in
+\\begin{minted} environments. Each element of the alist should
+be a list containing two strings: the name of the option, and the
+value. For example,
+
+ \(setq org-e-latex-minted-options
+ '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\")))
+
+will result in src blocks being exported with
+
+\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
+
+as the start of the minted environment. Note that the same
+options will be applied to blocks of all languages."
+ :group 'org-export-e-latex
+ :type '(repeat
+ (list
+ (string :tag "Minted option name ")
+ (string :tag "Minted option value"))))
+
+(defvar org-e-latex-custom-lang-environments nil
+ "Alist mapping languages to language-specific LaTeX environments.
+
+It is used during export of src blocks by the listings and minted
+latex packages. For example,
+
+ \(setq org-e-latex-custom-lang-environments
+ '\(\(python \"pythoncode\"\)\)\)
+
+would have the effect that if org encounters begin_src python
+during latex export it will output
+
+ \\begin{pythoncode}
+ <src block body>
+ \\end{pythoncode}")
+
+
+;;;; Plain text
+
+(defcustom org-e-latex-quotes
+ '(("fr"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~")
+ ("\\(\\S-\\)\"" . "~»")
+ ("\\(\\s-\\|(\\|^\\)'" . "'"))
+ ("en"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "``")
+ ("\\(\\S-\\)\"" . "''")
+ ("\\(\\s-\\|(\\|^\\)'" . "`")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-latex
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+
+;;;; Compilation
+
+(defcustom org-e-latex-pdf-process
+ '("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f")
+ "Commands to process a LaTeX file to a PDF file.
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+full file name, %b by the file base name \(i.e. without
+extension) and %o by the base directory of the file.
+
+The reason why this is a list is that it usually takes several
+runs of `pdflatex', maybe mixed with a call to `bibtex'. Org
+does not have a clever mechanism to detect which of these
+commands have to be run to get to a stable result, and it also
+does not do any error checking.
+
+By default, Org uses 3 runs of `pdflatex' to do the processing.
+If you have texi2dvi on your system and if that does not cause
+the infamous egrep/locale bug:
+
+ http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
+
+then `texi2dvi' is the superior choice. Org does offer it as one
+of the customize options.
+
+Alternatively, this may be a Lisp function that does the
+processing, so you could use this to apply the machinery of
+AUCTeX or the Emacs LaTeX mode. This function should accept the
+file name as its single argument."
+ :group 'org-export-pdf
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "bibtex %b"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "texi2dvi"
+ ("texi2dvi -p -b -c -V %f"))
+ (const :tag "rubber"
+ ("rubber -d --into %o %f"))
+ (function)))
+
+(defcustom org-e-latex-logfiles-extensions
+ '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ "The list of file extensions to consider as LaTeX logfiles."
+ :group 'org-export-e-latex
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-e-latex-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+These are the .aux, .log, .out, and .toc files."
+ :group 'org-export-e-latex
+ :type 'boolean)
+
+
+
+;;; Internal Functions
+
+(defun org-e-latex--caption/label-string (caption label info)
+ "Return caption and label LaTeX string for floats.
+
+CAPTION is a cons cell of secondary strings, the car being the
+standard caption and the cdr its short form. LABEL is a string
+representing the label. INFO is a plist holding contextual
+information.
+
+If there's no caption nor label, return the empty string.
+
+For non-floats, see `org-e-latex--wrap-label'."
+ (let ((label-str (if label (format "\\label{%s}" label) "")))
+ (cond
+ ((and (not caption) (not label)) "")
+ ((not caption) (format "\\label{%s}\n" label))
+ ;; Option caption format with short name.
+ ((cdr caption)
+ (format "\\caption[%s]{%s%s}\n"
+ (org-export-data (cdr caption) info)
+ label-str
+ (org-export-data (car caption) info)))
+ ;; Standard caption format.
+ (t (format "\\caption{%s%s}\n"
+ label-str
+ (org-export-data (car caption) info))))))
+
+(defun org-e-latex--guess-babel-language (header info)
+ "Set Babel's language according to LANGUAGE keyword.
+
+HEADER is the LaTeX header string. INFO is the plist used as
+a communication channel.
+
+Insertion of guessed language only happens when Babel package has
+explicitly been loaded. Then it is added to the rest of
+package's options.
+
+Return the new header."
+ (let ((language-code (plist-get info :language)))
+ ;; If no language is set or Babel package is not loaded, return
+ ;; HEADER as-is.
+ (if (or (not (stringp language-code))
+ (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
+ header
+ (let ((options (save-match-data
+ (org-split-string (match-string 1 header) ",")))
+ (language (cdr (assoc language-code
+ org-e-latex-babel-language-alist))))
+ ;; If LANGUAGE is already loaded, return header. Otherwise,
+ ;; append LANGUAGE to other options.
+ (if (member language options) header
+ (replace-match (mapconcat 'identity
+ (append options (list language))
+ ",")
+ nil nil header 1))))))
+
+(defun org-e-latex--guess-inputenc (header)
+ "Set the coding system in inputenc to what the buffer is.
+HEADER is the LaTeX header string. Return the new header."
+ (let* ((cs (or (ignore-errors
+ (latexenc-coding-system-to-inputenc
+ buffer-file-coding-system))
+ "utf8")))
+ (if (not cs) header
+ ;; First translate if that is requested.
+ (setq cs (or (cdr (assoc cs org-e-latex-inputenc-alist)) cs))
+ ;; Then find the \usepackage statement and replace the option.
+ (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
+ cs header t nil 1))))
+
+(defun org-e-latex--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-e-latex--make-option-string (options)
+ "Return a comma separated string of keywords and values.
+OPTIONS is an alist where the key is the options keyword as
+a string, and the value a list containing the keyword value, or
+nil."
+ (mapconcat (lambda (pair)
+ (concat (first pair)
+ (when (> (length (second pair)) 0)
+ (concat "=" (second pair)))))
+ options
+ ","))
+
+(defun org-e-latex--quotation-marks (text info)
+ "Export quotation marks depending on language conventions.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr (or (assoc (plist-get info :language) org-e-latex-quotes)
+ ;; Falls back on English.
+ (assoc "en" org-e-latex-quotes))))
+ text)
+
+(defun org-e-latex--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-e-latex--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (or (not output) (not label) (string= output "") (string= label ""))
+ output
+ (concat (format "\\label{%s}\n" label) output))))
+
+(defun org-e-latex--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-e-latex-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-e-latex-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ;; Handle the `verb' special case: Find and appropriate separator
+ ;; and use "\\verb" command.
+ ((eq 'verb fmt)
+ (let ((separator (org-e-latex--find-verb-separator text)))
+ (concat "\\verb" separator text separator)))
+ ;; Handle the `protectedtexttt' special case: Protect some
+ ;; special chars and use "\texttt{%s}" format string.
+ ((eq 'protectedtexttt fmt)
+ (let ((start 0)
+ (trans '(("\\" . "\\textbackslash{}")
+ ("~" . "\\textasciitilde{}")
+ ("^" . "\\textasciicircum{}")))
+ (rtn "")
+ char)
+ (while (string-match "[\\{}$%&_#~^]" text)
+ (setq char (match-string 0 text))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
+ (setq text (substring text (1+ (match-beginning 0))))
+ (setq char (or (cdr (assoc char trans)) (concat "\\" char))
+ rtn (concat rtn char)))
+ (setq text (concat rtn text)
+ fmt "\\texttt{%s}")
+ (while (string-match "--" text)
+ (setq text (replace-match "-{}-" t t text)))
+ (format fmt text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
+
+(defun org-e-latex--delayed-footnotes-definitions (element info)
+ "Return footnotes definitions in ELEMENT as a string.
+
+INFO is a plist used as a communication channel.
+
+Footnotes definitions are returned within \"\\footnotetxt{}\"
+commands.
+
+This function is used within constructs that don't support
+\"\\footnote{}\" command (i.e. an item's tag). In that case,
+\"\\footnotemark\" is used within the construct and the function
+just outside of it."
+ (mapconcat
+ (lambda (ref)
+ (format
+ "\\footnotetext[%s]{%s}"
+ (org-export-get-footnote-number ref info)
+ (org-trim
+ (org-export-data
+ (org-export-get-footnote-definition ref info) info))))
+ ;; Find every footnote reference in ELEMENT.
+ (let* (all-refs
+ search-refs ; For byte-compiler.
+ (search-refs
+ (function
+ (lambda (data)
+ ;; Return a list of all footnote references never seen
+ ;; before in DATA.
+ (org-element-map
+ data 'footnote-reference
+ (lambda (ref)
+ (when (org-export-footnote-first-reference-p ref info)
+ (push ref all-refs)
+ (when (eq (org-element-property :type ref) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition ref info)))))
+ info)
+ (reverse all-refs)))))
+ (funcall search-refs element))
+ ""))
+
+
+
+;;; Template
+
+(defun org-e-latex-template (contents info)
+ "Return complete document string after LaTeX conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let ((title (org-export-data (plist-get info :title) info)))
+ (concat
+ ;; Time-stamp.
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; Document class and packages.
+ (let ((class (plist-get info :latex-class))
+ (class-options (plist-get info :latex-class-options)))
+ (org-element-normalize-string
+ (let* ((header (nth 1 (assoc class org-e-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if class-options
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)"
+ class-options header t nil 1)
+ header))))
+ (when document-class-string
+ (org-e-latex--guess-babel-language
+ (org-e-latex--guess-inputenc
+ (org-splice-latex-header
+ document-class-string
+ org-export-latex-default-packages-alist ; defined in org.el
+ org-export-latex-packages-alist nil ; defined in org.el
+ (plist-get info :latex-header-extra)))
+ info)))))
+ ;; Possibly limit depth for headline numbering.
+ (let ((sec-num (plist-get info :section-numbers)))
+ (when (integerp sec-num)
+ (format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
+ ;; Author.
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info))))
+ (cond ((and author email (not (string= "" email)))
+ (format "\\author{%s\\thanks{%s}}\n" author email))
+ (author (format "\\author{%s}\n" author))
+ (t "\\author{}\n")))
+ ;; Date.
+ (let ((date (org-export-data (plist-get info :date) info)))
+ (and date (format "\\date{%s}\n" date)))
+ ;; Title
+ (format "\\title{%s}\n" title)
+ ;; Hyperref options.
+ (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
+ (or (plist-get info :keywords) "")
+ (or (plist-get info :description) "")
+ (if (not (plist-get info :with-creator)) ""
+ (plist-get info :creator)))
+ ;; Document start.
+ "\\begin{document}\n\n"
+ ;; Title command.
+ (org-element-normalize-string
+ (cond ((string= "" title) nil)
+ ((not (stringp org-e-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-e-latex-title-command)
+ (format org-e-latex-title-command title))
+ (t org-e-latex-title-command)))
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%d}\n" depth))
+ "\\tableofcontents\n\\vspace*{1cm}\n\n")))
+ ;; Document's body.
+ contents
+ ;; Creator.
+ (let ((creator-info (plist-get info :with-creator)))
+ (cond
+ ((not creator-info) "")
+ ((eq creator-info 'comment)
+ (format "%% %s\n" (plist-get info :creator)))
+ (t (concat (plist-get info :creator) "\n"))))
+ ;; Document end.
+ "\\end{document}")))
+
+
+
+;;; Transcode Functions
+
+;;;; Babel Call
+;;
+;; Babel Calls are ignored.
+
+
+;;;; Bold
+
+(defun org-e-latex-bold (bold contents info)
+ "Transcode BOLD from Org to LaTeX.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (org-e-latex--text-markup contents 'bold))
+
+
+;;;; Center Block
+
+(defun org-e-latex-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-e-latex--wrap-label
+ center-block
+ (format "\\begin{center}\n%s\\end{center}" contents)))
+
+
+;;;; Clock
+
+(defun org-e-latex-clock (clock contents info)
+ "Transcode a CLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "\\noindent"
+ (format "\\textbf{%s} " org-clock-string)
+ (format org-e-latex-inactive-timestamp-format
+ (concat (org-translate-time (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time (format " (%s)" time)))))
+ "\\\\"))
+
+
+;;;; Code
+
+(defun org-e-latex-code (code contents info)
+ "Transcode a CODE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-latex--text-markup (org-element-property :value code) 'code))
+
+
+;;;; Comment
+;;
+;; Comments are ignored.
+
+
+;;;; Comment Block
+;;
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-e-latex-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (if (functionp org-e-latex-format-drawer-function)
+ (funcall org-e-latex-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ (org-e-latex--wrap-label drawer output)))
+
+
+;;;; Dynamic Block
+
+(defun org-e-latex-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-e-latex--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-e-latex-entity (entity contents info)
+ "Transcode an ENTITY object from Org to LaTeX.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :latex entity)))
+ (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent)))
+
+
+;;;; Example Block
+
+(defun org-e-latex-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-e-latex--wrap-label
+ example-block
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default example-block info))))
+
+
+;;;; Export Block
+
+(defun org-e-latex-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "LATEX")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-e-latex-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-latex)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Fixed Width
+
+(defun org-e-latex-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-latex--wrap-label
+ fixed-width
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+
+;;;; Footnote Definition
+;;
+;; Footnote Definitions are ignored.
+
+
+;;;; Footnote Reference
+;;
+;; Footnote reference export is handled by
+;; `org-e-latex-footnote-reference'.
+;;
+;; Internally, `org-e-latex--get-footnote-counter' is used to restore
+;; the value of the LaTeX "footnote" counter after a jump due to
+;; a reference to an already defined footnote. It is only needed in
+;; item tags since the optional argument to \footnotemark is not
+;; allowed there.
+
+(defun org-e-latex--get-footnote-counter (footnote-reference info)
+ "Return \"footnote\" counter before FOOTNOTE-REFERENCE is encountered.
+INFO is a plist used as a communication channel."
+ ;; Find original counter value by counting number of footnote
+ ;; references appearing for the first time before the current
+ ;; footnote reference.
+ (let* ((label (org-element-property :label footnote-reference))
+ seen-refs
+ search-ref ; For byte-compiler.
+ (search-ref
+ (function
+ (lambda (data)
+ ;; Search footnote references through DATA, filling
+ ;; SEEN-REFS along the way.
+ (org-element-map
+ data 'footnote-reference
+ (lambda (fn)
+ (let ((fn-lbl (org-element-property :label fn)))
+ (cond
+ ;; Anonymous footnote match: return number.
+ ((eq fn footnote-reference) (length seen-refs))
+ ;; Anonymous footnote: it's always a new one.
+ ;; Also, be sure to return nil from the `cond' so
+ ;; `first-match' doesn't get us out of the loop.
+ ((not fn-lbl) (push 'inline seen-refs) nil)
+ ;; Label not seen so far: add it so SEEN-REFS.
+ ;;
+ ;; Also search for subsequent references in
+ ;; footnote definition so numbering follows reading
+ ;; logic. Note that we don't have to care about
+ ;; inline definitions, since `org-element-map'
+ ;; already traverse them at the right time.
+ ((not (member fn-lbl seen-refs))
+ (push fn-lbl seen-refs)
+ (funcall search-ref
+ (org-export-get-footnote-definition fn info))))))
+ ;; Don't enter footnote definitions since it will happen
+ ;; when their first reference is found.
+ info 'first-match 'footnote-definition)))))
+ (funcall search-ref (plist-get info :parse-tree))))
+
+(defun org-e-latex-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ org-e-latex-footnote-separator))
+ (cond
+ ;; Use \footnotemark if reference is within an item's tag.
+ ((eq (org-element-type (org-export-get-parent-element footnote-reference))
+ 'item)
+ (if (org-export-footnote-first-reference-p footnote-reference info)
+ "\\footnotemark"
+ ;; Since we can't specify footnote number as an optional
+ ;; argument within an item tag, some extra work has to be done
+ ;; when the footnote has already been referenced. In that
+ ;; case, set footnote counter to the desired number, use the
+ ;; footnotemark, then set counter back to its original value.
+ (format
+ "\\setcounter{footnote}{%s}\\footnotemark\\setcounter{footnote}{%s}"
+ (1- (org-export-get-footnote-number footnote-reference info))
+ (org-e-latex--get-footnote-counter footnote-reference info))))
+ ;; Use \footnotemark if the footnote has already been defined.
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (format "\\footnotemark[%s]{}"
+ (org-export-get-footnote-number footnote-reference info)))
+ ;; Use \footnotemark if reference is within another footnote
+ ;; reference or footnote definition.
+ ((loop for parent in (org-export-get-genealogy footnote-reference)
+ thereis (memq (org-element-type parent)
+ '(footnote-reference footnote-definition)))
+ "\\footnotemark")
+ ;; Otherwise, define it with \footnote command.
+ (t
+ (let ((def (org-export-get-footnote-definition footnote-reference info)))
+ (unless (eq (org-element-type def) 'org-data)
+ (setq def (cons 'org-data (cons nil def))))
+ (concat
+ (format "\\footnote{%s}" (org-trim (org-export-data def info)))
+ ;; Retrieve all footnote references within the footnote and
+ ;; add their definition after it, since LaTeX doesn't support
+ ;; them inside.
+ (org-e-latex--delayed-footnotes-definitions def info)))))))
+
+
+;;;; Headline
+
+(defun org-e-latex-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to LaTeX.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((class (plist-get info :latex-class))
+ (level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ (class-sectionning (assoc class org-e-latex-classes))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (let ((sec (if (and (symbolp (nth 2 class-sectionning))
+ (fboundp (nth 2 class-sectionning)))
+ (funcall (nth 2 class-sectionning) level numberedp)
+ (nth (1+ level) class-sectionning))))
+ (cond
+ ;; No section available for that LEVEL.
+ ((not sec) nil)
+ ;; Section format directly returned by a function.
+ ((stringp sec) sec)
+ ;; (numbered-section . unnumbered-section)
+ ((not (consp (cdr sec)))
+ (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s"))
+ ;; (numbered-open numbered-close)
+ ((= (length sec) 2)
+ (when numberedp (concat (car sec) "\n%s" (nth 1 sec))))
+ ;; (num-in num-out no-num-in no-num-out)
+ ((= (length sec) 4)
+ (if numberedp (concat (car sec) "\n%s" (nth 1 sec))
+ (concat (nth 2 sec) "\n%s" (nth 3 sec)))))))
+ (text (org-export-data (org-element-property :title headline) info))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ ;; Create the headline text along with a no-tag version. The
+ ;; latter is required to remove tags from table of contents.
+ (full-text (if (functionp org-e-latex-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-latex-format-headline-function
+ todo todo-type priority text tags)
+ ;; Default formatting.
+ (concat
+ (when todo
+ (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ text
+ (when tags
+ (format "\\hfill{}\\textsc{:%s:}"
+ (mapconcat 'identity tags ":"))))))
+ (full-text-no-tag
+ (if (functionp org-e-latex-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-latex-format-headline-function
+ todo todo-type priority text nil)
+ ;; Default formatting.
+ (concat
+ (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ text)))
+ ;; Associate some \label to the headline for internal links.
+ (headline-label
+ (format "\\label{sec-%s}\n"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number headline info)
+ "-")))
+ (pre-blanks
+ (make-string (org-element-property :pre-blank headline) 10)))
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (let ((low-level-body
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize)))
+ ;; Itemize headline
+ "\\item " full-text "\n" headline-label pre-blanks contents)))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize))
+ low-level-body))))
+ ;; Case 3. Standard headline. Export it as a section.
+ (t
+ (cond
+ ((not (and tags (eq (plist-get info :with-tags) 'not-in-toc)))
+ ;; Regular section. Use specified format string.
+ (format section-fmt full-text
+ (concat headline-label pre-blanks contents)))
+ ((string-match "\\`\\\\\\(.*?\\){" section-fmt)
+ ;; If tags should be removed from table of contents, insert
+ ;; title without tags as an alternative heading in sectioning
+ ;; command.
+ (format (replace-match (concat (match-string 1 section-fmt) "[%s]")
+ nil nil section-fmt 1)
+ ;; Replace square brackets with parenthesis since
+ ;; square brackets are not supported in optional
+ ;; arguments.
+ (replace-regexp-in-string
+ "\\[" "("
+ (replace-regexp-in-string
+ "\\]" ")"
+ full-text-no-tag))
+ full-text
+ (concat headline-label pre-blanks contents)))
+ (t
+ ;; Impossible to add an alternative heading. Fallback to
+ ;; regular sectioning format string.
+ (format section-fmt full-text
+ (concat headline-label pre-blanks contents))))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-e-latex-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((attr (org-export-read-attribute :attr_latex horizontal-rule))
+ (prev (org-export-get-previous-element horizontal-rule info)))
+ (concat
+ ;; Make sure the rule doesn't start at the end of the current
+ ;; line by separating it with a blank line from previous element.
+ (when (and prev
+ (let ((prev-blank (org-element-property :post-blank prev)))
+ (or (not prev-blank) (zerop prev-blank))))
+ "\n")
+ (org-e-latex--wrap-label
+ horizontal-rule
+ (format "\\rule{%s}{%s}"
+ (or (plist-get attr :width) "\\linewidth")
+ (or (plist-get attr :thickness) "0.5pt"))))))
+
+
+;;;; Inline Babel Call
+;;
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-e-latex-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block))
+ (separator (org-e-latex--find-verb-separator code)))
+ (cond
+ ;; Do not use a special package: transcode it verbatim.
+ ((not org-e-latex-listings)
+ (concat "\\verb" separator code separator))
+ ;; Use minted package.
+ ((eq org-e-latex-listings 'minted)
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (mint-lang (or (cadr (assq (intern org-lang)
+ org-e-latex-minted-langs))
+ org-lang))
+ (options (org-e-latex--make-option-string
+ org-e-latex-minted-options)))
+ (concat (format "\\mint%s{%s}"
+ (if (string= options "") "" (format "[%s]" options))
+ mint-lang)
+ separator code separator)))
+ ;; Use listings package.
+ (t
+ ;; Maybe translate language's name.
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (lst-lang (or (cadr (assq (intern org-lang)
+ org-e-latex-listings-langs))
+ org-lang))
+ (options (org-e-latex--make-option-string
+ (append org-e-latex-listings-options
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator))))))
+
+
+;;;; Inlinetask
+
+(defun org-e-latex-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((title (org-export-data (org-element-property :title inlinetask) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (org-element-property :todo-type inlinetask))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))))
+ ;; If `org-e-latex-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-e-latex-format-inlinetask-function)
+ (funcall org-e-latex-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (org-e-latex--wrap-label
+ inlinetask
+ (let ((full-title
+ (concat
+ (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ title
+ (when tags (format "\\hfill{}\\textsc{:%s:}"
+ (mapconcat 'identity tags ":"))))))
+ (format (concat "\\begin{center}\n"
+ "\\fbox{\n"
+ "\\begin{minipage}[c]{.6\\textwidth}\n"
+ "%s\n\n"
+ "\\rule[.8em]{\\textwidth}{2pt}\n\n"
+ "%s"
+ "\\end{minipage}\n"
+ "}\n"
+ "\\end{center}")
+ full-title contents))))))
+
+
+;;;; Italic
+
+(defun org-e-latex-italic (italic contents info)
+ "Transcode ITALIC from Org to LaTeX.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (org-e-latex--text-markup contents 'italic))
+
+
+;;;; Item
+
+(defun org-e-latex-item (item contents info)
+ "Transcode an ITEM element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((counter
+ (let ((count (org-element-property :counter item))
+ (level
+ (loop for parent in (org-export-get-genealogy item)
+ count (eq (org-element-type parent) 'plain-list)
+ until (eq (org-element-type parent) 'headline))))
+ (and count
+ (< level 5)
+ (format "\\setcounter{enum%s}{%s}\n"
+ (nth (1- level) '("i" "ii" "iii" "iv"))
+ (1- count)))))
+ (checkbox (case (org-element-property :checkbox item)
+ (on "$\\boxtimes$ ")
+ (off "$\\Box$ ")
+ (trans "$\\boxminus$ ")))
+ (tag (let ((tag (org-element-property :tag item)))
+ ;; Check-boxes must belong to the tag.
+ (and tag (format "[%s] "
+ (concat checkbox
+ (org-export-data tag info)))))))
+ (concat counter "\\item" (or tag (concat " " checkbox))
+ (and contents (org-trim contents))
+ ;; If there are footnotes references in tag, be sure to
+ ;; add their definition at the end of the item. This
+ ;; workaround is necessary since "\footnote{}" command is
+ ;; not supported in tags.
+ (and tag
+ (org-e-latex--delayed-footnotes-definitions
+ (org-element-property :tag item) info)))))
+
+
+;;;; Keyword
+
+(defun org-e-latex-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "LATEX") value)
+ ((string= key "INDEX") (format "\\index{%s}" value))
+ ;; Invisible targets.
+ ((string= key "TARGET") nil)
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (concat
+ (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%s}\n" depth))
+ "\\tableofcontents")))
+ ((string= "tables" value) "\\listoftables")
+ ((string= "figures" value) "\\listoffigures")
+ ((string= "listings" value)
+ (cond
+ ((eq org-e-latex-listings 'minted) "\\listoflistings")
+ (org-e-latex-listings "\\lstlistoflistings")
+ ;; At the moment, src blocks with a caption are wrapped
+ ;; into a figure environment.
+ (t "\\listoffigures")))))))))
+
+
+;;;; Latex Environment
+
+(defun org-e-latex-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((label (org-element-property :name latex-environment))
+ (value (org-remove-indentation
+ (org-element-property :value latex-environment))))
+ (if (not (org-string-nw-p label)) value
+ ;; Environment is labelled: label must be within the environment
+ ;; (otherwise, a reference pointing to that element will count
+ ;; the section instead).
+ (with-temp-buffer
+ (insert value)
+ (goto-char (point-min))
+ (forward-line)
+ (insert (format "\\label{%s}\n" label))
+ (buffer-string)))))
+
+
+;;;; Latex Fragment
+
+(defun org-e-latex-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value latex-fragment))
+
+
+;;;; Line Break
+
+(defun org-e-latex-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "\\\\")
+
+
+;;;; Link
+
+(defun org-e-latex-link--inline-image (link info)
+ "Return LaTeX code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (let* ((parent (org-export-get-parent-element link))
+ (path (let ((raw-path (org-element-property :path link)))
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (expand-file-name raw-path))))
+ (caption (org-e-latex--caption/label-string
+ (org-element-property :caption parent)
+ (org-element-property :name parent)
+ info))
+ ;; Retrieve latex attributes from the element around.
+ (attr (let ((raw-attr
+ (mapconcat #'identity
+ (org-element-property :attr_latex parent)
+ " ")))
+ (unless (string= raw-attr "") raw-attr)))
+ (disposition
+ (cond
+ ((and attr (string-match "\\<wrap\\>" attr)) 'wrap)
+ ((and attr (string-match "\\<multicolumn\\>" attr)) 'multicolumn)
+ ((or (and attr (string-match "\\<float\\>" attr))
+ (not (string= caption "")))
+ 'float)))
+ (placement
+ (cond
+ ((and attr (string-match "\\<placement=\\(\\S-+\\)" attr))
+ (org-match-string-no-properties 1 attr))
+ ((eq disposition 'wrap) "{l}{0.5\\textwidth}")
+ ((eq disposition 'float)
+ (concat "[" org-e-latex-default-figure-position "]"))
+ (t ""))))
+ ;; Now clear ATTR from any special keyword and set a default
+ ;; value if nothing is left.
+ (setq attr
+ (if (not attr) ""
+ (org-trim
+ (replace-regexp-in-string
+ "\\(wrap\\|multicolumn\\|float\\|placement=\\S-+\\)" "" attr))))
+ (setq attr (cond ((not (string= attr "")) attr)
+ ((eq disposition 'float) "width=0.7\\textwidth")
+ ((eq disposition 'wrap) "width=0.48\\textwidth")
+ (t (or org-e-latex-image-default-option ""))))
+ ;; Return proper string, depending on DISPOSITION.
+ (case disposition
+ (wrap (format "\\begin{wrapfigure}%s
+\\centering
+\\includegraphics[%s]{%s}
+%s\\end{wrapfigure}" placement attr path caption))
+ (multicolumn (format "\\begin{figure*}%s
+\\centering
+\\includegraphics[%s]{%s}
+%s\\end{figure*}" placement attr path caption))
+ (float (format "\\begin{figure}%s
+\\centering
+\\includegraphics[%s]{%s}
+%s\\end{figure}" placement attr path caption))
+ (t (format "\\includegraphics[%s]{%s}" attr path)))))
+
+(defun org-e-latex-link (link desc info)
+ "Transcode a LINK object from Org to LaTeX.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (imagep (org-export-inline-image-p
+ link org-e-latex-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; Image file.
+ (imagep (org-e-latex-link--inline-image link info))
+ ;; Radio link: Transcode target's contents and use them as link's
+ ;; description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (format "\\hyperref[%s]{%s}"
+ (org-export-solidify-link-text path)
+ (org-export-data (org-element-contents destination) info)))))
+ ;; Links pointing to an headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "\\href{file://%s}{%s}" destination desc)
+ (format "\\url{file://%s}" destination)))
+ ;; Fuzzy link points nowhere.
+ ('nil
+ (format org-e-latex-link-with-unknown-path-format
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; Fuzzy link points to an invisible target.
+ (keyword nil)
+ ;; LINK points to an headline. If headlines are numbered
+ ;; and the link has no description, display headline's
+ ;; number. Otherwise, display description or headline's
+ ;; title.
+ (headline
+ (let ((label
+ (format "sec-%s"
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number destination info)
+ "-"))))
+ (if (and (plist-get info :section-numbers) (not desc))
+ (format "\\ref{%s}" label)
+ (format "\\hyperref[%s]{%s}" label
+ (or desc
+ (org-export-data
+ (org-element-property :title destination) info))))))
+ ;; Fuzzy link points to a target. Do as above.
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "\\ref{%s}" path)
+ (format "\\hyperref[%s]{%s}" path desc)))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (format (org-export-get-coderef-format path desc)
+ (org-export-resolve-coderef path info)))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'latex))
+ ;; External link with a description part.
+ ((and path desc) (format "\\href{%s}{%s}" path desc))
+ ;; External link without a description part.
+ (path (format "\\url{%s}" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format org-e-latex-link-with-unknown-path-format desc)))))
+
+
+;;;; Macro
+
+(defun org-e-latex-macro (macro contents info)
+ "Transcode a MACRO element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+
+;;;; Paragraph
+
+(defun org-e-latex-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to LaTeX.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ contents)
+
+
+;;;; Plain List
+
+(defun org-e-latex-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to LaTeX.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (paralist-types '("inparaenum" "asparaenum" "inparaitem" "asparaitem"
+ "inparadesc" "asparadesc"))
+ (paralist-regexp (concat
+ "\\("
+ (mapconcat 'identity paralist-types "\\|")
+ "\\)"))
+ (attr (mapconcat #'identity
+ (org-element-property :attr_latex plain-list)
+ " "))
+ (latex-type (cond
+ ((and attr
+ (string-match
+ (format "\\<%s\\>" paralist-regexp) attr))
+ (match-string 1 attr))
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'unordered) "itemize")
+ ((eq type 'descriptive) "description"))))
+ (org-e-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s\n%s\\end{%s}"
+ latex-type
+ ;; Once special environment, if any, has been removed, the
+ ;; rest of the attributes will be optional arguments.
+ ;; They will be put inside square brackets if necessary.
+ (let ((opt (replace-regexp-in-string
+ (format " *%s *" paralist-regexp) "" attr)))
+ (cond ((string= opt "") "")
+ ((string-match "\\`\\[[^][]+\\]\\'" opt) opt)
+ (t (format "[%s]" opt))))
+ contents
+ latex-type))))
+
+
+;;;; Plain Text
+
+(defun org-e-latex-plain-text (text info)
+ "Transcode a TEXT string from Org to LaTeX.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect %, #, &, $, ~, ^, _, { and }.
+ (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}~^_]\\)" text)
+ (setq text
+ (replace-match (format "\\%s" (match-string 2 text)) nil t text 2)))
+ ;; Protect \
+ (setq text (replace-regexp-in-string
+ "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
+ "$\\backslash$" text nil t 1))
+ ;; LaTeX into \LaTeX{} and TeX into \TeX{}.
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" text start)
+ (setq text (replace-match
+ (format "\\%s{}" (match-string 1 text)) nil t text)
+ start (match-end 0))))
+ ;; Handle quotation marks
+ (setq text (org-e-latex--quotation-marks text info))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (while (string-match (regexp-quote "...") text)
+ (setq text (replace-match "\\ldots{}" nil t text))))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n"
+ text)))
+ ;; Return value.
+ text)
+
+
+;;;; Planning
+
+(defun org-e-latex-planning (planning contents info)
+ "Transcode a PLANNING element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "\\noindent"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "\\textbf{%s} " org-closed-string)
+ (format org-e-latex-inactive-timestamp-format
+ (org-translate-time closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "\\textbf{%s} " org-deadline-string)
+ (format org-e-latex-active-timestamp-format
+ (org-translate-time deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "\\textbf{%s} " org-scheduled-string)
+ (format org-e-latex-active-timestamp-format
+ (org-translate-time scheduled)))))))
+ " ")
+ "\\\\"))
+
+
+;;;; Property Drawer
+
+(defun org-e-latex-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+
+;;;; Quote Block
+
+(defun org-e-latex-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-latex--wrap-label
+ quote-block
+ (format "\\begin{quote}\n%s\\end{quote}" contents)))
+
+
+;;;; Quote Section
+
+(defun org-e-latex-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
+
+
+;;;; Radio Target
+
+(defun org-e-latex-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to LaTeX.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "\\label{%s}%s"
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+
+;;;; Section
+
+(defun org-e-latex-section (section contents info)
+ "Transcode a SECTION element from Org to LaTeX.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Special Block
+
+(defun org-e-latex-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block))))
+ (org-e-latex--wrap-label
+ special-block
+ (format "\\begin{%s}\n%s\\end{%s}" type contents type))))
+
+
+;;;; Src Block
+
+(defun org-e-latex-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (label (org-element-property :name src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-e-latex-custom-lang-environments))))
+ (num-start (case (org-element-property :number-lines src-block)
+ (continued (org-export-get-loc src-block info))
+ (new 0)))
+ (retain-labels (org-element-property :retain-labels src-block)))
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-e-latex-listings)
+ (let ((caption-str (org-e-latex--caption/label-string caption label info))
+ (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}")))
+ (format
+ (or float-env "%s")
+ (concat caption-str
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default src-block info))))))
+ ;; Case 2. Custom environment.
+ (custom-env (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-env
+ (org-export-format-code-default src-block info)
+ custom-env))
+ ;; Case 3. Use minted package.
+ ((eq org-e-latex-listings 'minted)
+ (let ((float-env (when (or label caption)
+ (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
+ (org-e-latex--caption/label-string
+ caption label info))))
+ (body
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ ;; Options.
+ (org-e-latex--make-option-string
+ (if (not num-start) org-e-latex-minted-options
+ (append `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ org-e-latex-minted-options)))
+ ;; Language.
+ (or (cadr (assq (intern lang) org-e-latex-minted-langs)) lang)
+ ;; Source code.
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'length
+ (org-split-string (car code-info) "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line
+ ;; of code.
+ (concat (make-string (+ (- max-width (length loc)) 6) ? )
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))
+ ;; Return value.
+ (if float-env (format float-env body) body)))
+ ;; Case 4. Use listings package.
+ (t
+ (let ((lst-lang
+ (or (cadr (assq (intern lang) org-e-latex-listings-langs)) lang))
+ (caption-str
+ (when caption
+ (let ((main (org-export-data (car caption) info)))
+ (if (not (cdr caption)) (format "{%s}" main)
+ (format "{[%s]%s}"
+ (org-export-data (cdr caption) info)
+ main))))))
+ (concat
+ ;; Options.
+ (format "\\lstset{%s}\n"
+ (org-e-latex--make-option-string
+ (append org-e-latex-listings-options
+ `(("language" ,lst-lang))
+ (when label `(("label" ,label)))
+ (when caption-str `(("caption" ,caption-str)))
+ (cond ((not num-start) '(("numbers" "none")))
+ ((zerop num-start) '(("numbers" "left")))
+ (t `(("numbers" "left")
+ ("firstnumber"
+ ,(number-to-string (1+ num-start)))))))))
+ ;; Source code.
+ (format
+ "\\begin{lstlisting}\n%s\\end{lstlisting}"
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'length
+ (org-split-string (car code-info) "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line of
+ ;; code
+ (concat (make-string (+ (- max-width (length loc)) 6) ? )
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-e-latex-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (replace-regexp-in-string
+ "%" "\\%" (org-element-property :value statistics-cookie) nil t))
+
+
+;;;; Strike-Through
+
+(defun org-e-latex-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to LaTeX.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (org-e-latex--text-markup contents 'strike-through))
+
+
+;;;; Subscript
+
+(defun org-e-latex-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to LaTeX.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (= (length contents) 1) (format "$_%s$" contents)
+ ;; Handle multiple objects in SUBSCRIPT by creating a subscript
+ ;; command for each of them.
+ (let ((prev-blanks 0))
+ (mapconcat
+ (lambda (obj)
+ (case (org-element-type obj)
+ ((entity latex-fragment)
+ (setq prev-blanks (org-element-property :post-blank obj))
+ (let ((data (org-trim (org-export-data obj info))))
+ (string-match
+ "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'"
+ data)
+ (format "$_{%s}$" (match-string 1 data))))
+ (plain-text
+ (format "$_\\mathrm{%s}$"
+ (concat (make-string prev-blanks ? )
+ ;; mathrm command doesn't handle spaces,
+ ;; so we have to enforce them.
+ (replace-regexp-in-string
+ " " "\\\\ " (org-export-data obj info)))))
+ (otherwise
+ (setq prev-blanks (org-element-property :post-blank obj))
+ (format "$_{%s}$" (org-export-data obj info)))))
+ (org-element-contents subscript) ""))))
+
+
+;;;; Superscript
+
+(defun org-e-latex-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to LaTeX.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (= (length contents) 1) (format "$^%s$" contents)
+ ;; Handle multiple objects in SUPERSCRIPT by creating
+ ;; a superscript command for each of them.
+ (let ((prev-blanks 0))
+ (mapconcat
+ (lambda (obj)
+ (case (org-element-type obj)
+ ((entity latex-fragment)
+ (setq prev-blanks (org-element-property :post-blank obj))
+ (let ((data (org-trim (org-export-data obj info))))
+ (string-match
+ "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'"
+ data)
+ (format "$^{%s}$" (match-string 1 data))))
+ (plain-text
+ (format "$^\\mathrm{%s}$"
+ (concat (make-string prev-blanks ? )
+ ;; mathrm command doesn't handle spaces,
+ ;; so we have to enforce them.
+ (replace-regexp-in-string
+ " " "\\\\ " (org-export-data obj info)))))
+ (otherwise
+ (setq prev-blanks (org-element-property :post-blank obj))
+ (format "$^{%s}$" (org-export-data obj info)))))
+ (org-element-contents superscript) ""))))
+
+
+;;;; Table
+;;
+;; `org-e-latex-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" attribute. Otherwise, it
+;; delegates the job to either `org-e-latex-table--table.el-table' or
+;; `org-e-latex-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-e-latex-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-e-latex-table (table contents info)
+ "Transcode a TABLE element from Org to LaTeX.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (cond
+ ;; Case 1: verbatim table.
+ ((or org-e-latex-tables-verbatim
+ (let ((attr (mapconcat 'identity
+ (org-element-property :attr_latex table)
+ " ")))
+ (and attr (string-match "\\<verbatim\\>" attr))))
+ (format "\\begin{verbatim}\n%s\n\\end{verbatim}"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+ ;; Case 2: table.el table. Convert it using appropriate tools.
+ ((eq (org-element-property :type table) 'table.el)
+ (org-e-latex-table--table.el-table table contents info))
+ ;; Case 3: Standard table.
+ (t (org-e-latex-table--org-table table contents info))))
+
+(defun org-e-latex-table--align-string (table info)
+ "Return an appropriate LaTeX alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (let ((attr (mapconcat 'identity
+ (org-element-property :attr_latex table)
+ " ")))
+ (if (string-match "\\<align=\\(\\S-+\\)" attr) (match-string 1 attr)
+ (let (alignment)
+ ;; Extract column groups and alignment from first (non-rule)
+ ;; row.
+ (org-element-map
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row) 'standard) row))
+ info 'first-match)
+ 'table-cell
+ (lambda (cell)
+ (let ((borders (org-export-table-cell-borders cell info)))
+ ;; Check left border for the first cell only.
+ (when (and (memq 'left borders) (not alignment))
+ (push "|" alignment))
+ (push (case (org-export-table-cell-alignment cell info)
+ (left "l")
+ (right "r")
+ (center "c"))
+ alignment)
+ (when (memq 'right borders) (push "|" alignment))))
+ info)
+ (apply 'concat (reverse alignment))))))
+
+(defun org-e-latex-table--org-table (table contents info)
+ "Return appropriate LaTeX code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' attribute."
+ (let* ((label (org-element-property :name table))
+ (caption (org-e-latex--caption/label-string
+ (org-element-property :caption table) label info))
+ (attr (mapconcat 'identity
+ (org-element-property :attr_latex table)
+ " "))
+ ;; Determine alignment string.
+ (alignment (org-e-latex-table--align-string table info))
+ ;; Determine environment for the table: longtable, tabular...
+ (table-env (cond
+ ((not attr) org-e-latex-default-table-environment)
+ ((string-match "\\<longtable\\>" attr) "longtable")
+ ((string-match "\\<tabular.?\\>" attr)
+ (org-match-string-no-properties 0 attr))
+ (t org-e-latex-default-table-environment)))
+ ;; If table is a float, determine environment: table, table*
+ ;; or sidewaystable.
+ (float-env (cond
+ ((string= "longtable" table-env) nil)
+ ((and attr (string-match "\\<sidewaystable\\>" attr))
+ "sidewaystable")
+ ((and attr
+ (or (string-match (regexp-quote "table*") attr)
+ (string-match "\\<multicolumn\\>" attr)))
+ "table*")
+ ((or (not (string= caption "")) label) "table")))
+ ;; Extract others display options.
+ (width (and attr (string-match "\\<width=\\(\\S-+\\)" attr)
+ (org-match-string-no-properties 1 attr)))
+ (placement
+ (if (and attr (string-match "\\<placement=\\(\\S-+\\)" attr))
+ (org-match-string-no-properties 1 attr)
+ (format "[%s]" org-e-latex-default-figure-position))))
+ ;; Prepare the final format string for the table.
+ (cond
+ ;; Longtable.
+ ((string= "longtable" table-env)
+ (format
+ "\\begin{longtable}{%s}\n%s%s%s\\end{longtable}"
+ alignment
+ (if (or (not org-e-latex-table-caption-above) (string= "" caption)) ""
+ (concat (org-trim caption) "\\\\\n"))
+ contents
+ (if (or org-e-latex-table-caption-above (string= "" caption)) ""
+ (concat (org-trim caption) "\\\\\n"))))
+ ;; Others.
+ (t (concat (when float-env
+ (concat
+ (format "\\begin{%s}%s\n" float-env placement)
+ (if org-e-latex-table-caption-above caption "")))
+ (when org-e-latex-tables-centered "\\begin{center}\n")
+ (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
+ table-env
+ (if width (format "{%s}" width) "")
+ alignment
+ contents
+ table-env)
+ (when org-e-latex-tables-centered "\n\\end{center}")
+ (when float-env
+ (concat (if org-e-latex-table-caption-above "" caption)
+ (format "\n\\end{%s}" float-env))))))))
+
+(defun org-e-latex-table--table.el-table (table contents info)
+ "Return appropriate LaTeX code for a table.el table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `table.el' as its `:type'
+attribute."
+ (require 'table)
+ ;; Ensure "*org-export-table*" buffer is empty.
+ (with-current-buffer (get-buffer-create "*org-export-table*")
+ (erase-buffer))
+ (let ((output (with-temp-buffer
+ (insert (org-element-property :value table))
+ (goto-char 1)
+ (re-search-forward "^[ \t]*|[^|]" nil t)
+ (table-generate-source 'latex "*org-export-table*")
+ (with-current-buffer "*org-export-table*"
+ (org-trim (buffer-string))))))
+ (kill-buffer (get-buffer "*org-export-table*"))
+ ;; Remove left out comments.
+ (while (string-match "^%.*\n" output)
+ (setq output (replace-match "" t t output)))
+ ;; When the "rmlines" attribute is provided, remove all hlines but
+ ;; the the one separating heading from the table body.
+ (let ((attr (mapconcat 'identity
+ (org-element-property :attr_latex table)
+ " ")))
+ (when (and attr (string-match "\\<rmlines\\>" attr))
+ (let ((n 0) (pos 0))
+ (while (and (< (length output) pos)
+ (setq pos (string-match "^\\\\hline\n?" output pos)))
+ (incf n)
+ (unless (= n 2)
+ (setq output (replace-match "" nil nil output)))))))
+ (if (not org-e-latex-tables-centered) output
+ (format "\\begin{center}\n%s\n\\end{center}" output))))
+
+
+;;;; Table Cell
+
+(defun org-e-latex-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to LaTeX.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-e-latex-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-e-latex-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) " & ")))
+
+
+;;;; Table Row
+
+(defun org-e-latex-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to LaTeX.
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((attr (mapconcat 'identity
+ (org-element-property
+ :attr_latex (org-export-get-parent table-row))
+ " "))
+ (longtablep (and attr (string-match "\\<longtable\\>" attr)))
+ (booktabsp
+ (or (and attr (string-match "\\<booktabs=\\(yes\\|t\\)\\>" attr))
+ org-e-latex-tables-booktabs))
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (borders
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (concat
+ ;; When BOOKTABS are activated enforce top-rule even when no
+ ;; hline was specifically marked.
+ (cond ((and booktabsp (memq 'top borders)) "\\toprule\n")
+ ((and (memq 'top borders) (memq 'above borders)) "\\hline\n"))
+ contents "\\\\\n"
+ (cond
+ ;; Special case for long tables. Define header and footers.
+ ((and longtablep (org-export-table-row-ends-header-p table-row info))
+ (format "%s
+\\endhead
+%s\\multicolumn{%d}{r}{Continued on next page} \\\\
+\\endfoot
+\\endlastfoot"
+ (if booktabsp "\\midrule" "\\hline")
+ (if booktabsp "\\midrule" "\\hline")
+ ;; Number of columns.
+ (cdr (org-export-table-dimensions
+ (org-export-get-parent-table table-row) info))))
+ ;; When BOOKTABS are activated enforce bottom rule even when
+ ;; no hline was specifically marked.
+ ((and booktabsp (memq 'bottom borders)) "\\bottomrule")
+ ((and (memq 'bottom borders) (memq 'below borders)) "\\hline")
+ ((memq 'below borders) (if booktabsp "\\midrule" "\\hline")))))))
+
+
+;;;; Target
+
+(defun org-e-latex-target (target contents info)
+ "Transcode a TARGET object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\label{%s}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Timestamp
+
+(defun org-e-latex-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-translate-time (org-element-property :value timestamp)))
+ (range-end (org-element-property :range-end timestamp)))
+ (case (org-element-property :type timestamp)
+ (active (format org-e-latex-active-timestamp-format value))
+ (active-range
+ (concat (format org-e-latex-active-timestamp-format value)
+ "--"
+ (format org-e-latex-active-timestamp-format
+ (org-translate-time range-end))))
+ (inactive (format org-e-latex-inactive-timestamp-format value))
+ (inactive-range
+ (concat (format org-e-latex-inactive-timestamp-format value)
+ "--"
+ (format org-e-latex-inactive-timestamp-format
+ (org-translate-time range-end))))
+ (otherwise (format org-e-latex-diary-timestamp-format value)))))
+
+
+;;;; Underline
+
+(defun org-e-latex-underline (underline contents info)
+ "Transcode UNDERLINE from Org to LaTeX.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (org-e-latex--text-markup contents 'underline))
+
+
+;;;; Verbatim
+
+(defun org-e-latex-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-latex--text-markup (org-element-property :value verbatim) 'verbatim))
+
+
+;;;; Verse Block
+
+(defun org-e-latex-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to LaTeX.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (org-e-latex--wrap-label
+ verse-block
+ ;; In a verse environment, add a line break to each newline
+ ;; character and change each white space at beginning of a line
+ ;; into a space of 1 em. Also change each blank line with
+ ;; a vertical space of 1 em.
+ (progn
+ (setq contents (replace-regexp-in-string
+ "^ *\\\\\\\\$" "\\\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents)))
+ (while (string-match "^[ \t]+" contents)
+ (let ((new-str (format "\\hspace*{%dem}"
+ (length (match-string 0 contents)))))
+ (setq contents (replace-match new-str nil t contents))))
+ (format "\\begin{verse}\n%s\\end{verse}" contents))))
+
+
+
+;;; Interactive functions
+
+;;;###autoload
+(defun org-e-latex-export-as-latex
+ (&optional subtreep visible-only body-only ext-plist)
+ "Export current buffer as a LaTeX buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org E-LATEX Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (let ((outbuf (org-export-to-buffer
+ 'e-latex "*Org E-LATEX Export*"
+ subtreep visible-only body-only ext-plist)))
+ (with-current-buffer outbuf (LaTeX-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf))))
+
+;;;###autoload
+(defun org-e-latex-export-to-latex
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a LaTeX file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-latex outfile subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-e-latex-export-to-pdf
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to LaTeX then process through to PDF.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return PDF file's name."
+ (interactive)
+ (org-e-latex-compile
+ (org-e-latex-export-to-latex
+ subtreep visible-only body-only ext-plist pub-dir)))
+
+(defun org-e-latex-compile (texfile)
+ "Compile a TeX file.
+
+TEXFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-e-latex-pdf-process'.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((wconfig (current-window-configuration))
+ (texfile (file-truename texfile))
+ (base (file-name-sans-extension texfile))
+ errors)
+ (message (format "Processing LaTeX file %s ..." texfile))
+ (unwind-protect
+ (progn
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-e-latex-pdf-process)
+ (funcall org-e-latex-pdf-process (shell-quote-argument texfile)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org PDF LaTeX Output*" buffer.
+ ((consp org-e-latex-pdf-process)
+ (let* ((out-dir (or (file-name-directory texfile) "./"))
+ (outbuf (get-buffer-create "*Org PDF LaTeX Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument texfile)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-e-latex-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-e-latex--collect-errors outbuf))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat base ".pdf")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p pdffile))
+ (error (concat (format "PDF file %s wasn't produced" pdffile)
+ (when errors (concat ": " errors))))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when org-e-latex-remove-logfiles
+ (dolist (ext org-e-latex-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))
+ (set-window-configuration wconfig))))
+
+(defun org-e-latex--collect-errors (buffer)
+ "Collect some kind of errors from \"pdflatex\" command output.
+
+BUFFER is the buffer containing output.
+
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ ;; Find final "pdflatex" run.
+ (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
+ (let ((case-fold-search t)
+ (errors ""))
+ (when (save-excursion
+ (re-search-forward "Reference.*?undefined" nil t))
+ (setq errors (concat errors " [undefined reference]")))
+ (when (save-excursion
+ (re-search-forward "Citation.*?undefined" nil t))
+ (setq errors (concat errors " [undefined citation]")))
+ (when (save-excursion
+ (re-search-forward "Undefined control sequence" nil t))
+ (setq errors (concat errors " [undefined control sequence]")))
+ (when (save-excursion
+ (re-search-forward "^! LaTeX.*?Error" nil t))
+ (setq errors (concat errors " [LaTeX error]")))
+ (when (save-excursion
+ (re-search-forward "^! Package.*?Error" nil t))
+ (setq errors (concat errors " [package error]")))
+ (and (org-string-nw-p errors) (org-trim errors)))))))
+
+
+(provide 'org-e-latex)
+;;; org-e-latex.el ends here
diff --git a/contrib/lisp/org-e-man.el b/contrib/lisp/org-e-man.el
new file mode 100644
index 0000000..981f831
--- /dev/null
+++ b/contrib/lisp/org-e-man.el
@@ -0,0 +1,1363 @@
+;; org-e-man.el --- Man Back-End For Org Export Engine
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a Man back-end for Org generic exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'e-man "*Test e-Man*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the Man
+;; export. See contrib/lisp/org-export.el for more details on how
+;; this exporter works.
+;;
+;; It introduces one new buffer keywords:
+;; "MAN_CLASS_OPTIONS".
+
+;;;; Code:
+
+(require 'org-export)
+
+(eval-when-compile (require 'cl))
+
+(defvar org-export-man-default-packages-alist)
+(defvar org-export-man-packages-alist)
+
+
+
+
+
+
+;;;; Define Back-End
+
+(defvar org-e-man-translate-alist
+ '((babel-call . org-e-man-babel-call)
+ (bold . org-e-man-bold)
+ (center-block . org-e-man-center-block)
+ (clock . org-e-man-clock)
+ (code . org-e-man-code)
+ (comment . org-e-man-comment)
+ (comment-block . org-e-man-comment-block)
+ (drawer . org-e-man-drawer)
+ (dynamic-block . org-e-man-dynamic-block)
+ (entity . org-e-man-entity)
+ (example-block . org-e-man-example-block)
+ (export-block . org-e-man-export-block)
+ (export-snippet . org-e-man-export-snippet)
+ (fixed-width . org-e-man-fixed-width)
+ (footnote-definition . org-e-man-footnote-definition)
+ (footnote-reference . org-e-man-footnote-reference)
+ (headline . org-e-man-headline)
+ (horizontal-rule . org-e-man-horizontal-rule)
+ (inline-babel-call . org-e-man-inline-babel-call)
+ (inline-src-block . org-e-man-inline-src-block)
+ (inlinetask . org-e-man-inlinetask)
+ (italic . org-e-man-italic)
+ (item . org-e-man-item)
+ (keyword . org-e-man-keyword)
+ (man-environment . org-e-man-man-environment)
+ (man-fragment . org-e-man-man-fragment)
+ (line-break . org-e-man-line-break)
+ (link . org-e-man-link)
+ (macro . org-e-man-macro)
+ (paragraph . org-e-man-paragraph)
+ (plain-list . org-e-man-plain-list)
+ (plain-text . org-e-man-plain-text)
+ (planning . org-e-man-planning)
+ (property-drawer . org-e-man-property-drawer)
+ (quote-block . org-e-man-quote-block)
+ (quote-section . org-e-man-quote-section)
+ (radio-target . org-e-man-radio-target)
+ (section . org-e-man-section)
+ (special-block . org-e-man-special-block)
+ (src-block . org-e-man-src-block)
+ (statistics-cookie . org-e-man-statistics-cookie)
+ (strike-through . org-e-man-strike-through)
+ (subscript . org-e-man-subscript)
+ (superscript . org-e-man-superscript)
+ (table . org-e-man-table)
+ (table-cell . org-e-man-table-cell)
+ (table-row . org-e-man-table-row)
+ (target . org-e-man-target)
+ (template . org-e-man-template)
+ (timestamp . org-e-man-timestamp)
+ (underline . org-e-man-underline)
+ (verbatim . org-e-man-verbatim)
+ (verse-block . org-e-man-verse-block))
+ "Alist between element or object types and translators.")
+
+(defconst org-e-man-options-alist
+ '((:date "DATE" nil nil t)
+ (:man-class "MAN_CLASS" nil nil t)
+ (:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
+ (:man-header-extra "MAN_HEADER" nil nil newline))
+ "Alist between Man export properties and ways to set them.
+See `org-export-options-alist' for more information on the
+structure of the values.")
+
+
+
+
+;;; User Configurable Variables
+
+
+(defgroup org-export-e-man nil
+ "Options for exporting Org mode files to Man."
+ :tag "Org Export Man"
+ :group 'org-export)
+
+
+;;;; Tables
+
+
+(defcustom org-e-man-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-e-man
+ :type 'boolean)
+
+(defcustom org-e-man-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-e-man
+ :type 'boolean)
+
+(defcustom org-e-man-table-scientific-notation "%sE%s"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-e-man
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+
+;;;; Inlinetasks
+
+
+;; Src blocks
+
+(defcustom org-e-man-source-highlight nil
+ "Use GNU source highlight to embellish source blocks "
+ :group 'org-export-e-man
+ :type 'boolean)
+
+(defcustom org-e-man-source-highlight-langs
+ '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
+ (scheme "scheme")
+ (c "c") (cc "cpp") (csharp "csharp") (d "d")
+ (fortran "fortran") (cobol "cobol") (pascal "pascal")
+ (ada "ada") (asm "asm")
+ (perl "perl") (cperl "perl")
+ (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
+ (java "java") (javascript "javascript")
+ (tex "latex")
+ (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
+ (ocaml "caml") (caml "caml")
+ (sql "sql") (sqlite "sql")
+ (html "html") (css "css") (xml "xml")
+ (bat "bat") (bison "bison") (clipper "clipper")
+ (ldap "ldap") (opa "opa")
+ (php "php") (postscript "postscript") (prolog "prolog")
+ (properties "properties") (makefile "makefile")
+ (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the listings package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present."
+ :group 'org-export-e-man
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+
+(defvar org-e-man-custom-lang-environments nil
+ "Alist mapping languages to language-specific Man environments.
+
+It is used during export of src blocks by the listings and
+man packages. For example,
+
+ \(setq org-e-man-custom-lang-environments
+ '\(\(python \"pythoncode\"\)\)\)
+
+would have the effect that if org encounters begin_src python
+during man export."
+)
+
+
+;;;; Plain text
+
+(defcustom org-e-man-quotes
+ '(("fr"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~")
+ ("\\(\\S-\\)\"" . "~»")
+ ("\\(\\s-\\|(\\|^\\)'" . "'"))
+ ("en"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "``")
+ ("\\(\\S-\\)\"" . "''")
+ ("\\(\\s-\\|(\\|^\\)'" . "`")))
+
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-man
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+
+;;;; Compilation
+
+(defcustom org-e-man-pdf-process
+ '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
+
+ "Commands to process a Man file to a PDF file.
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+full file name, %b by the file base name \(i.e. without
+extension) and %o by the base directory of the file.
+
+
+By default, Org uses 3 runs of to do the processing.
+
+Alternatively, this may be a Lisp function that does the
+processing. This function should accept the file name as
+its single argument."
+ :group 'org-export-pdf
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdfgroff"
+ ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"))
+ (const :tag "3 runs of pdfgroff"
+ ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"))
+ (function)))
+
+(defcustom org-e-man-logfiles-extensions
+ '("log" "out" "toc")
+ "The list of file extensions to consider as Man logfiles."
+ :group 'org-export-e-man
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-e-man-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+These are the .aux, .log, .out, and .toc files."
+ :group 'org-export-e-man
+ :type 'boolean)
+
+
+
+;; Preamble
+
+
+;; Adding MAN as a block parser to make sure that its contents
+;; does not execute
+
+(add-to-list 'org-element-block-name-alist
+ '("MAN" . org-element-export-block-parser))
+
+
+
+
+
+;;; Internal Functions
+
+(defun org-e-man--caption/label-string (caption label info)
+ "Return caption and label Man string for floats.
+
+CAPTION is a cons cell of secondary strings, the car being the
+standard caption and the cdr its short form. LABEL is a string
+representing the label. INFO is a plist holding contextual
+information.
+
+If there's no caption nor label, return the empty string.
+
+For non-floats, see `org-e-man--wrap-label'."
+ (let ((label-str ""))
+ (cond
+ ((and (not caption) (not label)) "")
+ ((not caption) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ ((cdr caption)
+ (format "\\fR%s\\fP - \\fI%s\\P - %s\n"
+ (org-export-data (cdr caption) info)
+ label-str
+ (org-export-data (car caption) info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP"
+ (org-export-data (car caption) info))))))
+
+(defun org-e-man--quotation-marks (text info)
+ "Export quotation marks depending on language conventions.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr (or (assoc (plist-get info :language) org-e-man-quotes)
+ ;; Falls back on English.
+ (assoc "en" org-e-man-quotes))))
+ text)
+
+(defun org-e-man--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-e-man--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (or (not output) (not label) (string= output "") (string= label ""))
+ output
+ (concat (format "%s\n.br\n" label) output))))
+
+
+
+
+;;; Template
+
+(defun org-e-man-template (contents info)
+ "Return complete document string after Man conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (attr
+ (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (list (plist-get info :man-class-options))
+ " "))))
+ (section-item (plist-get attr :section-id)))
+
+ (concat
+ (cond
+ ((and title (stringp section-item))
+ (format ".TH \"%s\" \"%s\" \n" title section-item))
+ ((and (string= "" title) (stringp section-item))
+ (format ".TH \"%s\" \"%s\" \n" " " section-item))
+ (title
+ (format ".TH \"%s\" \"1\" \n" title))
+ (t
+ ".TH \" \" \"1\" "))
+ contents)))
+
+
+
+
+;;; Transcode Functions
+
+;;;; Babel Call
+
+;; Babel Calls are ignored.
+
+
+;;;; Bold
+
+(defun org-e-man-bold (bold contents info)
+ "Transcode BOLD from Org to Man.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "\\fB%s\\fP" contents))
+
+
+;;;; Center Block
+
+(defun org-e-man-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to Man.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-e-man--wrap-label
+ center-block
+ (format ".ce %d\n.nf\n%s\n.fi"
+ (- (length (split-string contents "\n")) 1)
+ contents)))
+
+
+;;;; Clock
+
+(defun org-e-man-clock (clock contents info)
+ "Transcode a CLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ "")
+
+
+;;;; Code
+
+(defun org-e-man-code (code contents info)
+ "Transcode a CODE object from Org to Man.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "\\fC%s\\fP" code))
+
+
+;;;; Comment
+;; Comments are ignored.
+
+
+;;;; Comment Block
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-e-man-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to Man.
+ DRAWER holds the drawer information
+ CONTENTS holds the contents of the block.
+ INFO is a plist holding contextual information. "
+ contents)
+
+
+;;;; Dynamic Block
+
+(defun org-e-man-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-e-man--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-e-man-entity (entity contents info)
+ "Transcode an ENTITY object from Org to Man.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :utf8 entity))) ent))
+
+
+;;;; Example Block
+
+(defun org-e-man-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-e-man--wrap-label
+ example-block
+ (format ".RS\n.nf\n%s\n.fi\n.RE"
+ (org-export-format-code-default example-block info))))
+
+;;;; Export Block
+
+(defun org-e-man-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "MAN")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-e-man-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-man)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Fixed Width
+
+(defun org-e-man-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-man--wrap-label
+ fixed-width
+ (format "\\fC\n%s\\fP"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+
+;;;; Footnote Definition
+;; Footnote Definitions are ignored.
+
+;;;; Footnote References
+;; Footnote References are Ignored
+
+
+;;;; Headline
+
+(defun org-e-man-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to Man.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (case level
+ (1 ".SH \"%s\"\n%s")
+ (2 ".SS \"%s\"\n%s")
+ (3 ".SS \"%s\"\n%s")
+ (t nil)))
+ (text (org-export-data (org-element-property :title headline) info)))
+
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (let ((low-level-body
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "%s\n" ".RS"))
+ ;; Itemize headline
+ ".TP\n.ft I\n" text "\n.ft\n"
+ contents ".RE")))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'" ""
+ low-level-body))))
+
+ ;; Case 3. Standard headline. Export it as a section.
+ (t (format section-fmt text contents)))))
+
+
+;;;; Horizontal Rule
+;; Not supported
+
+
+;;;; Inline Babel Call
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-e-man-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block)))
+ (cond
+ (org-e-man-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory))
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+ (org-lang (org-element-property :language inline-src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-man-source-highlight-langs)))
+
+ (cmd (concat (expand-file-name "source-highlight")
+ " -s " lst-lang
+ " -f groff_man"
+ " -i " in-file
+ " -o " out-file)))
+
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
+ code))))
+
+ ;; Do not use a special package: transcode it verbatim.
+ (t
+ (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
+ "\\fP\n.fi\n.RE\n")))))
+
+
+;;;; Inlinetask
+;;;; Italic
+
+(defun org-e-man-italic (italic contents info)
+ "Transcode ITALIC from Org to Man.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "\\fI%s\\fP" contents))
+
+
+;;;; Item
+
+(defun org-e-man-item (item contents info)
+
+ "Transcode an ITEM element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+
+ (let* ((bullet (org-element-property :bullet item))
+ (type (org-element-property :type (org-element-property :parent item)))
+ (checkbox (case (org-element-property :checkbox item)
+ (on "\\o'\\(sq\\(mu'") ;;
+ (off "\\(sq ") ;;
+ (trans "\\o'\\(sq\\(mi'"))) ;;
+
+ (tag (let ((tag (org-element-property :tag item)))
+ ;; Check-boxes must belong to the tag.
+ (and tag (format "\\fB%s\\fP"
+ (concat checkbox
+ (org-export-data tag info)))))))
+
+ (if (and (null tag)
+ (null checkbox))
+ (let* ((bullet (org-trim bullet))
+ (marker (cond ((string= "-" bullet) "\\(em")
+ ((string= "*" bullet) "\\(bu")
+ ((eq type 'ordered)
+ (format "%s " (org-trim bullet)))
+ (t "\\(dg"))))
+ (concat ".IP " marker " 4\n"
+ (org-trim (or contents " "))))
+ ; else
+ (concat ".TP\n" (or tag (concat " " checkbox)) "\n"
+ (org-trim (or contents " "))))))
+
+
+;;;; Keyword
+
+(defun org-e-man-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "MAN") value)
+ ((string= key "INDEX") nil)
+ ;; Invisible targets.
+ ((string= key "TARGET") nil)
+ ((string= key "TOC") nil))))
+
+
+;;;; Man Environment
+
+(defun org-e-man-man-environment (man-environment contents info)
+ "Transcode a MAN-ENVIRONMENT element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((label (org-element-property :name man-environment))
+ (value (org-remove-indentation
+ (org-element-property :value man-environment))))
+ (if (not (org-string-nw-p label)) value
+ ;; Environment is labelled: label must be within the environment
+ ;; (otherwise, a reference pointing to that element will count
+ ;; the section instead).
+ (with-temp-buffer
+ (insert value)
+ (goto-char (point-min))
+ (forward-line)
+ (insert (format "%s\n" label))
+ (buffer-string)))))
+
+
+;;;; Man Fragment
+
+(defun org-e-man-man-fragment (man-fragment contents info)
+ "Transcode a MAN-FRAGMENT object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value man-fragment))
+
+
+;;;; Line Break
+
+(defun org-e-man-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ".br\n")
+
+
+;;;; Link
+
+(defun org-e-man-link (link desc info)
+ "Transcode a LINK object from Org to Man.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; External link with a description part.
+ ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
+ ;; External link without a description part.
+ (path (format "\\fI%s\\fP" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "\\fI%s\\fP" desc)))))
+
+
+;;;; Macro
+
+(defun org-e-man-macro (macro contents info)
+ "Transcode a MACRO element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+
+;;;; Paragraph
+
+(defun org-e-man-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to Man.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let ((parent (plist-get (nth 1 paragraph) :parent)))
+ (when parent
+ (let ((parent-type (car parent))
+ (fixed-paragraph ""))
+ (cond ((and (eq parent-type 'item)
+ (plist-get (nth 1 parent) :bullet))
+ (setq fixed-paragraph (concat "" contents)))
+ ((eq parent-type 'section)
+ (setq fixed-paragraph (concat ".PP\n" contents)))
+ ((eq parent-type 'footnote-definition)
+ (setq fixed-paragraph contents))
+ (t (setq fixed-paragraph (concat "" contents))))
+ fixed-paragraph))))
+
+
+;;;; Plain List
+
+(defun org-e-man-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to Man.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-e-man-plain-text (text info)
+ "Transcode a TEXT string from Org to Man.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect
+ (setq text (replace-regexp-in-string
+ "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
+ "$\\" text nil t 1))
+
+ ;; Handle quotation marks
+ (setq text (org-e-man--quotation-marks text info))
+
+ ;; Handle break preservation if required.
+
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n"
+ text)))
+ ;; Return value.
+ text)
+
+
+;;;; Planning
+
+;;;; Property Drawer
+
+
+;;;; Quote Block
+
+(defun org-e-man-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-man--wrap-label
+ quote-block
+ (format ".RS\n%s\n.RE" contents)))
+
+
+;;;; Quote Section
+
+(defun org-e-man-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format ".RS\\fI%s\\fP\n.RE\n" value))))
+
+
+;;;; Radio Target
+
+(defun org-e-man-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to Man.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ text)
+
+
+;;;; Section
+
+(defun org-e-man-section (section contents info)
+ "Transcode a SECTION element from Org to Man.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Special Block
+
+(defun org-e-man-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block))))
+ (org-e-man--wrap-label
+ special-block
+ (format "%s\n" contents))))
+
+
+;;;; Src Block
+
+(defun org-e-man-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (label (org-element-property :name src-block))
+ (code (org-element-property :value src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-e-man-custom-lang-environments))))
+ (num-start (case (org-element-property :number-lines src-block)
+ (continued (org-export-get-loc src-block info))
+ (new 0)))
+ (retain-labels (org-element-property :retain-labels src-block)))
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-e-man-source-highlight)
+ (let ((caption-str (org-e-man--caption/label-string caption label info)))
+ (concat
+ (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
+ (org-export-format-code-default src-block info)))))
+ ((and org-e-man-source-highlight)
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory))
+
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+
+ (org-lang (org-element-property :language src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-e-man-source-highlight-langs)))
+
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_man "
+ " -i " in-file
+ " -o " out-file)))
+
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE"
+ code)))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-e-man-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+
+;;;; Strike-Through
+
+(defun org-e-man-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Man.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "\\fI%s\\fP" contents))
+
+
+;;;; Subscript
+
+(defun org-e-man-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to Man.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\d\\s-2%s\\s+2\\u" contents))
+
+
+;;;; Superscript "^_%s$
+
+(defun org-e-man-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to Man.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\u\\s-2%s\\s+2\\d" contents))
+
+
+;;;; Table
+;;
+;; `org-e-man-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" attribute. Otherwise, it
+;; delegates the job to either `org-e-man-table--table.el-table' or
+;; `org-e-man-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-e-man-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-e-man-table (table contents info)
+ "Transcode a TABLE element from Org to Man.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (cond
+ ;; Case 1: verbatim table.
+ ((or org-e-man-tables-verbatim
+ (let ((attr
+ (read
+ (format
+ "(%s)"
+ (mapconcat
+ #'identity
+ (org-element-property :attr_man table)
+ " ")))))
+
+ (and attr (plist-get attr :verbatim))))
+
+ (format ".nf\n\\fC%s\\fP\n.fi"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+ ;; Case 2: Standard table.
+ (t (org-e-man-table--org-table table contents info))))
+
+(defun org-e-man-table--align-string (divider table info)
+ "Return an appropriate Man alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+(let (alignment)
+ ;; Extract column groups and alignment from first (non-rule)
+ ;; row.
+ (org-element-map
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row) 'standard) row))
+ info 'first-match)
+ 'table-cell
+ (lambda (cell)
+ (let* ((borders (org-export-table-cell-borders cell info))
+ (raw-width (org-export-table-cell-width cell info))
+ (width-cm (when raw-width (/ raw-width 5)))
+ (width (if raw-width (format "w(%dc)"
+ (if (< width-cm 1) 1 width-cm)) "")))
+ ;; Check left border for the first cell only.
+ (when (and (memq 'left borders) (not alignment))
+ (push "|" alignment))
+ (push
+ (case (org-export-table-cell-alignment cell info)
+ (left (concat "l" width divider))
+ (right (concat "r" width divider))
+ (center (concat "c" width divider)))
+ alignment)
+ (when (memq 'right borders) (push "|" alignment))))
+ info)
+ (apply 'concat (reverse alignment))))
+
+(defun org-e-man-table--org-table (table contents info)
+ "Return appropriate Man code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' attribute."
+ (let* ((label (org-element-property :name table))
+ (caption (org-e-man--caption/label-string
+ (org-element-property :caption table) label info))
+ (attr
+ (read
+ (format
+ "(%s)"
+ (mapconcat
+ #'identity
+ (org-element-property :attr_man table)
+ " "))))
+
+ (divider (if (plist-get attr :divider)
+ "|"
+ " "))
+
+ ;; Determine alignment string.
+ (alignment (org-e-man-table--align-string divider table info))
+ ;; Extract others display options.
+ (lines (org-split-string contents "\n"))
+
+ (attr-list
+ (let ((result-list '()))
+ (dolist (attr-item
+ (list
+ (if (plist-get attr :expand)
+ "expand"
+ nil)
+
+ (case (plist-get attr :placement)
+ ('center "center")
+ ('left nil)
+ (t
+ (if org-e-man-tables-centered
+ "center" "")))
+
+ (case (plist-get attr :boxtype)
+ ('box "box")
+ ('doublebox "doublebox")
+ ('allbox "allbox")
+ ('none nil)
+ (t "box"))))
+
+ (if attr-item
+ (add-to-list 'result-list attr-item)))
+ result-list))
+
+
+ (title-line (plist-get attr :title-line))
+
+ (table-format
+ (concat
+ (format "%s"
+ (or (car attr-list) ""))
+ (or
+ (let ((output-list '()))
+ (when (cdr attr-list)
+ (dolist (attr-item (cdr attr-list))
+ (setq output-list (concat output-list (format ",%s" attr-item)))))
+ output-list)
+ "")))
+
+ (first-line
+ (when lines (org-split-string (car lines) "\t"))))
+ ;; Prepare the final format string for the table.
+
+ (cond
+ ;; Others.
+ (lines (concat ".TS\n " table-format ";\n"
+
+ (format "%s.\n"
+ (let ((final-line ""))
+
+ (when title-line
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "cb" divider))))
+
+ (setq final-line (concat final-line "\n"))
+ (if alignment
+ (setq final-line (concat final-line alignment))
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "c" divider))))
+ final-line))
+
+ (format "%s.TE"
+ (let ((final-line ""))
+ (dolist (line-item lines)
+ (cond
+ (t
+ (setq lines (org-split-string contents "\n"))
+
+ (setq final-line (concat final-line
+ (car (org-split-string line-item "\\\\")) "\n")))))
+ final-line)))))))
+
+
+;;;; Table Cell
+
+(defun org-e-man-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to Man
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-e-man-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-e-man-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) " \t ")))
+
+
+;;;; Table Row
+
+(defun org-e-man-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to Man
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((attr (mapconcat 'identity
+ (org-element-property
+ :attr_man (org-export-get-parent table-row))
+ " "))
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (borders
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (concat
+ ;; Mark "hline" for horizontal lines.
+ (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
+ contents "\\\\\n"
+ (cond
+ ;; When BOOKTABS are activated enforce bottom rule even when
+ ;; no hline was specifically marked.
+ ((and (memq 'bottom borders) (memq 'below borders)) "_\n")
+ ((memq 'below borders) "_"))))))
+
+
+;;;; Target
+
+(defun org-e-man-target (target contents info)
+ "Transcode a TARGET object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\fI%s\\fP"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Timestamp
+
+(defun org-e-man-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to Man.
+ CONTENTS is nil. INFO is a plist holding contextual
+ information."
+ "")
+
+
+;;;; Underline
+
+(defun org-e-man-underline (underline contents info)
+ "Transcode UNDERLINE from Org to Man.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "\\fI%s\\fP" contents))
+
+
+;;;; Verbatim
+
+(defun org-e-man-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to Man.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format ".nf\n%s\n.fi" contents))
+
+
+;;;; Verse Block
+
+(defun org-e-man-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to Man.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (format ".RS\n.ft I\n%s\n.ft\n.RE" contents))
+
+
+
+;;; Interactive functions
+
+(defun org-e-man-export-to-man
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a Man file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only the body
+without any markers.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".man" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-man outfile subtreep visible-only body-only ext-plist)))
+
+(defun org-e-man-export-to-pdf
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to Groff then process through to PDF.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write between
+markers.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return PDF file's name."
+ (interactive)
+ (org-e-man-compile
+ (org-e-man-export-to-man
+ subtreep visible-only body-only ext-plist pub-dir)))
+
+(defun org-e-man-compile (grofffile)
+ "Compile a Groff file.
+
+GROFFFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-e-man-pdf-process'.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((wconfig (current-window-configuration))
+ (grofffile (file-truename grofffile))
+ (base (file-name-sans-extension grofffile))
+ errors)
+ (message (format "Processing Groff file %s ..." grofffile))
+ (unwind-protect
+ (progn
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-e-man-pdf-process)
+ (funcall org-e-man-pdf-process (shell-quote-argument grofffile)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org PDF Groff Output*" buffer.
+ ((consp org-e-man-pdf-process)
+ (let* ((out-dir (or (file-name-directory grofffile) "./"))
+ (outbuf (get-buffer-create "*Org PDF Groff Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument grofffile)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-e-man-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-e-man-collect-errors outbuf))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat base ".pdf")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p pdffile))
+ (error (concat (format "PDF file %s wasn't produced" pdffile)
+ (when errors (concat ": " errors))))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when org-e-man-remove-logfiles
+ (dolist (ext org-e-man-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))
+ (set-window-configuration wconfig))))
+
+(defun org-e-man-collect-errors (buffer)
+ "Collect some kind of errors from \"groff\" output
+BUFFER is the buffer containing output.
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ ;; Find final run
+ nil)))
+
+
+(provide 'org-e-man)
+;;; org-e-man.el ends here
diff --git a/contrib/lisp/org-e-odt.el b/contrib/lisp/org-e-odt.el
new file mode 100644
index 0000000..b2f7479
--- /dev/null
+++ b/contrib/lisp/org-e-odt.el
@@ -0,0 +1,3762 @@
+;;; org-e-odt.el --- OpenDocument Text exporter for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'table))
+(require 'format-spec)
+(require 'org-export)
+
+;;; Define Back-End
+
+(org-export-define-backend e-odt
+ ((bold . org-e-odt-bold)
+ (center-block . org-e-odt-center-block)
+ (clock . org-e-odt-clock)
+ (code . org-e-odt-code)
+ (drawer . org-e-odt-drawer)
+ (dynamic-block . org-e-odt-dynamic-block)
+ (entity . org-e-odt-entity)
+ (example-block . org-e-odt-example-block)
+ (export-block . org-e-odt-export-block)
+ (export-snippet . org-e-odt-export-snippet)
+ (fixed-width . org-e-odt-fixed-width)
+ (footnote-definition . org-e-odt-footnote-definition)
+ (footnote-reference . org-e-odt-footnote-reference)
+ (headline . org-e-odt-headline)
+ (horizontal-rule . org-e-odt-horizontal-rule)
+ (inline-src-block . org-e-odt-inline-src-block)
+ (inlinetask . org-e-odt-inlinetask)
+ (italic . org-e-odt-italic)
+ (item . org-e-odt-item)
+ (keyword . org-e-odt-keyword)
+ (latex-environment . org-e-odt-latex-environment)
+ (latex-fragment . org-e-odt-latex-fragment)
+ (line-break . org-e-odt-line-break)
+ (link . org-e-odt-link)
+ (macro . org-e-odt-macro)
+ (paragraph . org-e-odt-paragraph)
+ (plain-list . org-e-odt-plain-list)
+ (plain-text . org-e-odt-plain-text)
+ (planning . org-e-odt-planning)
+ (property-drawer . org-e-odt-property-drawer)
+ (quote-block . org-e-odt-quote-block)
+ (quote-section . org-e-odt-quote-section)
+ (radio-target . org-e-odt-radio-target)
+ (section . org-e-odt-section)
+ (special-block . org-e-odt-special-block)
+ (src-block . org-e-odt-src-block)
+ (statistics-cookie . org-e-odt-statistics-cookie)
+ (strike-through . org-e-odt-strike-through)
+ (subscript . org-e-odt-subscript)
+ (superscript . org-e-odt-superscript)
+ (table . org-e-odt-table)
+ (table-cell . org-e-odt-table-cell)
+ (table-row . org-e-odt-table-row)
+ (target . org-e-odt-target)
+ (template . org-e-odt-template)
+ (timestamp . org-e-odt-timestamp)
+ (underline . org-e-odt-underline)
+ (verbatim . org-e-odt-verbatim)
+ (verse-block . org-e-odt-verse-block))
+ :export-block "ODT"
+ :options-alist
+ ((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ (:LaTeX-fragments nil "LaTeX" org-export-with-LaTeX-fragments)))
+
+
+;;; Dependencies
+
+;;; Hooks
+
+;;; Function Declarations
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function hfy-face-to-style "htmlfontify" (fn))
+(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
+(declare-function archive-zip-extract "arc-mode.el" (archive name))
+(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file))
+(declare-function browse-url-file-url "browse-url" (file))
+
+
+
+
+;;; Internal Variables
+
+(defconst org-e-odt-lib-dir
+ (file-name-directory load-file-name)
+ "Location of ODT exporter.
+Use this to infer values of `org-e-odt-styles-dir' and
+`org-e-odt-schema-dir'.")
+
+(defvar org-e-odt-data-dir
+ (expand-file-name "../../etc/" org-e-odt-lib-dir)
+ "Data directory for ODT exporter.
+Use this to infer values of `org-e-odt-styles-dir' and
+`org-e-odt-schema-dir'.")
+
+(defconst org-e-odt-special-string-regexps
+ '(("\\\\-" . "&#x00ad;\\1") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-e-odt-schema-dir-list
+ (list
+ (and org-e-odt-data-dir
+ (expand-file-name "./schema/" org-e-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-e-odt-data-dir) org-e-odt-data-dir ; see make install
+ (expand-file-name "./schema/" org-e-odt-data-dir))))
+ "List of directories to search for OpenDocument schema files.
+Use this list to set the default value of
+`org-e-odt-schema-dir'. The entries in this list are
+populated heuristically based on the values of `org-e-odt-lib-dir'
+and `org-e-odt-data-dir'.")
+
+(defconst org-e-odt-styles-dir-list
+ (list
+ (and org-e-odt-data-dir
+ (expand-file-name "./styles/" org-e-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-e-odt-data-dir) org-e-odt-data-dir ; see make install
+ (expand-file-name "./styles/" org-e-odt-data-dir)))
+ (expand-file-name "../../etc/styles/" org-e-odt-lib-dir) ; git
+ (expand-file-name "./etc/styles/" org-e-odt-lib-dir) ; elpa
+ (expand-file-name "./org/" data-directory) ; system
+ )
+ "List of directories to search for OpenDocument styles files.
+See `org-e-odt-styles-dir'. The entries in this list are populated
+heuristically based on the values of `org-e-odt-lib-dir' and
+`org-e-odt-data-dir'.")
+
+(defconst org-e-odt-styles-dir
+ (let* ((styles-dir
+ (catch 'styles-dir
+ (message "Debug (org-e-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (org-e-odt): Trying %s..." styles-dir)
+ (when (and (file-readable-p
+ (expand-file-name
+ "OrgOdtContentTemplate.xml" styles-dir))
+ (file-readable-p
+ (expand-file-name
+ "OrgOdtStyles.xml" styles-dir)))
+ (message "Debug (org-e-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-e-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (org-e-odt): Cannot find factory styles files, aborting"))
+ styles-dir)
+ "Directory that holds auxiliary XML files used by the ODT exporter.
+
+This directory contains the following XML files -
+ \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
+ XML files are used as the default values of
+ `org-e-odt-styles-file' and
+ `org-e-odt-content-template-file'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-e-odt-styles-dir-list'. Note that the user could be using org
+from one of: org's own private git repository, GNU ELPA tar or
+standard Emacs.")
+
+(defconst org-e-odt-bookmark-prefix "OrgXref.")
+
+(defconst org-e-odt-manifest-file-entry-tag
+ "\n<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
+
+(defconst org-e-odt-file-extensions
+ '(("odt" . "OpenDocument Text")
+ ("ott" . "OpenDocument Text Template")
+ ("odm" . "OpenDocument Master Document")
+ ("ods" . "OpenDocument Spreadsheet")
+ ("ots" . "OpenDocument Spreadsheet Template")
+ ("odg" . "OpenDocument Drawing (Graphics)")
+ ("otg" . "OpenDocument Drawing Template")
+ ("odp" . "OpenDocument Presentation")
+ ("otp" . "OpenDocument Presentation Template")
+ ("odi" . "OpenDocument Image")
+ ("odf" . "OpenDocument Formula")
+ ("odc" . "OpenDocument Chart")))
+
+(defvar org-e-odt-table-style-format
+ "
+<style:style style:name=\"%s\" style:family=\"table\">
+ <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
+</style:style>
+"
+ "Template for auto-generated Table styles.")
+
+(defvar org-e-odt-automatic-styles '()
+ "Registry of automatic styles for various OBJECT-TYPEs.
+The variable has the following form:
+\(\(OBJECT-TYPE-A
+ \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\)
+ \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\)
+ \(OBJECT-TYPE-B
+ \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\)
+ \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\)
+ ...\).
+
+OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option to `org-e-odt-parse-block-attributes'.
+
+Use `org-e-odt-add-automatic-style' to add update this variable.'")
+
+(defvar org-e-odt-object-counters nil
+ "Running counters for various OBJECT-TYPEs.
+Use this to generate automatic names and style-names. See
+`org-e-odt-add-automatic-style'.")
+
+(defvar org-e-odt-src-block-paragraph-format
+ "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
+ <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
+ <style:background-image/>
+ </style:paragraph-properties>
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>"
+ "Custom paragraph style for colorized source and example blocks.
+This style is much the same as that of \"OrgFixedWidthBlock\"
+except that the foreground and background colors are set
+according to the default face identified by the `htmlfontify'.")
+
+(defvar hfy-optimisations)
+(defvar org-e-odt-embedded-formulas-count 0)
+(defvar org-e-odt-entity-frame-styles
+ '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
+ ("CaptionedAs-CharImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgInlineImage" nil "as-char"))
+ ("CaptionedParagraphImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgPageImageCaptionFrame" nil "page"))
+ ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
+ ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
+ ("CaptionedDisplayFormula" "__MathFormula__"
+ ("OrgCaptionedFormula" nil "paragraph")
+ ("OrgFormulaCaptionFrame" nil "as-char"))))
+
+(defvar org-e-odt-embedded-images-count 0)
+(defvar org-e-odt-image-size-probe-method
+ (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
+ '(emacs fixed))
+ "Ordered list of methods for determining image sizes.")
+
+(defvar org-e-odt-default-image-sizes-alist
+ '(("as-char" . (5 . 0.4))
+ ("paragraph" . (5 . 5)))
+ "Hardcoded image dimensions one for each of the anchor
+ methods.")
+
+;; A4 page size is 21.0 by 29.7 cms
+;; The default page settings has 2cm margin on each of the sides. So
+;; the effective text area is 17.0 by 25.7 cm
+(defvar org-e-odt-max-image-size '(17.0 . 20.0)
+ "Limiting dimensions for an embedded image.")
+
+(defvar org-e-odt-label-styles
+ '(("math-formula" "%c" "text" "(%n)")
+ ("math-label" "(%n)" "text" "(%n)")
+ ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
+ ("value" "%e %n: %c" "value" "%n"))
+ "Specify how labels are applied and referenced.
+This is an alist where each element is of the
+form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
+LABEL-REF-FMT).
+
+LABEL-ATTACH-FMT controls how labels and captions are attached to
+an entity. It may contain following specifiers - %e, %n and %c.
+%e is replaced with the CATEGORY-NAME. %n is replaced with
+\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
+with CAPTION. See `org-e-odt-format-label-definition'.
+
+LABEL-REF-MODE and LABEL-REF-FMT controls how label references
+are generated. The following XML is generated for a label
+reference - \"<text:sequence-ref
+text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
+</text:sequence-ref>\". LABEL-REF-FMT may contain following
+specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
+%n is replaced with SEQNO. See
+`org-e-odt-format-label-reference'.")
+
+(defvar org-e-odt-category-map-alist
+ '(("__Table__" "Table" "value" "Table")
+ ("__Figure__" "Illustration" "value" "Figure")
+ ("__MathFormula__" "Text" "math-formula" "Equation")
+ ("__DvipngImage__" "Equation" "value" "Equation")
+ ("__Listing__" "Listing" "value" "Listing")
+ ;; ("__Table__" "Table" "category-and-value")
+ ;; ("__Figure__" "Figure" "category-and-value")
+ ;; ("__DvipngImage__" "Equation" "category-and-value")
+ )
+ "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
+This is a list where each entry is of the form \\(CATEGORY-HANDLE
+OD-VARIABLE LABEL-STYLE CATEGORY-NAME\\). CATEGORY_HANDLE
+identifies the captionable entity in question. OD-VARIABLE is
+the OpenDocument sequence counter associated with the entity.
+These counters are declared within
+\"<text:sequence-decls>...</text:sequence-decls>\" block of
+`org-e-odt-content-template-file'. LABEL-STYLE is a key into
+`org-e-odt-label-styles' and specifies how a given entity should
+be captioned and referenced. CATEGORY-NAME is used for
+qualifying captions on export. You can modify the CATEGORY-NAME
+used in the exported document by modifying
+`org-export-dictionary'. For example, an embedded image in an
+English document is captioned as \"Figure 1: Orgmode Logo\", by
+default. If you want the image to be captioned as \"Illustration
+1: Orgmode Logo\" instead, install an entry in
+`org-export-dictionary' which translates \"Figure\" to
+\"Illustration\" when the language is \"en\" and encoding is
+`:utf-8'.")
+
+(defvar org-e-odt-manifest-file-entries nil)
+(defvar hfy-user-sheet-assoc)
+
+(defvar org-e-odt-zip-dir nil
+ "Temporary work directory for OpenDocument exporter.")
+
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-e-odt nil
+ "Options for exporting Org mode files to ODT."
+ :tag "Org Export ODT"
+ :group 'org-export)
+
+
+;;;; Debugging
+
+(defcustom org-e-odt-prettify-xml nil
+ "Specify whether or not the xml output should be prettified.
+When this option is turned on, `indent-region' is run on all
+component xml buffers before they are saved. Turn this off for
+regular use. Turn this on if you need to examine the xml
+visually."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type 'boolean)
+
+
+;;;; Document schema
+
+(defcustom org-e-odt-schema-dir
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (org-e-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (org-e-odt): Trying %s..." schema-dir)
+ (when (and (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (org-e-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-e-odt-schema-dir-list)
+ (message "Debug (org-e-odt): No OpenDocument schema files installed")
+ nil)))
+ schema-dir)
+ "Directory that contains OpenDocument schema files.
+
+This directory contains:
+1. rnc files for OpenDocument schema
+2. a \"schemas.xml\" file that specifies locating rules needed
+ for auto validation of OpenDocument XML files.
+
+Use the customize interface to set this variable. This ensures
+that `rng-schema-locating-files' is updated and auto-validation
+of OpenDocument XML takes place based on the value
+`rng-nxml-auto-validate-flag'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-e-odt-schema-dir-list'. The OASIS schema files are available
+only in the org's private git repository. It is *not* bundled
+with GNU ELPA tar or standard Emacs distribution."
+ :type '(choice
+ (const :tag "Not set" nil)
+ (directory :tag "Schema directory"))
+ :group 'org-export-e-odt
+ :version "24.1"
+ :set
+ (lambda (var value)
+ "Set `org-e-odt-schema-dir'.
+Also add it to `rng-schema-locating-files'."
+ (let ((schema-dir value))
+ (set var
+ (if (and
+ (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ schema-dir
+ (when value
+ (message "Error (org-e-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
+ (when org-e-odt-schema-dir
+ (eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "schemas.xml"
+ org-e-odt-schema-dir))))))
+
+
+;;;; Document styles
+
+(defcustom org-e-odt-content-template-file nil
+ "Template file for \"content.xml\".
+The exporter embeds the exported content just before
+\"</office:text>\" element.
+
+If unspecified, the file named \"OrgOdtContentTemplate.xml\"
+under `org-e-odt-styles-dir' is used."
+ :type 'file
+ :group 'org-export-e-odt
+ :version "24.1")
+
+(defcustom org-e-odt-styles-file nil
+ "Default styles file for use with ODT export.
+Valid values are one of:
+1. nil
+2. path to a styles.xml file
+3. path to a *.odt or a *.ott file
+4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
+...))
+
+In case of option 1, an in-built styles.xml is used. See
+`org-e-odt-styles-dir' for more information.
+
+In case of option 3, the specified file is unzipped and the
+styles.xml embedded therein is used.
+
+In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
+and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
+generated odt file. Use relative path for specifying the
+FILE-MEMBERS. styles.xml must be specified as one of the
+FILE-MEMBERS.
+
+Use options 1, 2 or 3 only if styles.xml alone suffices for
+achieving the desired formatting. Use option 4, if the styles.xml
+references additional files like header and footer images for
+achieving the desired formatting.
+
+Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
+a per-file basis. For example,
+
+#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
+#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "Factory settings" nil)
+ (file :must-match t :tag "styles.xml")
+ (file :must-match t :tag "ODT or OTT file")
+ (list :tag "ODT or OTT file + Members"
+ (file :must-match t :tag "ODF Text or Text Template file")
+ (cons :tag "Members"
+ (file :tag " Member" "styles.xml")
+ (repeat (file :tag "Member"))))))
+
+(defcustom org-e-odt-display-outline-level 2
+ "Outline levels considered for enumerating captioned entities."
+ :group 'org-export-e-odt
+ :version "24.2"
+ :type 'integer)
+
+;;;; Document conversion
+
+(defcustom org-e-odt-convert-processes
+ '(("LibreOffice"
+ "soffice --headless --convert-to %f%x --outdir %d %i")
+ ("unoconv"
+ "unoconv -f %f -o %d %i"))
+ "Specify a list of document converters and their usage.
+The converters in this list are offered as choices while
+customizing `org-e-odt-convert-process'.
+
+This variable is a list where each element is of the
+form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
+of the converter. CONVERTER-CMD is the shell command for the
+converter and can contain format specifiers. These format
+specifiers are interpreted as below:
+
+%i input file name in full
+%I input file name as a URL
+%f format of the output file
+%o output file name in full
+%O output file name as a URL
+%d output dir in full
+%D output dir as a URL.
+%x extra options as set in `org-e-odt-convert-capabilities'."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Converters"
+ :key-type (string :tag "Converter Name")
+ :value-type (group (string :tag "Command line")))))
+
+(defcustom org-e-odt-convert-process "LibreOffice"
+ "Use this converter to convert from \"odt\" format to other formats.
+During customization, the list of converter names are populated
+from `org-e-odt-convert-processes'."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,(car c) ,(car c)))
+ org-e-odt-convert-processes))))
+
+(defcustom org-e-odt-convert-capabilities
+ '(("Text"
+ ("odt" "ott" "doc" "rtf" "docx")
+ (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
+ ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
+ ("Web"
+ ("html")
+ (("pdf" "pdf") ("odt" "odt") ("html" "html")))
+ ("Spreadsheet"
+ ("ods" "ots" "xls" "csv" "xlsx")
+ (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
+ ("xls" "xls") ("xlsx" "xlsx")))
+ ("Presentation"
+ ("odp" "otp" "ppt" "pptx")
+ (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
+ ("pptx" "pptx") ("odg" "odg"))))
+ "Specify input and output formats of `org-e-odt-convert-process'.
+More correctly, specify the set of input and output formats that
+the user is actually interested in.
+
+This variable is an alist where each element is of the
+form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
+INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
+alist where each element is of the form (OUTPUT-FMT
+OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
+
+The variable is interpreted as follows:
+`org-e-odt-convert-process' can take any document that is in
+INPUT-FMT-LIST and produce any document that is in the
+OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
+OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
+serves dual purposes:
+- It is used for populating completion candidates during
+ `org-e-odt-convert' commands.
+- It is used as the value of \"%f\" specifier in
+ `org-e-odt-convert-process'.
+
+EXTRA-OPTIONS is used as the value of \"%x\" specifier in
+`org-e-odt-convert-process'.
+
+DOCUMENT-CLASS is used to group a set of file formats in
+INPUT-FMT-LIST in to a single class.
+
+Note that this variable inherently captures how LibreOffice based
+converters work. LibreOffice maps documents of various formats
+to classes like Text, Web, Spreadsheet, Presentation etc and
+allow document of a given class (irrespective of it's source
+format) to be converted to any of the export formats associated
+with that class.
+
+See default setting of this variable for an typical
+configuration."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Capabilities"
+ :key-type (string :tag "Document Class")
+ :value-type
+ (group (repeat :tag "Input formats" (string :tag "Input format"))
+ (alist :tag "Output formats"
+ :key-type (string :tag "Output format")
+ :value-type
+ (group (string :tag "Output file extension")
+ (choice
+ (const :tag "None" nil)
+ (string :tag "Extra options"))))))))
+
+(defcustom org-e-odt-preferred-output-format nil
+ "Automatically post-process to this format after exporting to \"odt\".
+Interactive commands `org-export-as-e-odt' and
+`org-export-as-e-odt-and-open' export first to \"odt\" format and
+then use `org-e-odt-convert-process' to convert the
+resulting document to this format. During customization of this
+variable, the list of valid values are populated based on
+`org-e-odt-convert-capabilities'."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,c ,c))
+ (org-e-odt-reachable-formats "odt")))))
+
+
+;;;; Drawers
+
+(defcustom org-e-odt-format-drawer-function nil
+ "Function called to format a drawer in HTML code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-odt-format-drawer-default \(name contents\)
+ \"Format a drawer element for HTML export.\"
+ contents\)"
+ :group 'org-export-e-odt
+ :type 'function)
+
+
+;;;; Headline
+
+(defcustom org-e-odt-format-headline-function nil
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword \(string or nil\).
+TODO-TYPE the type of todo \(symbol: `todo', `done', nil\)
+PRIORITY the priority of the headline \(integer or nil\)
+TEXT the main headline text \(string\).
+TAGS the tags string, separated with colons \(string or nil\).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-e-odt-format-headline \(todo todo-type priority text tags\)
+ \"Default format function for an headline.\"
+ \(concat \(when todo
+ \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\)
+ \(when priority
+ \(format \"\\\\framebox{\\\\#%c} \" priority\)\)
+ text
+ \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)"
+ :group 'org-export-e-odt
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-e-odt-format-inlinetask-function nil
+ "Function called to format an inlinetask in HTML code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a string.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-odt-format-inlinetask \(todo type priority name tags contents\)
+\"Format an inline task element for HTML export.\"
+ \(let \(\(full-title
+ \(concat
+ \(when todo
+ \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\)
+ \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\)
+ title
+ \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\)
+ \(format \(concat \"\\\\begin{center}\\n\"
+ \"\\\\fbox{\\n\"
+ \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
+ \"%s\\n\\n\"
+ \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
+ \"%s\"
+ \"\\\\end{minipage}}\"
+ \"\\\\end{center}\"\)
+ full-title contents\)\)"
+ :group 'org-export-e-odt
+ :type 'function)
+
+
+;;;; Links
+
+(defcustom org-e-odt-inline-image-rules
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'"))
+ "Rules characterizing image files that can be inlined into HTML.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path.
+
+Note that, by default, the image extension *actually* allowed
+depend on the way the HTML file is processed. When used with
+pdflatex, pdf, jpg and png images are OK. When processing
+through dvi to Postscript, only ps and eps are allowed. The
+default we use here encompasses both."
+ :group 'org-export-e-odt
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-e-odt-pixels-per-inch display-pixels-per-inch
+ "Scaling factor for converting images pixels to inches.
+Use this for sizing of embedded images. See Info node `(org)
+Images in ODT export' for more information."
+ :type 'float
+ :group 'org-export-e-odt
+ :version "24.1")
+
+
+;;;; Plain text
+
+(defcustom org-e-odt-quotes
+ '(("fr"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "« ")
+ ("\\(\\S-\\)\"" . "» ")
+ ("\\(\\s-\\|(\\|^\\)'" . "'"))
+ ("en"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "“")
+ ("\\(\\S-\\)\"" . "”")
+ ("\\(\\s-\\|(\\|^\\)'" . "‘")
+ ("\\(\\S-\\)'" . "’")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-odt
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+
+;;;; Src Block
+
+(defcustom org-e-odt-create-custom-styles-for-srcblocks t
+ "Whether custom styles for colorized source blocks be automatically created.
+When this option is turned on, the exporter creates custom styles
+for source blocks based on the advice of `htmlfontify'. Creation
+of custom styles happen as part of `org-e-odt-hfy-face-to-css'.
+
+When this option is turned off exporter does not create such
+styles.
+
+Use the latter option if you do not want the custom styles to be
+based on your current display settings. It is necessary that the
+styles.xml already contains needed styles for colorizing to work.
+
+This variable is effective only if
+`org-e-odt-fontify-srcblocks' is turned on."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-e-odt-fontify-srcblocks t
+ "Specify whether or not source blocks need to be fontified.
+Turn this option on if you want to colorize the source code
+blocks in the exported file. For colorization to work, you need
+to make available an enhanced version of `htmlfontify' library."
+ :type 'boolean
+ :group 'org-export-e-odt
+ :version "24.1")
+
+
+;;;; Table
+
+(defcustom org-e-odt-table-caption-above t
+ "When non-nil, place caption string at the beginning of the table.
+Otherwise, place it near the end."
+ :group 'org-export-e-odt
+ :type 'boolean)
+
+(defcustom org-e-odt-table-styles
+ '(("OrgEquation" "OrgEquation"
+ ((use-first-column-styles . t)
+ (use-last-column-styles . t))))
+ "Specify how Table Styles should be derived from a Table Template.
+This is a list where each element is of the
+form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
+
+TABLE-STYLE-NAME is the style associated with the table through
+\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line.
+
+TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
+TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
+below) that is included in
+`org-e-odt-content-template-file'.
+
+TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableCell\"
+PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableParagraph\"
+TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
+ \"FirstRow\" | \"LastRow\" |
+ \"EvenRow\" | \"OddRow\" |
+ \"EvenColumn\" | \"OddColumn\" | \"\"
+where \"+\" above denotes string concatenation.
+
+TABLE-CELL-OPTIONS is an alist where each element is of the
+form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
+TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
+ `use-last-row-styles' |
+ `use-first-column-styles' |
+ `use-last-column-styles' |
+ `use-banding-rows-styles' |
+ `use-banding-columns-styles' |
+ `use-first-row-styles'
+ON-OR-OFF := `t' | `nil'
+
+For example, with the following configuration
+
+\(setq org-e-odt-table-styles
+ '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\"
+ \(\(use-first-row-styles . t\)
+ \(use-first-column-styles . t\)\)\)
+ \(\"TableWithHeaderColumns\" \"Custom\"
+ \(\(use-first-column-styles . t\)\)\)\)\)
+
+1. A table associated with \"TableWithHeaderRowsAndColumns\"
+ style will use the following table-cell styles -
+ \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
+ \"CustomTableCell\" and the following paragraph styles
+ \"CustomFirstRowTableParagraph\",
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate.
+
+2. A table associated with \"TableWithHeaderColumns\" style will
+ use the following table-cell styles -
+ \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
+ following paragraph styles
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate..
+
+Note that TABLE-TEMPLATE-NAME corresponds to the
+\"<table:table-template>\" elements contained within
+\"<office:styles>\". The entries (TABLE-STYLE-NAME
+TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
+\"table:template-name\" and \"table:use-first-row-styles\" etc
+attributes of \"<table:table>\" element. Refer ODF-1.2
+specification for more information. Also consult the
+implementation filed under `org-e-odt-get-table-cell-styles'.
+
+The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
+formatting of numbered display equations. Do not delete this
+style from the list."
+ :group 'org-export-e-odt
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (repeat :tag "Table Styles"
+ (list :tag "Table Style Specification"
+ (string :tag "Table Style Name")
+ (string :tag "Table Template Name")
+ (alist :options (use-first-row-styles
+ use-last-row-styles
+ use-first-column-styles
+ use-last-column-styles
+ use-banding-rows-styles
+ use-banding-columns-styles)
+ :key-type symbol
+ :value-type (const :tag "True" t))))))
+
+
+
+;;; Internal functions
+
+;;;; Date
+
+(defun org-e-odt--date (&optional org-ts fmt)
+ (save-match-data
+ (let* ((time
+ (and (stringp org-ts)
+ (string-match org-ts-regexp0 org-ts)
+ (apply 'encode-time
+ (org-fix-decoded-time
+ (org-parse-time-string (match-string 0 org-ts) t)))))
+ date)
+ (cond
+ (fmt (format-time-string fmt time))
+ (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time))
+ (format "%s:%s" (substring date 0 -2) (substring date -2)))))))
+
+;;;; Frame
+
+(defun org-e-odt--frame (text width height style &optional extra
+ anchor-type)
+ (let ((frame-attrs
+ (concat
+ (if width (format " svg:width=\"%0.2fcm\"" width) "")
+ (if height (format " svg:height=\"%0.2fcm\"" height) "")
+ extra
+ (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")))))
+ (format
+ "\n<draw:frame draw:style-name=\"%s\"%s>\n%s\n</draw:frame>"
+ style frame-attrs
+ (concat text
+ (let ((title (get-text-property 0 :title text))
+ (desc (get-text-property 0 :description text)))
+ (concat (and title
+ (format "<svg:title>%s</svg:title>"
+ (org-e-odt-encode-plain-text title t)))
+ (and desc
+ (format "<svg:desc>%s</svg:desc>"
+ (org-e-odt-encode-plain-text desc t)))))))))
+
+;;;; Library wrappers
+
+(defun org-e-odt--adopt-elements (parent &rest children)
+ (prog1 parent
+ (mapc (lambda (child)
+ (let ((parent-1 (org-element-adopt-element parent child nil)))
+ (assert (eq parent-1 parent))))
+ children)))
+
+(defun org-e-odt--zip-extract (archive members target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (archive member target)
+ (require 'arc-mode)
+ (let* ((--quote-file-name
+ ;; This is shamelessly stolen from `archive-zip-extract'.
+ (lambda (name)
+ (if (or (not (memq system-type '(windows-nt ms-dos)))
+ (and (boundp 'w32-quote-process-args)
+ (null w32-quote-process-args)))
+ (shell-quote-argument name)
+ name)))
+ (target (funcall --quote-file-name target))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed"))))
+ members))
+
+;;;; Textbox
+
+(defun org-e-odt--textbox (text width height style &optional
+ extra anchor-type)
+ (org-e-odt--frame
+ (format "\n<draw:text-box %s>%s\n</draw:text-box>"
+ (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
+ (and (not width)
+ (format " fo:min-width=\"%0.2fcm\"" (or width .2))))
+ text)
+ width nil style extra anchor-type))
+
+
+
+;;;; Table of Contents
+
+(defun org-e-odt-begin-toc (index-title depth)
+ (concat
+ (format "
+ <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\">
+ <text:table-of-content-source text:outline-level=\"%d\">
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+" depth index-title)
+
+ (let ((levels (number-sequence 1 10)))
+ (mapconcat
+ (lambda (level)
+ (format
+ "
+ <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
+ <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
+ <text:index-entry-chapter/>
+ <text:index-entry-text/>
+ <text:index-entry-link-end/>
+ </text:table-of-content-entry-template>
+" level level)) levels ""))
+
+ (format "
+ </text:table-of-content-source>
+
+ <text:index-body>
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>
+ " index-title)))
+
+(defun org-e-odt-end-toc ()
+ (format "
+ </text:index-body>
+ </text:table-of-content>
+"))
+
+
+
+(defun* org-e-odt-format-toc-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (setq text (concat
+ (and org-export-with-section-numbers
+ (concat section-number ". "))
+ text
+ (and tags
+ (concat
+ "<text:tab/>"
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tags)))))
+ (when todo
+ (setq text (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTodo" text)))
+ (org-e-odt-format-link text (concat "#" headline-label) t))
+
+(defun org-e-odt-toc (depth info)
+ (assert (wholenump depth))
+ (let* ((title (org-export-translate "Table of Contents" :utf-8 info))
+ (headlines (org-export-collect-headlines info depth)))
+
+ (when headlines
+ (concat
+ (org-e-odt-begin-toc title depth)
+
+ (mapconcat
+ (lambda (headline)
+ (let* ((entry (org-e-odt-format-headline--wrap
+ headline info 'org-e-odt-format-toc-headline))
+ (level (org-export-get-relative-level headline info))
+ (style (format "Contents_20_%d" level)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ style entry)))
+ headlines "\n")
+
+ (org-e-odt-end-toc)))))
+
+
+;;;; Document styles
+
+(defun org-e-odt-add-automatic-style (object-type &optional object-props)
+ "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option of the object in question to
+`org-e-odt-parse-block-attributes'.
+
+Use `org-e-odt-object-counters' to generate an automatic
+OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
+new entry in `org-e-odt-automatic-styles'. Return (OBJECT-NAME
+. STYLE-NAME)."
+ (assert (stringp object-type))
+ (let* ((object (intern object-type))
+ (seqvar object)
+ (seqno (1+ (or (plist-get org-e-odt-object-counters seqvar) 0)))
+ (object-name (format "%s%d" object-type seqno)) style-name)
+ (setq org-e-odt-object-counters
+ (plist-put org-e-odt-object-counters seqvar seqno))
+ (when object-props
+ (setq style-name (format "Org%s" object-name))
+ (setq org-e-odt-automatic-styles
+ (plist-put org-e-odt-automatic-styles object
+ (append (list (list style-name object-props))
+ (plist-get org-e-odt-automatic-styles object)))))
+ (cons object-name style-name)))
+
+
+;;;; Caption and Labels
+
+
+(defun org-e-odt--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-e-odt--caption/label-string'."
+ ;; (let ((label (org-element-property :name element)))
+ ;; (if (or (not output) (not label) (string= output "") (string= label ""))
+ ;; output
+ ;; (concat (format "\\label{%s}\n" label) output)))
+ output)
+
+
+(defun org-e-odt--caption/label-string (caption label info)
+ "Return caption and label HTML string for floats.
+
+CAPTION is a cons cell of secondary strings, the car being the
+standard caption and the cdr its short form. LABEL is a string
+representing the label. INFO is a plist holding contextual
+information.
+
+If there's no caption nor label, return the empty string.
+
+For non-floats, see `org-e-odt--wrap-label'."
+ (setq label nil) ;; FIXME
+
+ (let ((label-str (if label (format "\\label{%s}" label) "")))
+ (cond
+ ((and (not caption) (not label)) "")
+ ((not caption) (format "\\label{%s}\n" label))
+ ;; Option caption format with short name.
+ ((cdr caption)
+ (format "\\caption[%s]{%s%s}\n"
+ (org-export-data (cdr caption) info)
+ label-str
+ (org-export-data (car caption) info)))
+ ;; Standard caption format.
+ ;; (t (format "\\caption{%s%s}\n"
+ ;; label-str
+ ;; (org-export-data (car caption) info)))
+ (t (org-export-data (car caption) info)))))
+
+;;;; Checkbox
+
+(defun org-e-odt--checkbox (item)
+ "Return check-box string associated to ITEM."
+ (let ((checkbox (org-element-property :checkbox item)))
+ (if (not checkbox) ""
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (case checkbox
+ (on "[&#x2713;] ") ; CHECK MARK
+ (off "[ ] ")
+ (trans "[-] "))))))
+
+
+
+;;; Template
+
+(defun org-e-odt-template (contents info)
+ "Return complete document string after HTML conversion.
+CONTENTS is the transcoded contents string. RAW-DATA is the
+original parsed data. INFO is a plist holding export options."
+ ;; Write meta file.
+ (let ((title (org-export-data (plist-get info :title) info))
+ (author (let ((author (plist-get info :author)))
+ (if (not author) "" (org-export-data author info))))
+ (date (org-e-odt--date
+ (org-export-data (plist-get info :date) info)))
+ (email (plist-get info :email))
+ (keywords (plist-get info :keywords))
+ (description (plist-get info :description)))
+ (write-region
+ (concat
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <office:document-meta
+ xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
+ xmlns:xlink=\"http://www.w3.org/1999/xlink\"
+ xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
+ xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
+ xmlns:ooo=\"http://openoffice.org/2004/office\"
+ office:version=\"1.2\">
+ <office:meta>\n"
+ (format "<dc:creator>%s</dc:creator>\n" author)
+ (format "<meta:initial-creator>%s</meta:initial-creator>\n" author)
+ (format "<dc:date>%s</dc:date>\n" date)
+ (format "<meta:creation-date>%s</meta:creation-date>\n" date)
+ (format "<meta:generator>%s</meta:generator>\n"
+ (let ((creator-info (plist-get info :with-creator)))
+ (if (or (not creator-info) (eq creator-info 'comment)) ""
+ (plist-get info :creator))))
+ (format "<meta:keyword>%s</meta:keyword>\n" keywords)
+ (format "<dc:subject>%s</dc:subject>\n" description)
+ (format "<dc:title>%s</dc:title>\n" title)
+ "\n"
+ " </office:meta>\n" "</office:document-meta>")
+ nil (concat org-e-odt-zip-dir "meta.xml"))
+ ;; Add meta.xml in to manifest.
+ (org-e-odt-create-manifest-file-entry "text/xml" "meta.xml"))
+
+ ;; Update styles file.
+ ;; Copy styles.xml. Also dump htmlfontify styles, if there is any.
+ ;; Write styles file.
+ (let* ((styles-file (plist-get info :odt-styles-file))
+ (styles-file (and styles-file (read (org-trim styles-file))))
+ ;; Non-availability of styles.xml is not a critical
+ ;; error. For now throw an error purely for aesthetic
+ ;; reasons.
+ (styles-file (or styles-file
+ org-e-odt-styles-file
+ (expand-file-name "OrgOdtStyles.xml"
+ org-e-odt-styles-dir)
+ (error "org-e-odt: Missing styles file?"))))
+ (cond
+ ((listp styles-file)
+ (let ((archive (nth 0 styles-file))
+ (members (nth 1 styles-file)))
+ (org-e-odt--zip-extract archive members org-e-odt-zip-dir)
+ (mapc
+ (lambda (member)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-e-odt-create-manifest-file-entry media-type member))))
+ members)))
+ ((and (stringp styles-file) (file-exists-p styles-file))
+ (let ((styles-file-type (file-name-extension styles-file)))
+ (cond
+ ((string= styles-file-type "xml")
+ (copy-file styles-file (concat org-e-odt-zip-dir "styles.xml") t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-e-odt--zip-extract styles-file "styles.xml" org-e-odt-zip-dir)))))
+ (t
+ (error (format "Invalid specification of styles.xml file: %S"
+ org-e-odt-styles-file))))
+
+ ;; create a manifest entry for styles.xml
+ (org-e-odt-create-manifest-file-entry "text/xml" "styles.xml")
+
+ ;; FIXME: Who is opening an empty styles.xml before this point?
+ (with-current-buffer
+ (find-file-noselect (concat org-e-odt-zip-dir "styles.xml") t)
+ (revert-buffer t t)
+
+ ;; Write custom styles for source blocks
+ ;; Save STYLES used for colorizing of source blocks.
+ ;; Update styles.xml with styles that were collected as part of
+ ;; `org-e-odt-hfy-face-to-css' callbacks.
+ (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style)))
+ hfy-user-sheet-assoc "")))
+ (when styles
+ (goto-char (point-min))
+ (when (re-search-forward "</office:styles>" nil t)
+ (goto-char (match-beginning 0))
+ (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n"))))
+
+ ;; Update styles.xml - take care of outline numbering
+
+ ;; Don't make automatic backup of styles.xml file. This setting
+ ;; prevents the backed-up styles.xml file from being zipped in to
+ ;; odt file. This is more of a hackish fix. Better alternative
+ ;; would be to fix the zip command so that the output odt file
+ ;; includes only the needed files and excludes any auto-generated
+ ;; extra files like backups and auto-saves etc etc. Note that
+ ;; currently the zip command zips up the entire temp directory so
+ ;; that any auto-generated files created under the hood ends up in
+ ;; the resulting odt file.
+ (set (make-local-variable 'backup-inhibited) t)
+
+ ;; Outline numbering is retained only upto LEVEL.
+ ;; To disable outline numbering pass a LEVEL of 0.
+
+ (goto-char (point-min))
+ (let ((regex
+ "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
+ (replacement
+ "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
+ (while (re-search-forward regex nil t)
+ (unless (let ((sec-num (plist-get info :section-numbers))
+ (level (string-to-number (match-string 2))))
+ (if (wholenump sec-num) (<= level sec-num) sec-num))
+ (replace-match replacement t nil))))
+ (save-buffer 0)))
+ ;; Update content.xml.
+ (with-temp-buffer
+ (insert-file-contents
+ (or org-e-odt-content-template-file
+ (expand-file-name "OrgOdtContentTemplate.xml"
+ org-e-odt-styles-dir)))
+ ;; Write automatic styles.
+ ;; - Position the cursor.
+ (goto-char (point-min))
+ (re-search-forward " </office:automatic-styles>" nil t)
+ (goto-char (match-beginning 0))
+ ;; - Dump automatic table styles
+ (loop for (style-name props) in
+ (plist-get org-e-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) 96))
+ (insert (format org-e-odt-table-style-format style-name props))))
+ ;; Update display level.
+ ;; - Remove existing sequence decls. Also position the cursor.
+ (goto-char (point-min))
+ (when (re-search-forward "<text:sequence-decls" nil t)
+ (delete-region (match-beginning 0)
+ (re-search-forward "</text:sequence-decls>" nil nil)))
+ ;; Update sequence decls according to user preference.
+ (insert
+ (format
+ "\n<text:sequence-decls>\n%s\n</text:sequence-decls>"
+ (mapconcat
+ (lambda (x)
+ (format
+ "<text:sequence-decl text:display-outline-level=\"%d\" text:name=\"%s\"/>"
+ org-e-odt-display-outline-level (nth 1 x)))
+ org-e-odt-category-map-alist "\n")))
+ ;; Position the cursor to document body.
+ (goto-char (point-min))
+ (re-search-forward "</office:text>" nil nil)
+ (goto-char (match-beginning 0))
+
+ ;; Preamble - Title, Author, Date etc.
+ (insert
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (date (org-export-data (plist-get info :date) info))
+ (iso-date (org-e-odt--date date))
+ (date (org-e-odt--date date "%d %b %Y"))
+ (email (plist-get info :email))
+ ;; switch on or off above vars based on user settings
+ (author (and (plist-get info :with-author) (or author email)))
+ ;; (date (and (plist-get info :time-stamp-file) date))
+ (email (and (plist-get info :with-email) email)))
+ (concat
+ ;; title
+ (when title
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgTitle" (format "\n<text:title>%s</text:title>" title))
+ ;; separator
+ "\n<text:p text:style-name=\"OrgTitle\"/>"))
+ (cond
+ ((and author (not email))
+ ;; author only
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (format "<text:initial-creator>%s</text:initial-creator>" author))
+ ;; separator
+ "\n<text:p text:style-name=\"OrgSubtitle\"/>"))
+ ((and author email)
+ ;; author and email
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (org-e-odt-format-link
+ (format "<text:initial-creator>%s</text:initial-creator>" author)
+ (concat "mailto:" email)))
+ ;; separator
+ "\n<text:p text:style-name=\"OrgSubtitle\"/>")))
+ ;; date
+ (when date
+ (concat
+ (format
+ "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (format
+ "\n<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">%s</text:date>"
+
+ "N75" iso-date date))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))))
+
+ ;; Table of Contents
+ (let ((depth (plist-get info :with-toc)))
+ (when (wholenump depth) (insert (org-e-odt-toc depth info))))
+ ;; Contents.
+ (insert contents)
+ ;; Return contents.
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-e-odt-bold (bold contents info)
+ "Transcode BOLD from Org to ODT.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Bold" contents))
+
+
+;;;; Center Block
+
+(defun org-e-odt-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-e-odt--wrap-label center-block contents))
+
+
+;;;; Clock
+
+(defun org-e-odt-clock (clock contents info)
+ "Transcode a CLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampWrapper"
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampKeyword" org-clock-string)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp"
+ (concat (org-translate-time
+ (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time (format " (%s)" time))))))))
+
+
+;;;; Code
+
+(defun org-e-odt-code (code contents info)
+ "Transcode a CODE object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-element-property :value code)))
+
+
+;;;; Comment
+
+;; Comments are ignored.
+
+
+;;;; Comment Block
+
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-e-odt-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (if (functionp org-e-odt-format-drawer-function)
+ (funcall org-e-odt-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ (org-e-odt--wrap-label drawer output)))
+
+
+;;;; Dynamic Block
+
+(defun org-e-odt-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-e-odt--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-e-odt-entity (entity contents info)
+ "Transcode an ENTITY object from Org to ODT.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ ;; (let ((ent (org-element-property :latex entity)))
+ ;; (if (org-element-property :latex-math-p entity)
+ ;; (format "$%s$" ent)
+ ;; ent))
+ (org-element-property :utf-8 entity))
+
+
+;;;; Example Block
+
+(defun org-e-odt-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-odt--wrap-label
+ example-block (org-e-odt-format-code example-block info)))
+
+
+;;;; Export Snippet
+
+(defun org-e-odt-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-odt)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-e-odt-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "ODT")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Fixed Width
+
+(defun org-e-odt-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-odt--wrap-label
+ fixed-width (org-e-odt-do-format-code
+ (org-element-property :value fixed-width))))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored.
+
+
+;;;; Footnote Reference
+
+(defun org-e-odt-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((--format-footnote-definition
+ (function
+ (lambda (n def)
+ (setq n (format "%d" n))
+ (let ((id (concat "fn" n))
+ (note-class "footnote")
+ (par-style "Footnote"))
+ (format
+ "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
+ id note-class
+ (concat
+ (format "<text:note-citation>%s</text:note-citation>" n)
+ (format "<text:note-body>%s</text:note-body>" def)))))))
+ (--format-footnote-reference
+ (function
+ (lambda (n)
+ (setq n (format "%d" n))
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript"
+ (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
+ note-class ref-format ref-name n)))))))
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (and (eq (org-element-type prev) 'footnote-reference)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript" ",")))
+ ;; Trancode footnote reference.
+ (let ((n (org-export-get-footnote-number footnote-reference info)))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (funcall --format-footnote-reference n))
+ ;; Inline definitions are secondary strings.
+ ;; Non-inline footnotes definitions are full Org data.
+ (t
+ (let* ((raw (org-export-get-footnote-definition footnote-reference
+ info))
+ (def (let ((def (org-trim (org-export-data raw info))))
+ (if (eq (org-element-type raw) 'org-data) def
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Footnote" def)))))
+ (funcall --format-footnote-definition n def))))))))
+
+
+;;;; Headline
+
+(defun* org-e-odt-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (concat
+ ;; Todo.
+ (and todo
+ (concat
+ (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ style todo)) " "))
+ ;; Title.
+ text
+ ;; Tags.
+ (and tags
+ (concat "<text:tab/>"
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" (mapconcat 'org-trim tags " : "))))))
+
+(defun org-e-odt-format-headline--wrap (headline info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode an HEADLINE element from Org to ODT.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((level (+ (org-export-get-relative-level headline info)))
+ (headline-number (org-export-get-headline-number headline info))
+ (section-number (and (org-export-numbered-headline-p headline info)
+ (mapconcat 'number-to-string
+ headline-number ".")))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (headline-label (concat "sec-" (mapconcat 'number-to-string
+ headline-number "-")))
+ (format-function (cond
+ ((functionp format-function) format-function)
+ ((functionp org-e-odt-format-headline-function)
+ (function*
+ (lambda (todo todo-type priority text tags
+ &allow-other-keys)
+ (funcall org-e-odt-format-headline-function
+ todo todo-type priority text tags))))
+ (t 'org-e-odt-format-headline))))
+ (apply format-function
+ todo todo-type priority text tags
+ :headline-label headline-label :level level
+ :section-number section-number extra-keys)))
+
+
+(defun org-e-odt-begin-plain-list (ltype &optional continue-numbering)
+ (unless (member ltype '(ordered unordered descriptive))
+ (error "Unknown list type: %s" ltype))
+ (let ((style-name (assoc-default ltype
+ '((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (descriptive . "OrgDescriptionList")))))
+ (format "<text:list text:style-name=\"%s\" text:continue-numbering=\"%s\">"
+ style-name (if continue-numbering "true" "false"))))
+
+(defun org-e-odt-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to ODT.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((numberedp (org-export-numbered-headline-p headline info))
+ ;; Get level relative to current parsed data.
+ (level (org-export-get-relative-level headline info))
+ (text (org-export-data (org-element-property :title headline) info))
+ ;; Create the headline text.
+ (full-text (org-e-odt-format-headline--wrap headline info)))
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ;; FIXME
+ ;; ((org-export-low-level-p headline info)
+ ;; ;; Build the real contents of the sub-tree.
+ ;; (let* ((type (if numberedp 'unordered 'unordered)) ; FIXME
+ ;; (itemized-body (org-e-odt-format-list-item
+ ;; contents type nil nil full-text)))
+ ;; (concat
+ ;; (and (org-export-first-sibling-p headline info)
+ ;; (org-e-odt-begin-plain-list type))
+ ;; itemized-body
+ ;; (and (org-export-last-sibling-p headline info)
+ ;; "</text:list>"))))
+ ;; Case 3. Standard headline. Export it as a section.
+ (t
+ (let* ((extra-ids (list (org-element-property :custom-id headline)
+ (org-element-property :id headline)))
+ (extra-ids nil) ; FIXME
+ (id (concat "sec-" (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-"))))
+ (concat
+ (format
+ "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\">%s%s</text:h>"
+ (format "Heading_20_%s" level)
+ level
+ ;; Extra targets.
+ (mapconcat (lambda (x)
+ (when x
+ (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-e-odt-format-target
+ "" (org-export-solidify-link-text x)))))
+ extra-ids "")
+ ;; Title.
+ (org-e-odt-format-target full-text id))
+ contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-e-odt-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-odt--wrap-label
+ horizontal-rule
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Horizontal_20_Line" "")))
+
+
+;;;; Inline Babel Call
+
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-e-odt--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-e-odt-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (code (org-element-property :value inline-src-block))
+ (separator (org-e-odt--find-verb-separator code)))
+ (error "FIXME")))
+
+
+;;;; Inlinetask
+
+(defun org-e-odt-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (cond
+ ;; If `org-e-odt-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ ((functionp org-e-odt-format-inlinetask-function)
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-e-odt-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-e-odt-format-headline--wrap
+ inlinetask info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t (org-e-odt--wrap-label
+ inlinetask
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-e-odt--textbox
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgInlineTaskHeading"
+ (org-e-odt-format-headline--wrap
+ inlinetask info))
+ contents)
+ nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))))))
+
+;;;; Italic
+
+(defun org-e-odt-italic (italic contents info)
+ "Transcode ITALIC from Org to ODT.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" contents))
+
+
+;;;; Item
+
+(defun org-e-odt-item (item contents info)
+ "Transcode an ITEM element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((plain-list (org-export-get-parent item))
+ (type (org-element-property :type plain-list))
+ (counter (org-element-property :counter item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag
+ (concat (org-e-odt--checkbox item)
+ (org-export-data tag info))))))
+ (case type
+ ((ordered unordered)
+ (format "\n<text:list-item>\n%s\n%s"
+ contents
+ (let* ((--element-has-a-table-p
+ (function
+ (lambda (element info)
+ (loop for el in (org-element-contents element)
+ thereis (eq (org-element-type el) 'table))))))
+ (cond
+ ((funcall --element-has-a-table-p item info)
+ "</text:list-header>")
+ (t "</text:list-item>")))))
+ (descriptive
+ (concat
+ (let ((term (or tag "(no term)")))
+ (concat
+ (format "\n<text:list-item>\n%s\n</text:list-item>"
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body_20_bold" term))
+ (format
+ "\n<text:list-item>\n%s\n</text:list-item>"
+ (format "\n<text:list text:style-name=\"%s\" %s>\n%s\n</text:list>"
+ "OrgDescriptionList"
+ "text:continue-numbering=\"false\""
+ (format "\n<text:list-item>\n%s\n</text:list-item>"
+ contents)))))))
+ (t (error "Unknown list type: %S" type)))))
+
+
+;;;; Keyword
+
+(defun org-e-odt-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "LATEX") value)
+ ((string= key "INDEX") (format "\\index{%s}" value))
+ ((string= key "TARGET") nil ; FIXME
+ ;; (format "\\label{%s}" (org-export-solidify-link-text value))
+ )
+ ((string= key "toc")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (when (wholenump depth) (org-e-odt-toc depth info))))
+ ((string= "tables" value) "FIXME")
+ ((string= "figures" value) "FIXME")
+ ((string= "listings" value)
+ (cond
+ ;; At the moment, src blocks with a caption are wrapped
+ ;; into a figure environment.
+ (t "FIXME")))))))))
+
+
+;;;; Latex Environment
+
+
+(eval-after-load 'org-odt
+ '(ad-deactivate 'org-format-latex-as-mathml))
+
+;; (defadvice org-format-latex-as-mathml ; FIXME
+;; (after org-e-odt-protect-latex-fragment activate)
+;; "Encode LaTeX fragment as XML.
+;; Do this when translation to MathML fails."
+;; (when (or (not (> (length ad-return-value) 0))
+;; (get-text-property 0 'org-protected ad-return-value))
+;; (setq ad-return-value
+;; (org-propertize (org-e-odt-encode-plain-text (ad-get-arg 0))
+;; 'org-protected t))))
+
+(defun org-e-odt-format-latex (latex-frag processing-type info)
+ (let* ((prefix (case processing-type
+ (dvipng "ltxpng/")
+ (mathml "ltxmathml/")))
+ (input-file (plist-get info :input-file))
+ (cache-subdir
+ (concat prefix (file-name-sans-extension
+ (file-name-nondirectory input-file))))
+ (cache-dir (file-name-directory input-file))
+ (display-msg (case processing-type
+ (dvipng "Creating LaTeX Image...")
+ (mathml "Creating MathML snippet..."))))
+ (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-subdir cache-dir nil display-msg
+ nil nil processing-type)
+ (buffer-string))))
+
+(defun org-e-odt-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-e-odt--wrap-label
+ latex-environment
+ (let* ((latex-frag
+ (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (processing-type (plist-get info :LaTeX-fragments))
+ (caption (org-element-property :caption latex-environment))
+ (short-caption (and (cdr caption)
+ (org-export-data (cdr caption) info)))
+ (caption (and (car caption) (org-export-data (car caption) info)))
+ (label (org-element-property :name latex-environment))
+ (attr nil) ; FIXME
+ (label (org-element-property :name latex-environment)))
+
+ (when (memq processing-type '(t mathjax))
+ (unless (and (fboundp 'org-format-latex-mathml-available-p)
+ (org-format-latex-mathml-available-p))
+ (message "LaTeX to MathML converter not available. Trying dvinpng...")
+ (setq processing-type 'dvipng)))
+
+ (when (eq processing-type 'dvipng)
+ (unless (and (org-check-external-command "latex" "" t)
+ (org-check-external-command "dvipng" "" t))
+ (message "LaTeX to PNG converter not available. Using verbatim.")
+ (setq processing-type 'verbatim)))
+
+ (case processing-type
+ ((t mathjax)
+ (org-e-odt-format-formula latex-environment info))
+ (dvipng
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-e-odt-link--inline-image latex-environment info)))
+ (t (org-e-odt-do-format-code latex-frag))))))
+
+
+;;;; Latex Fragment
+
+
+;; (when latex-frag ; FIXME
+;; (setq href (org-propertize href :title "LaTeX Fragment"
+;; :description latex-frag)))
+;; handle verbatim
+;; provide descriptions
+
+(defun org-e-odt-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let* ((latex-frag (org-element-property :value latex-fragment))
+ (processing-type (plist-get info :LaTeX-fragments)))
+ (cond
+ ((member processing-type '(t mathjax))
+ (org-e-odt-format-formula latex-fragment info))
+ ((eq processing-type 'dvipng)
+ (org-e-odt-link--inline-image latex-fragment info))
+ (t (org-e-odt-encode-plain-text latex-frag t)))))
+
+
+;;;; Line Break
+
+(defun org-e-odt-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "<text:line-break/>\n")
+
+
+;;;; Link
+
+
+
+;;;; Links :: Generic
+
+(defun org-e-odt-format-link (desc href &optional suppress-xref)
+ (cond
+ ((and (= (string-to-char href) ?#) (not suppress-xref))
+ (setq href (substring href 1))
+ (let ((xref-format "text"))
+ (when (numberp desc)
+ (setq desc (format "%d" desc) xref-format "number"))
+ (when (listp desc)
+ (setq desc (mapconcat 'number-to-string desc ".") xref-format "chapter"))
+ (setq href (concat org-e-odt-bookmark-prefix href))
+ (format
+ "<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:bookmark-ref>"
+ xref-format href desc)))
+ ;; (org-lparse-link-description-is-image
+ ;; (format "\n<draw:a xlink:type=\"simple\" xlink:href=\"%s\">\n%s\n</draw:a>"
+ ;; href desc))
+ (t (format "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ href desc))))
+
+(defun org-e-odt-format-internal-link (text href)
+ (org-e-odt-format-link text (concat "#" href)))
+
+;;;; Links :: Label references
+
+(defun org-e-odt-enumerate-element (element info &optional predicate n)
+ (let* ((--numbered-parent-headline-at-<=-n
+ (function
+ (lambda (element n info)
+ (loop for x in (org-export-get-genealogy element)
+ thereis (and (eq (org-element-type x) 'headline)
+ (<= (org-export-get-relative-level x info) n)
+ (org-export-numbered-headline-p x info)
+ x)))))
+ (--enumerate
+ (function
+ (lambda (element scope info &optional predicate)
+ (let ((counter 0))
+ (org-element-map
+ (or scope (plist-get info :parse-tree))
+ (org-element-type element)
+ (lambda (el)
+ (and (or (not predicate) (funcall predicate el info))
+ (incf counter)
+ (eq element el)
+ counter))
+ info 'first-match)))))
+ (scope (funcall --numbered-parent-headline-at-<=-n
+ element (or n org-e-odt-display-outline-level) info))
+ (ordinal (funcall --enumerate element scope info predicate))
+ (tag
+ (concat
+ ;; Section number.
+ (and scope
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number scope info) "."))
+ ;; Separator.
+ (and scope ".")
+ ;; Ordinal.
+ (number-to-string ordinal))))
+ tag))
+
+(defun org-e-odt-format-label (element info op)
+ (let* ((caption-from
+ (case (org-element-type element)
+ (link (org-export-get-parent-element element))
+ (t element)))
+ ;; get label and caption.
+ (label (org-element-property :name caption-from))
+ (caption (org-element-property :caption caption-from))
+ (short-caption (cdr caption))
+ ;; transcode captions.
+ (caption (and (car caption) (org-export-data (car caption) info)))
+ (short-caption (and short-caption
+ (org-export-data short-caption info))))
+ (when (or label caption)
+ (let* ((default-category
+ (cond
+ ((eq (org-element-type element) 'table)
+ "__Table__")
+ ((org-e-odt-standalone-image-p element info)
+ "__Figure__")
+ ((member (org-element-type element)
+ '(latex-environment latex-fragment))
+ (let ((processing-type (plist-get info :LaTeX-fragments)))
+ (cond
+ ((eq processing-type 'dvipng) "__DvipngImage__")
+ ((eq processing-type 'mathjax) "__MathFormula__")
+ ((eq processing-type 't) "__MathFormula__")
+ (t (error "Handle LaTeX:verbatim")))))
+ ((eq (org-element-type element) 'src-block)
+ "__Listing__")
+ (t (error "Handle enumeration of %S" element))))
+ (predicate
+ (cond
+ ((member (org-element-type element)
+ '(table latex-environment src-block))
+ nil)
+ ((org-e-odt-standalone-image-p element info)
+ 'org-e-odt-standalone-image-p)
+ (t (error "Handle enumeration of %S" element))))
+ (seqno (org-e-odt-enumerate-element
+ element info predicate)) ; FIXME
+ ;; handle label props.
+ (label-props (assoc default-category org-e-odt-category-map-alist))
+ ;; identify opendocument counter
+ (counter (nth 1 label-props))
+ ;; identify label style
+ (label-style (nth 2 label-props))
+ ;; retrieve localized category sting
+ (category (org-export-translate (nth 3 label-props) :utf-8 info)))
+ (case op
+ (definition
+ ;; assign an internal label, if user has not provided one
+ (setq label (or label (format "%s-%s" default-category seqno)))
+ (setq label (org-export-solidify-link-text label))
+
+ (cons
+ (format-spec
+ (cadr (assoc-string label-style org-e-odt-label-styles t))
+ `((?e . ,category)
+ (?n . ,(format
+ "<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">%s</text:sequence>"
+ label counter counter seqno))
+ (?c . ,(or caption ""))))
+ short-caption))
+ (reference
+ (assert label)
+ (setq label (org-export-solidify-link-text label))
+ (let* ((fmt (cddr (assoc-string label-style org-e-odt-label-styles t)))
+ (fmt1 (car fmt))
+ (fmt2 (cadr fmt)))
+ (format "<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:sequence-ref>"
+ fmt1 label (format-spec fmt2 `((?e . ,category)
+ (?n . ,seqno))))))
+ (t (error "Unknow %S on label" op)))))))
+
+;;;; Links :: Embedded images
+
+(defun org-e-odt-copy-image-file (path)
+ "Returns the internal name of the file"
+ (let* ((image-type (file-name-extension path))
+ (media-type (format "image/%s" image-type))
+ (target-dir "Images/")
+ (target-file
+ (format "%s%04d.%s" target-dir
+ (incf org-e-odt-embedded-images-count) image-type)))
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+
+ (when (= 1 org-e-odt-embedded-images-count)
+ (make-directory (concat org-e-odt-zip-dir target-dir))
+ (org-e-odt-create-manifest-file-entry "" target-dir))
+
+ (copy-file path (concat org-e-odt-zip-dir target-file) 'overwrite)
+ (org-e-odt-create-manifest-file-entry media-type target-file)
+ target-file))
+
+(defun org-e-odt-image-size-from-file (file &optional user-width
+ user-height scale dpi embed-as)
+ (let* ((--pixels-to-cms
+ (function (lambda (pixels dpi)
+ (let ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches)))))
+ (--size-in-cms
+ (function
+ (lambda (size-in-pixels dpi)
+ (and size-in-pixels
+ (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
+ (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))
+ (dpi (or dpi org-e-odt-pixels-per-inch))
+ (anchor-type (or embed-as "paragraph"))
+ (user-width (and (not scale) user-width))
+ (user-height (and (not scale) user-height))
+ (size
+ (and
+ (not (and user-height user-width))
+ (or
+ ;; Use Imagemagick.
+ (and (executable-find "identify")
+ (let ((size-in-pixels
+ (let ((dim (shell-command-to-string
+ (format "identify -format \"%%w:%%h\" \"%s\""
+ file))))
+ (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
+ (cons (string-to-number (match-string 1 dim))
+ (string-to-number (match-string 2 dim)))))))
+ (funcall --size-in-cms size-in-pixels dpi)))
+ ;; Use Emacs.
+ (let ((size-in-pixels
+ (ignore-errors ; Emacs could be in batch mode
+ (clear-image-cache)
+ (image-size (create-image file) 'pixels))))
+ (funcall --size-in-cms size-in-pixels dpi))
+ ;; Use hard-coded values.
+ (cdr (assoc-string anchor-type
+ org-e-odt-default-image-sizes-alist))
+ ;; Error out.
+ (error "Cannot determine image size, aborting"))))
+ (width (car size)) (height (cdr size)))
+ (cond
+ (scale
+ (setq width (* width scale) height (* height scale)))
+ ((and user-height user-width)
+ (setq width user-width height user-height))
+ (user-height
+ (setq width (* user-height (/ width height)) height user-height))
+ (user-width
+ (setq height (* user-width (/ height width)) width user-width))
+ (t (ignore)))
+ ;; ensure that an embedded image fits comfortably within a page
+ (let ((max-width (car org-e-odt-max-image-size))
+ (max-height (cdr org-e-odt-max-image-size)))
+ (when (or (> width max-width) (> height max-height))
+ (let* ((scale1 (/ max-width width))
+ (scale2 (/ max-height height))
+ (scale (min scale1 scale2)))
+ (setq width (* scale width) height (* scale height)))))
+ (cons width height)))
+
+;;;; Links :: Math formula
+
+(defun org-e-odt-format-formula (element info)
+ (let* ((src (cond
+ ((eq (org-element-type element) 'link) ; FIXME
+ (let* ((type (org-element-property :type element))
+ (raw-path (org-element-property :path element)))
+ (cond
+ ((file-name-absolute-p raw-path)
+ (expand-file-name raw-path))
+ (t raw-path))))
+ ((member (org-element-type element)
+ '(latex-fragment latex-environment))
+ (let* ((latex-frag (org-remove-indentation
+ (org-element-property :value element)))
+ (formula-link (org-e-odt-format-latex
+ latex-frag 'mathml info)))
+ (and formula-link
+ (string-match "file:\\([^]]*\\)" formula-link)
+ (match-string 1 formula-link))))
+ (t (error "what is this?"))))
+ (full-src (if (file-name-absolute-p src) src
+ (expand-file-name src (file-name-directory
+ (plist-get info :input-file)))))
+ (caption-from
+ (case (org-element-type element)
+ (link (org-export-get-parent-element element))
+ (t element)))
+ (captions (org-e-odt-format-label caption-from info 'definition))
+ (caption (car captions))
+ (href
+ (format "\n<draw:object %s xlink:href=\"%s\" xlink:type=\"simple\"/>"
+ " xlink:show=\"embed\" xlink:actuate=\"onLoad\""
+ (file-name-directory (org-e-odt-copy-formula-file full-src))))
+ (embed-as (if caption 'paragraph 'character))
+ width height)
+ (cond
+ ((eq embed-as 'character)
+ (org-e-odt-format-entity "InlineFormula" href width height))
+ (t
+ (let* ((equation (org-e-odt-format-entity
+ "CaptionedDisplayFormula" href width height captions))
+ (label
+ (let* ((org-e-odt-category-map-alist
+ '(("__Table__" "Table" "value")
+ ("__Figure__" "Illustration" "value")
+ ("__MathFormula__" "Text" "math-label")
+ ("__DvipngImage__" "Equation" "value")
+ ("__Listing__" "Listing" "value"))))
+ (car (org-e-odt-format-label caption-from info 'definition))))
+ (formula-tree
+ (org-e-odt--adopt-elements
+ `(table (:type org :attr_odt (":style \"OrgEquation\"")))
+ (org-e-odt--adopt-elements
+ `(table-row (:type standard))
+ `(table-cell nil "<c8>") `(table-cell nil "<c1>"))
+ (org-e-odt--adopt-elements
+ `(table-row (:type standard))
+ (org-e-odt--adopt-elements
+ `(table-cell nil) `(export-block
+ (:type "ODT" :value ,equation)))
+ (org-e-odt--adopt-elements
+ `(table-cell nil) `(export-block
+ (:type "ODT" :value ,label))))))
+ (formula-info
+ (org-export-collect-tree-properties
+ formula-tree (org-export-get-environment 'e-odt))))
+ (org-export-data formula-tree formula-info))))))
+
+(defun org-e-odt-copy-formula-file (src-file)
+ "Returns the internal name of the file"
+ (let* ((target-dir (format "Formula-%04d/"
+ (incf org-e-odt-embedded-formulas-count)))
+ (target-file (concat target-dir "content.xml")))
+ ;; Create a directory for holding formula file. Also enter it in
+ ;; to manifest.
+ (make-directory (concat org-e-odt-zip-dir target-dir))
+ (org-e-odt-create-manifest-file-entry
+ "application/vnd.oasis.opendocument.formula" target-dir "1.2")
+ ;; Copy over the formula file from user directory to zip
+ ;; directory.
+ (message "Embedding %s as %s ..." src-file target-file)
+ (let ((case-fold-search nil))
+ (cond
+ ;; Case 1: Mathml.
+ ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file)
+ (copy-file src-file (concat org-e-odt-zip-dir target-file) 'overwrite))
+ ;; Case 2: OpenDocument formula.
+ ((string-match "\\.odf\\'" src-file)
+ (org-e-odt--zip-extract src-file "content.xml"
+ (concat org-e-odt-zip-dir target-dir)))
+ (t (error "%s is not a formula file" src-file))))
+ ;; Enter the formula file in to manifest.
+ (org-e-odt-create-manifest-file-entry "text/xml" target-file)
+ target-file))
+
+;;;; Targets
+
+(defun org-e-odt-format-target (text id)
+ (let ((name (concat org-e-odt-bookmark-prefix id)))
+ (concat
+ (and id (format "\n<text:bookmark-start text:name=\"%s\"/>" name))
+ (concat (and id (format "\n<text:bookmark text:name=\"%s\"/>" id)) text)
+ (and id (format "\n<text:bookmark-end text:name=\"%s\"/>" name)))))
+
+(defun org-e-odt-link--inline-image (element info)
+ "Return HTML code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (let* ((src (cond
+ ((eq (org-element-type element) 'link)
+ (let* ((type (org-element-property :type element))
+ (raw-path (org-element-property :path element)))
+ (cond ((member type '("http" "https"))
+ (concat type ":" raw-path))
+ ((file-name-absolute-p raw-path)
+ (expand-file-name raw-path))
+ (t raw-path))))
+ ((member (org-element-type element)
+ '(latex-fragment latex-environment))
+ (let* ((latex-frag (org-remove-indentation
+ (org-element-property :value element)))
+ (formula-link (org-e-odt-format-latex
+ latex-frag 'dvipng info)))
+ (and formula-link
+ (string-match "file:\\([^]]*\\)" formula-link)
+ (match-string 1 formula-link))))
+ (t (error "what is this?"))))
+ (src-expanded (if (file-name-absolute-p src) src
+ (expand-file-name src (file-name-directory
+ (plist-get info :input-file)))))
+ (href (format
+ "\n<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>"
+ (org-e-odt-copy-image-file src-expanded)))
+ ;; extract attributes from #+ATTR_ODT line.
+ (attr-from (case (org-element-type element)
+ (link (org-export-get-parent-element element))
+ (t element)))
+ ;; convert attributes to a plist.
+ (attr-plist (org-export-read-attribute :attr_odt attr-from))
+ ;; handle `:anchor', `:style' and `:attributes' properties.
+ (user-frame-anchor
+ (car (assoc-string (plist-get attr-plist :anchor)
+ '(("as-char") ("paragraph") ("page")) t)))
+ (user-frame-style
+ (and user-frame-anchor (plist-get attr-plist :style)))
+ (user-frame-attrs
+ (and user-frame-anchor (plist-get attr-plist :attributes)))
+ (user-frame-params
+ (list user-frame-style user-frame-attrs user-frame-anchor))
+ ;; (embed-as (or embed-as user-frame-anchor "paragraph"))
+ ;; extrac
+ ;; handle `:width', `:height' and `:scale' properties.
+ (size (org-e-odt-image-size-from-file
+ src-expanded (plist-get attr-plist :width)
+ (plist-get attr-plist :height)
+ (plist-get attr-plist :scale) nil ;; embed-as
+ "paragraph" ; FIXME
+ ))
+ (width (car size)) (height (cdr size))
+ (embed-as
+ (case (org-element-type element)
+ ((org-e-odt-standalone-image-p element info) "paragraph")
+ (latex-fragment "as-char")
+ (latex-environment "paragraph")
+ (t "paragraph")))
+ (captions (org-e-odt-format-label element info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ (entity (concat (and caption "Captioned") embed-as "Image")))
+ (org-e-odt-format-entity entity href width height
+ captions user-frame-params )))
+
+(defun org-e-odt-format-entity (entity href width height &optional
+ captions user-frame-params)
+ (let* ((caption (car captions)) (short-caption (cdr captions))
+ (entity-style (assoc-string entity org-e-odt-entity-frame-styles t))
+ default-frame-params frame-params
+ (--merge-frame-params
+ (function
+ (lambda (default-frame-params user-frame-params)
+ (if (not user-frame-params) default-frame-params
+ (assert (= (length default-frame-params) 3))
+ (assert (= (length user-frame-params) 3))
+ (loop for user-frame-param in user-frame-params
+ for default-frame-param in default-frame-params
+ collect (or user-frame-param default-frame-param)))))))
+ (cond
+ ((not caption)
+ (setq default-frame-params (nth 2 entity-style))
+ (setq frame-params (funcall --merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-e-odt--frame href width height frame-params))
+ (t
+ (setq default-frame-params (nth 3 entity-style))
+ (setq frame-params (funcall --merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-e-odt--textbox
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Illustration"
+ (concat
+ (apply 'org-e-odt--frame href width height
+ (let ((entity-style-1 (copy-sequence
+ (nth 2 entity-style))))
+ (setcar (cdr entity-style-1)
+ (concat
+ (cadr entity-style-1)
+ (and short-caption
+ (format " draw:name=\"%s\" "
+ short-caption))))
+ entity-style-1))
+ caption))
+ width height frame-params)))))
+
+(defun org-e-odt-standalone-image-p (element info)
+ "Test if ELEMENT is a standalone image for the purpose ODT export.
+INFO is a plist holding contextual information.
+
+Return non-nil, if ELEMENT is of type paragraph and it's sole
+content, save for whitespaces, is a link that qualifies as an
+inline image.
+
+Return non-nil, if ELEMENT is of type link and it's containing
+paragraph has no other content save for leading and trailing
+whitespaces.
+
+Return nil, otherwise.
+
+Bind `org-e-odt-standalone-image-predicate' to constrain
+paragraph further. For example, to check for only captioned
+standalone images, do the following.
+
+ \(setq org-e-odt-standalone-image-predicate
+ \(lambda \(paragraph\)
+ \(org-element-property :caption paragraph\)\)\)
+"
+ (let ((--standalone-image-predicate
+ (function (lambda (paragraph)
+ (or (org-element-property :caption paragraph)
+ (org-element-property :name paragraph)))))
+ (paragraph (case (org-element-type element)
+ (paragraph element)
+ (link (and (org-export-inline-image-p
+ element org-e-odt-inline-image-rules)
+ (org-export-get-parent element)))
+ (t nil))))
+ (when paragraph
+ (assert (eq (org-element-type paragraph) 'paragraph))
+ (when (funcall --standalone-image-predicate paragraph)
+ (let ((contents (org-element-contents paragraph)))
+ (loop for x in contents
+ with inline-image-count = 0
+ always (cond
+ ((eq (org-element-type x) 'plain-text)
+ (not (org-string-nw-p x)))
+ ((eq (org-element-type x) 'link)
+ (when (org-export-inline-image-p
+ x org-e-odt-inline-image-rules)
+ (= (incf inline-image-count) 1)))
+ (t nil))))))))
+
+(defun org-e-odt-link (link desc info)
+ "Transcode a LINK object from Org to ODT.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (imagep (org-export-inline-image-p
+ link org-e-odt-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and (not desc) (org-export-inline-image-p
+ link org-e-odt-inline-image-rules))
+ (org-e-odt-link--inline-image link info))
+ ;; Radio target: Transcode target's contents and use them as
+ ;; link's description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (when destination
+ (org-e-odt-format-internal-link
+ (org-export-data (org-element-contents destination) info)
+ (org-export-solidify-link-text path)))))
+ ;; Links pointing to an headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; Fuzzy link points nowhere.
+ ('nil
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" (or desc (org-export-data
+ (org-element-property
+ :raw-link link) info))))
+ ;; Fuzzy link points to an invisible target.
+ (keyword nil)
+ ;; LINK points to an headline. Check if LINK should display
+ ;; section numbers.
+ (headline
+ (let* ((headline-no (org-export-get-headline-number destination info))
+ (label (format "sec-%s" (mapconcat 'number-to-string
+ headline-no "-")))
+ (desc
+ ;; Case 1: Headline is numbered and LINK has no
+ ;; description or LINK's description matches
+ ;; headline's title. Display section number.
+ (if (and (org-export-numbered-headline-p destination info)
+ (or (not desc)
+ (string= desc (org-element-property
+ :raw-value destination))))
+ headline-no
+ ;; Case 2: Either the headline is un-numbered or
+ ;; LINK has a custom description. Display LINK's
+ ;; description or headline's title.
+ (or desc (org-export-data (org-element-property
+ :title destination) info)))))
+ (org-e-odt-format-internal-link desc label)))
+ ;; Fuzzy link points to a target. Do as above.
+ (otherwise
+ ;; (unless desc
+ ;; (setq number (cond
+ ;; ((org-e-odt-standalone-image-p destination info)
+ ;; (org-export-get-ordinal
+ ;; (assoc 'link (org-element-contents destination))
+ ;; info 'link 'org-e-odt-standalone-image-p))
+ ;; (t (org-export-get-ordinal destination info))))
+ ;; (setq desc (when number
+ ;; (if (atom number) (number-to-string number)
+ ;; (mapconcat 'number-to-string number ".")))))
+
+ (let ((label-reference
+ (org-e-odt-format-label destination info 'reference)))
+ (assert label-reference)
+ label-reference)))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (let* ((fmt (org-export-get-coderef-format path desc))
+ (res (org-export-resolve-coderef path info))
+ (href (concat "#coderef-" path)))
+ (format fmt (org-e-odt-format-link res href))))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'odt))
+ ;; External link with a description part.
+ ((and path desc) (org-e-odt-format-link desc path))
+ ;; External link without a description part.
+ (path (org-e-odt-format-link path path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" desc)))))
+
+
+;;;; Babel Call
+
+;; Babel Calls are ignored.
+
+
+;;;; Macro
+
+(defun org-e-odt-macro (macro contents info)
+ "Transcode a MACRO element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+
+;;;; Paragraph
+
+(defun org-e-odt-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to ODT.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let* ((parent (org-export-get-parent paragraph))
+ (parent-type (org-element-type parent))
+ (style (case parent-type
+ (quote-block "Quotations")
+ (center-block "OrgCenter")
+ (footnote-definition "Footnote")
+ (t "Text_20_body"))))
+ ;; If this paragraph is a leading paragraph in a non-descriptive
+ ;; item and the item has a checkbox, splice the checkbox and
+ ;; paragraph contents together.
+ (when (and (eq (org-element-type parent) 'item)
+ (not (eq (org-element-property :type
+ (org-export-get-parent parent))
+ 'descriptive))
+ (eq paragraph (car (org-element-contents parent))))
+ (setq contents (concat (org-e-odt--checkbox parent) contents)))
+ (assert style)
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>" style contents)))
+
+
+;;;; Plain List
+
+(defun org-e-odt-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to ODT.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (continue-numbering nil))
+ (assert (member type '(ordered unordered descriptive)))
+ (org-e-odt--wrap-label
+ plain-list
+ (format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>"
+ (assoc-default type '((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (descriptive . "OrgDescriptionList")))
+ ;; If top-level list, re-start numbering. Otherwise,
+ ;; continue numbering.
+ (format "text:continue-numbering=\"%s\""
+ (let* ((parent (org-export-get-parent plain-list)))
+ (if (and parent (eq (org-element-type parent) 'item))
+ "true" "false")))
+ contents))))
+
+;;;; Plain Text
+
+(defun org-e-odt-fill-tabs-and-spaces (line)
+ (replace-regexp-in-string
+ "\\([\t]\\|\\([ ]+\\)\\)"
+ (lambda (s)
+ (cond
+ ((string= s "\t") "<text:tab/>")
+ (t (let ((n (length s)))
+ (cond
+ ((= n 1) " ")
+ ((> n 1) (concat " " (format "<text:s text:c=\"%d\"/>" (1- n))))
+ (t ""))))))
+ line))
+
+(defun org-e-odt-encode-plain-text (text &optional no-whitespace-filling)
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
+ '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (if no-whitespace-filling text
+ (org-e-odt-fill-tabs-and-spaces text)))
+
+(defun org-e-odt--quotation-marks (text info)
+ "Export quotation marks depending on language conventions.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr (or (assoc (plist-get info :language) org-e-odt-quotes)
+ ;; Falls back on English.
+ (assoc "en" org-e-odt-quotes))))
+ text)
+
+(defun org-e-odt-plain-text (text info)
+ "Transcode a TEXT string from Org to ODT.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect &, < and >.
+ (setq text (org-e-odt-encode-plain-text text t))
+ ;; Handle quotation marks
+ (setq text (org-e-odt--quotation-marks text info))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t nil)))
+ org-e-odt-special-string-regexps))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" "<text:line-break/>\n" text t)))
+ ;; Return value.
+ text)
+
+
+;;;; Planning
+
+(defun org-e-odt-planning (planning contents info)
+ "Transcode a PLANNING element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampWrapper"
+ (concat
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampKeyword" org-closed-string)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp" (org-translate-time closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampKeyword" org-deadline-string)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp" (org-translate-time deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampKeyword" org-scheduled-string)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp" (org-translate-time scheduled))))))))
+
+
+;;;; Property Drawer
+
+(defun org-e-odt-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+
+;;;; Quote Block
+
+(defun org-e-odt-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-e-odt--wrap-label quote-block contents))
+
+
+;;;; Quote Section
+
+(defun org-e-odt-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (org-e-odt-do-format-code value))))
+
+
+;;;; Section
+
+
+(defun org-e-odt-format-section (text style &optional name)
+ (let ((default-name (car (org-e-odt-add-automatic-style "Section"))))
+ (format "\n<text:section text:style-name=\"%s\" %s>\n%s</text:section>"
+ style
+ (format "text:name=\"%s\"" (or name default-name))
+ text)))
+
+
+(defun org-e-odt-section (section contents info) ; FIXME
+ "Transcode a SECTION element from Org to ODT.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+;;;; Radio Target
+
+(defun org-e-odt-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to ODT.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (org-e-odt-format-target
+ text (org-export-solidify-link-text
+ (org-element-property :value radio-target))))
+
+
+;;;; Special Block
+
+(defun org-e-odt-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block)))
+ (attributes (org-export-read-attribute :attr_odt special-block)))
+ (org-e-odt--wrap-label
+ special-block
+ (cond
+ ;; Annotation.
+ ((string= type "annotation")
+ (let ((author (or (plist-get attributes :author)
+ (let ((author (plist-get info :author)))
+ (and author (org-export-data author info)))))
+ (date (or (plist-get attributes :date)
+ (plist-get info :date))))
+
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (format "<office:annotation>\n%s\n</office:annotation>"
+ (concat
+ (and author
+ (format "<dc:creator>%s</dc:creator>" author))
+ (and date
+ (format "<dc:date>%s</dc:date>"
+ (org-e-odt--date date)))
+ contents)))))
+ ;; Textbox.
+ ((string= type "textbox")
+ (let ((width (plist-get attributes :width))
+ (height (plist-get attributes :height))
+ (style (plist-get attributes :style))
+ (extra (plist-get attributes :extra))
+ (anchor (plist-get attributes :anchor)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body" (org-e-odt--textbox contents width height
+ style extra anchor))))
+ (t contents)))))
+
+
+;;;; Src Block
+
+
+(defun org-e-odt-hfy-face-to-css (fn)
+ "Create custom style for face FN.
+When FN is the default face, use it's foreground and background
+properties to create \"OrgSrcBlock\" paragraph style. Otherwise
+use it's color attribute to create a character style whose name
+is obtained from FN. Currently all attributes of FN other than
+color are ignored.
+
+The style name for a face FN is derived using the following
+operations on the face name in that order - de-dash, CamelCase
+and prefix with \"OrgSrc\". For example,
+`font-lock-function-name-face' is associated with
+\"OrgSrcFontLockFunctionNameFace\"."
+ (let* ((css-list (hfy-face-to-style fn))
+ (style-name ((lambda (fn)
+ (concat "OrgSrc"
+ (mapconcat
+ 'capitalize (split-string
+ (hfy-face-or-def-to-name fn) "-")
+ ""))) fn))
+ (color-val (cdr (assoc "color" css-list)))
+ (background-color-val (cdr (assoc "background" css-list)))
+ (style (and org-e-odt-create-custom-styles-for-srcblocks
+ (cond
+ ((eq fn 'default)
+ (format org-e-odt-src-block-paragraph-format
+ background-color-val color-val))
+ (t
+ (format
+ "
+<style:style style:name=\"%s\" style:family=\"text\">
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>" style-name color-val))))))
+ (cons style-name style)))
+
+(defun org-e-odt-htmlfontify-string (line)
+ (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (hfy-html-quote-map '(("\"" "&quot;")
+ ("<" "&lt;")
+ ("&" "&amp;")
+ (">" "&gt;")
+ (" " "<text:s/>")
+ (" " "<text:tab/>")))
+ (hfy-face-to-css 'org-e-odt-hfy-face-to-css)
+ (hfy-optimisations-1 (copy-seq hfy-optimisations))
+ (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ 'body-text-only))
+ (hfy-begin-span-handler
+ (lambda (style text-block text-id text-begins-block-p)
+ (insert (format "<text:span text:style-name=\"%s\">" style))))
+ (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
+ (with-no-warnings (htmlfontify-string line))))
+
+(defun org-e-odt-do-format-code
+ (code &optional lang refs retain-labels num-start)
+ (let* ((lang (or (assoc-default lang org-src-lang-modes) lang))
+ (lang-mode (and lang (intern (format "%s-mode" lang))))
+ (code-lines (org-split-string code "\n"))
+ (code-length (length code-lines))
+ (use-htmlfontify-p (and (functionp lang-mode)
+ org-e-odt-fontify-srcblocks
+ (require 'htmlfontify nil t)
+ (fboundp 'htmlfontify-string)))
+ (code (if (not use-htmlfontify-p) code
+ (with-temp-buffer
+ (insert code)
+ (funcall lang-mode)
+ (font-lock-fontify-buffer)
+ (buffer-string))))
+ (fontifier (if use-htmlfontify-p 'org-e-odt-htmlfontify-string
+ 'org-e-odt-encode-plain-text))
+ (par-style (if use-htmlfontify-p "OrgSrcBlock"
+ "OrgFixedWidthBlock"))
+ (i 0))
+ (assert (= code-length (length (org-split-string code "\n"))))
+ (setq code
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (setq par-style
+ (concat par-style (and (= (incf i) code-length) "LastLine")))
+
+ (setq loc (concat loc (and ref retain-labels (format " (%s)" ref))))
+ (setq loc (funcall fontifier loc))
+ (when ref
+ (setq loc (org-e-odt-format-target loc (concat "coderef-" ref))))
+ (assert par-style)
+ (setq loc (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ par-style loc))
+ (if (not line-num) loc
+ (format "\n<text:list-item>%s\n</text:list-item>" loc)))
+ num-start refs))
+ (cond
+ ((not num-start) code)
+ ((= num-start 0)
+ (format
+ "\n<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>%s</text:list>"
+ " text:continue-numbering=\"false\"" code))
+ (t
+ (format
+ "\n<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>%s</text:list>"
+ " text:continue-numbering=\"true\"" code)))))
+
+(defun org-e-odt-format-code (element info)
+ (let* ((lang (org-element-property :language element))
+ ;; Extract code and references.
+ (code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (refs (cdr code-info))
+ ;; Does the src block contain labels?
+ (retain-labels (org-element-property :retain-labels element))
+ ;; Does it have line numbers?
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0))))
+ (org-e-odt-do-format-code code lang refs retain-labels num-start)))
+
+(defun org-e-odt-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (short-caption (and (cdr caption)
+ (org-export-data (cdr caption) info)))
+ (caption (and (car caption) (org-export-data (car caption) info)))
+ (label (org-element-property :name src-block))
+ (attributes (org-export-read-attribute :attr_odt src-block)))
+ ;; FIXME: Handle caption
+ ;; caption-str (when caption)
+ ;; (main (org-export-data (car caption) info))
+ ;; (secondary (org-export-data (cdr caption) info))
+ ;; (caption-str (org-e-odt--caption/label-string caption label info))
+ (let* ((captions (org-e-odt-format-label src-block info 'definition))
+ (caption (car captions)) (short-caption (cdr captions)))
+ (concat
+ (and caption
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Listing" caption))
+ (let ((--src-block (org-e-odt-format-code src-block info)))
+ (if (not (plist-get attributes :textbox)) --src-block
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-e-odt--textbox --src-block nil nil nil))))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-e-odt-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((cookie-value (org-element-property :value statistics-cookie)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" cookie-value)))
+
+
+;;;; Strike-Through
+
+(defun org-e-odt-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to ODT.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Strikethrough" contents))
+
+
+;;;; Subscript
+
+(defun org-e-odt-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to ODT.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSubscript" contents))
+
+
+;;;; Superscript
+
+(defun org-e-odt-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to ODT.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript" contents))
+
+
+;;;; Table Cell
+
+(defun org-e-odt-table-style-spec (element info)
+ (let* ((table (org-export-get-parent-table element))
+ (table-attributes (org-export-read-attribute :attr_odt table))
+ (table-style (plist-get table-attributes :style)))
+ (assoc table-style org-e-odt-table-styles)))
+
+(defun org-e-odt-get-table-cell-styles (table-cell info)
+ "Retrieve styles applicable to a table cell.
+R and C are (zero-based) row and column numbers of the table
+cell. STYLE-SPEC is an entry in `org-e-odt-table-styles'
+applicable to the current table. It is `nil' if the table is not
+associated with any style attributes.
+
+Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
+
+When STYLE-SPEC is nil, style the table cell the conventional way
+- choose cell borders based on row and column groupings and
+choose paragraph alignment based on `org-col-cookies' text
+property. See also
+`org-e-odt-get-paragraph-style-cookie-for-table-cell'.
+
+When STYLE-SPEC is non-nil, ignore the above cookie and return
+styles congruent with the ODF-1.2 specification."
+ (let* ((table-cell-address (org-export-table-cell-address table-cell info))
+ (r (car table-cell-address)) (c (cdr table-cell-address))
+ (style-spec (org-e-odt-table-style-spec table-cell info))
+ (table-dimensions (org-export-table-dimensions
+ (org-export-get-parent-table table-cell)
+ info)))
+ (when style-spec
+ ;; LibreOffice - particularly the Writer - honors neither table
+ ;; templates nor custom table-cell styles. Inorder to retain
+ ;; inter-operability with LibreOffice, only automatic styles are
+ ;; used for styling of table-cells. The current implementation is
+ ;; congruent with ODF-1.2 specification and hence is
+ ;; future-compatible.
+
+ ;; Additional Note: LibreOffice's AutoFormat facility for tables -
+ ;; which recognizes as many as 16 different cell types - is much
+ ;; richer. Unfortunately it is NOT amenable to easy configuration
+ ;; by hand.
+ (let* ((template-name (nth 1 style-spec))
+ (cell-style-selectors (nth 2 style-spec))
+ (cell-type
+ (cond
+ ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ (= c 0)) "FirstColumn")
+ ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ (= (1+ c) (cdr table-dimensions)))
+ "LastColumn")
+ ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ (= r 0)) "FirstRow")
+ ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ (= (1+ r) (car table-dimensions)))
+ "LastRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 1)) "EvenRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 0)) "OddRow")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 1)) "EvenColumn")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 0)) "OddColumn")
+ (t ""))))
+ (concat template-name cell-type)))))
+
+(defun org-e-odt-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((table-cell-address (org-export-table-cell-address table-cell info))
+ (r (car table-cell-address))
+ (c (cdr table-cell-address))
+ (horiz-span (or (org-export-table-cell-width table-cell info) 0))
+ (table-row (org-export-get-parent table-cell))
+ (custom-style-prefix (org-e-odt-get-table-cell-styles
+ table-cell info))
+ (paragraph-style
+ (or
+ (and custom-style-prefix
+ (format "%sTableParagraph" custom-style-prefix))
+ (concat
+ (cond
+ ((and (= 1 (org-export-table-row-group table-row info))
+ (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info))
+ "OrgTableHeading")
+ ((let* ((table (org-export-get-parent-table table-cell))
+ (table-attrs (org-export-read-attribute :attr_odt table))
+ (table-header-columns (plist-get table-attrs
+ :header-columns)))
+ (<= c (cond ((wholenump table-header-columns)
+ (- table-header-columns 1))
+ (table-header-columns 0)
+ (t -1))))
+ "OrgTableHeading")
+ (t "OrgTableContents"))
+ (capitalize (symbol-name (org-export-table-cell-alignment
+ table-cell info))))))
+ (cell-style-name
+ (or
+ (and custom-style-prefix (format "%sTableCell"
+ custom-style-prefix))
+ (concat
+ "OrgTblCell"
+ (when (or (org-export-table-row-starts-rowgroup-p table-row info)
+ (zerop r)) "T")
+ (when (org-export-table-row-ends-rowgroup-p table-row info) "B")
+ (when (and (org-export-table-cell-starts-colgroup-p table-cell info)
+ (not (zerop c)) ) "L"))))
+ (cell-attributes
+ (concat
+ (format " table:style-name=\"%s\"" cell-style-name)
+ (and (> horiz-span 0)
+ (format " table:number-columns-spanned=\"%d\""
+ (1+ horiz-span))))))
+ (unless contents (setq contents ""))
+ (concat
+ (assert paragraph-style)
+ (format "\n<table:table-cell%s>\n%s\n</table:table-cell>"
+ cell-attributes
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ paragraph-style contents))
+ (let (s)
+ (dotimes (i horiz-span s)
+ (setq s (concat s "\n<table:covered-table-cell/>"))))
+ "\n")))
+
+
+;;;; Table Row
+
+(defun org-e-odt-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to ODT.
+CONTENTS is the contents of the row. INFO is a plist used as a
+communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((rowgroup-tags
+ (if (and (= 1 (org-export-table-row-group table-row info))
+ (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info))
+ ;; If the row belongs to the first rowgroup and the
+ ;; table has more than one row groups, then this row
+ ;; belongs to the header row group.
+ '("\n<table:table-header-rows>" . "\n</table:table-header-rows>")
+ ;; Otherwise, it belongs to non-header row group.
+ '("\n<table:table-rows>" . "\n</table:table-rows>"))))
+ (concat
+ ;; Does this row begin a rowgroup?
+ (when (org-export-table-row-starts-rowgroup-p table-row info)
+ (car rowgroup-tags))
+ ;; Actual table row
+ (format "\n<table:table-row>\n%s\n</table:table-row>" contents)
+ ;; Does this row end a rowgroup?
+ (when (org-export-table-row-ends-rowgroup-p table-row info)
+ (cdr rowgroup-tags))))))
+
+
+;;;; Table
+
+(defun org-e-odt-table-first-row-data-cells (table info)
+ (let ((table-row
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule) row))
+ info 'first-match))
+ (special-column-p (org-export-table-has-special-column-p table)))
+ (if (not special-column-p) (org-element-contents table-row)
+ (cdr (org-element-contents table-row)))))
+
+(defun org-e-odt--table (table contents info)
+ "Transcode a TABLE element from Org to ODT.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (case (org-element-property :type table)
+ ;; Case 1: table.el doesn't support export to OD format. Strip
+ ;; such tables from export.
+ (table.el
+ (prog1 nil
+ (message
+ (concat
+ "(org-e-odt): Found table.el-type table in the source Org file."
+ " table.el doesn't support export to ODT format."
+ " Stripping the table from export."))))
+ ;; Case 2: Native Org tables.
+ (otherwise
+ (let* ((captions (org-e-odt-format-label table info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ (attributes (org-export-read-attribute :attr_odt table))
+ (custom-table-style (nth 1 (org-e-odt-table-style-spec table info)))
+ (table-column-specs
+ (function
+ (lambda (table info)
+ (let* ((table-style (or custom-table-style "OrgTable"))
+ (column-style (format "%sColumn" table-style)))
+ (mapconcat
+ (lambda (table-cell)
+ (let ((width (1+ (or (org-export-table-cell-width
+ table-cell info) 0)))
+ (s (format
+ "\n<table:table-column table:style-name=\"%s\"/>"
+ column-style))
+ out)
+ (dotimes (i width out) (setq out (concat s out)))))
+ (org-e-odt-table-first-row-data-cells table info) "\n"))))))
+ (concat
+ ;; caption.
+ (when caption
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Table" caption))
+ ;; begin table.
+ (let* ((automatic-name
+ (org-e-odt-add-automatic-style "Table" attributes)))
+ (format
+ "\n<table:table table:name=\"%s\" table:style-name=\"%s\">"
+ (or short-caption (car automatic-name))
+ (or custom-table-style (cdr automatic-name) "OrgTable")))
+ ;; column specification.
+ (funcall table-column-specs table info)
+ ;; actual contents.
+ "\n" contents
+ ;; end table.
+ "</table:table>")))))
+
+(defun org-e-odt-table (table contents info)
+ "Transcode a TABLE element from Org to ODT.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (let* ((--get-previous-elements
+ (function
+ (lambda (blob info)
+ (let ((parent (org-export-get-parent blob)))
+ (cdr (member blob (reverse (org-element-contents parent))))))))
+ (--element-preceded-by-table-p
+ (function
+ (lambda (element info)
+ (loop for el in (funcall --get-previous-elements element info)
+ thereis (eq (org-element-type el) 'table)))))
+ (--walk-list-genealogy-and-collect-tags
+ (function
+ (lambda (table info)
+ (let* ((genealogy (org-export-get-genealogy table))
+ (list-genealogy
+ (when (eq (org-element-type (car genealogy)) 'item)
+ (loop for el in genealogy
+ when (member (org-element-type el)
+ '(item plain-list))
+ collect el))))
+ (loop for el in list-genealogy
+ with parent-list collect
+ (case (org-element-type el)
+ (plain-list
+ (setq parent-list el)
+ `("</text:list>"
+ . ,(let ((type (org-element-property :type el)))
+ (format
+ "<text:list text:style-name=\"%s\" %s>"
+ (assoc-default
+ type '((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (descriptive . "OrgDescriptionList")))
+ "text:continue-numbering=\"true\""))))
+ (item
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((funcall --element-preceded-by-table-p
+ parent-list info)
+ '("</text:list-header>" . "<text:list-header>"))
+ (t '("</text:list-item>" . "<text:list-item>"))))))))))
+ (close-open-tags (funcall --walk-list-genealogy-and-collect-tags
+ table info)))
+ ;; OpenDocument schema does not permit table to occur within a
+ ;; list item. So, to typeset an indented table, we make use of
+ ;; list continuations.
+ (concat "\n"
+ ;; Discontinue the list.
+ (mapconcat 'car close-open-tags "\n")
+ ;; Put the table in an indented section.
+ (let* ((table (org-e-odt--table table contents info))
+ (level (/ (length (mapcar 'car close-open-tags)) 2))
+ (style (format "OrgIndentedSection-Level-%d" level)))
+ (when table (org-e-odt-format-section table style)))
+ ;; Continue the list.
+ (mapconcat 'cdr (nreverse close-open-tags) "\n"))))
+
+
+;;;; Target
+
+(defun org-e-odt-target (target contents info)
+ "Transcode a TARGET object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-e-odt-format-target
+ "" (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Timestamp
+
+(defun org-e-odt-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((timestamp-1 (org-element-property :value timestamp))
+ (timestamp-2 (org-element-property :range-end timestamp)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestampWrapper"
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp" (org-translate-time timestamp-1))
+ (and timestamp-2
+ "&#x2013;"
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTimestamp" (org-translate-time timestamp-2)))))))
+
+
+;;;; Underline
+
+(defun org-e-odt-underline (underline contents info)
+ "Transcode UNDERLINE from Org to ODT.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Underline" contents))
+
+
+;;;; Verbatim
+
+(defun org-e-odt-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-element-property :value verbatim)))
+
+
+;;;; Verse Block
+
+(defun org-e-odt-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to ODT.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ ;; Add line breaks to each line of verse.
+ (setq contents (replace-regexp-in-string
+ "\\(<text:line-break/>\\)?[ \t]*\n"
+ "<text:line-break/>" contents))
+ ;; Replace tabs and spaces.
+ (setq contents (org-e-odt-fill-tabs-and-spaces contents))
+ ;; Surround it in a verse environment.
+ (org-e-odt--wrap-label
+ verse-block
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgVerse" contents)))
+
+
+
+
+
+;;; Interactive functions
+
+(defun org-e-odt-create-manifest-file-entry (&rest args)
+ (push args org-e-odt-manifest-file-entries))
+
+(defun org-e-odt-write-manifest-file ()
+ (make-directory (concat org-e-odt-zip-dir "META-INF"))
+ (let ((manifest-file (concat org-e-odt-zip-dir "META-INF/manifest.xml")))
+ (with-current-buffer
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect manifest-file t))
+ (insert
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
+ (mapc
+ (lambda (file-entry)
+ (let* ((version (nth 2 file-entry))
+ (extra (if (not version) ""
+ (format " manifest:version=\"%s\"" version))))
+ (insert
+ (format org-e-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
+ org-e-odt-manifest-file-entries)
+ (insert "\n</manifest:manifest>"))))
+
+(defmacro org-e-odt--export-wrap (out-file &rest body)
+ `(let* ((--out-file ,out-file)
+ (out-file-type (file-name-extension --out-file))
+ (org-e-odt-xml-files '("META-INF/manifest.xml" "content.xml"
+ "meta.xml" "styles.xml"))
+ ;; Initialize workarea. All files that end up in the
+ ;; exported get created here.
+ (org-e-odt-zip-dir (file-name-as-directory
+ (make-temp-file (format "%s-" out-file-type) t)))
+ (org-e-odt-manifest-file-entries nil)
+ (--cleanup-xml-buffers
+ (function
+ (lambda nil
+ ;; Kill all XML buffers.
+ (mapc (lambda (file)
+ (let ((buf (get-file-buffer
+ (concat org-e-odt-zip-dir file))))
+ (when buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf))))
+ org-e-odt-xml-files)
+ ;; Delete temporary directory and also other embedded
+ ;; files that get copied there.
+ (delete-directory org-e-odt-zip-dir t)))))
+ (org-condition-case-unless-debug
+ err
+ (progn
+ (unless (executable-find "zip")
+ ;; Not at all OSes ship with zip by default
+ (error "Executable \"zip\" needed for creating OpenDocument files"))
+ ;; Do export. This creates a bunch of xml files ready to be
+ ;; saved and zipped.
+ (progn ,@body)
+ ;; Create a manifest entry for content.xml.
+ (org-e-odt-create-manifest-file-entry "text/xml" "content.xml")
+
+ ;; Write mimetype file
+ (let* ((mimetypes
+ '(("odt" . "application/vnd.oasis.opendocument.text")
+ ("odf" . "application/vnd.oasis.opendocument.formula")))
+ (mimetype (cdr (assoc-string out-file-type mimetypes t))))
+ (unless mimetype
+ (error "Unknown OpenDocument backend %S" out-file-type))
+ (write-region mimetype nil (concat org-e-odt-zip-dir "mimetype"))
+ (org-e-odt-create-manifest-file-entry mimetype "/" "1.2"))
+ ;; Write out the manifest entries before zipping
+ (org-e-odt-write-manifest-file)
+ ;; Save all XML files.
+ (mapc (lambda (file)
+ (let ((buf (get-file-buffer (concat org-e-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ ;; Prettify output if needed.
+ (when org-e-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))))
+ org-e-odt-xml-files)
+ ;; Run zip.
+ (let* ((target --out-file)
+ (target-name (file-name-nondirectory target))
+ (target-dir (file-name-directory target))
+ (cmds `(("zip" "-mX0" ,target-name "mimetype")
+ ("zip" "-rmTq" ,target-name "."))))
+ ;; If a file with same name as the desired output file
+ ;; exists, remove it.
+ (when (file-exists-p target)
+ (delete-file target))
+ ;; Zip up the xml files.
+ (let ((coding-system-for-write 'no-conversion) exitcode err-string)
+ (message "Creating ODT file...")
+ ;; Switch temporarily to content.xml. This way Zip
+ ;; process will inherit `org-e-odt-zip-dir' as the current
+ ;; directory.
+ (with-current-buffer
+ (find-file-noselect (concat org-e-odt-zip-dir "content.xml") t)
+ (mapc
+ (lambda (cmd)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (error (concat "Unable to create OpenDocument file."
+ (format " Zip failed with error (%s)"
+ err-string)))))
+ cmds)
+ ;; Zip file is now in the rightful place.
+ (rename-file target-name target)))
+ (message "Created %s" target)
+ ;; Cleanup work directory and work files.
+ (funcall --cleanup-xml-buffers)
+ ;; Open the OpenDocument file in archive-mode for
+ ;; examination.
+ (find-file-noselect target t)
+ ;; Return exported file.
+ (cond
+ ;; Case 1: Conversion desired on exported file. Run the
+ ;; converter on the OpenDocument file. Return the
+ ;; converted file.
+ (org-e-odt-preferred-output-format
+ (or (org-e-odt-convert target org-e-odt-preferred-output-format)
+ target))
+ ;; Case 2: No further conversion. Return exported
+ ;; OpenDocument file.
+ (t target))))
+ ((quit error)
+ ;; Cleanup work directory and work files.
+ (funcall --cleanup-xml-buffers)
+ (message "OpenDocument export failed: %s"
+ (error-message-string err))))))
+
+
+
+;;;###autoload
+(defun org-e-odt-export-as-odf (latex-frag &optional odf-file)
+ "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
+Use `org-create-math-formula' to convert LATEX-FRAG first to
+MathML. When invoked as an interactive command, use
+`org-latex-regexps' to infer LATEX-FRAG from currently active
+region. If no LaTeX fragments are found, prompt for it. Push
+MathML source to kill ring, if `org-export-copy-to-kill-ring' is
+non-nil."
+ (interactive
+ `(,(let (frag)
+ (setq frag (and (setq frag (and (region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
+ (read-string "LaTeX Fragment: " frag nil frag))
+ ,(let ((odf-filename (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (read-file-name "ODF filename: " nil odf-filename nil
+ (file-name-nondirectory odf-filename)))))
+ (let ((filename (or odf-file
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name)))))
+ (org-e-odt--export-wrap
+ filename
+ (let* ((buffer (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect (concat org-e-odt-zip-dir
+ "content.xml") t))))
+ (coding-system-for-write 'utf-8)
+ (save-buffer-coding-system 'utf-8))
+ (set-buffer buffer)
+ (set-buffer-file-coding-system coding-system-for-write)
+ (let ((mathml (org-create-math-formula latex-frag)))
+ (unless mathml (error "No Math formula created"))
+ (insert mathml)
+ ;; Add MathML to kill ring, if needed.
+ (when org-export-copy-to-kill-ring
+ (org-kill-new (buffer-string))))))))
+
+;;;###autoload
+(defun org-e-odt-export-as-odf-and-open ()
+ "Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-e-odt-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file."
+ (interactive)
+ (org-open-file (call-interactively 'org-e-odt-export-as-odf)))
+
+;;;###autoload
+(defun org-e-odt-export-to-odt
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a HTML file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (org-e-odt--export-wrap
+ (org-export-output-file-name ".odt" subtreep pub-dir)
+ (let* ((org-e-odt-embedded-images-count 0)
+ (org-e-odt-embedded-formulas-count 0)
+ (org-e-odt-automatic-styles nil)
+ (org-e-odt-object-counters nil)
+ ;; Let `htmlfontify' know that we are interested in collecting
+ ;; styles.
+ (hfy-user-sheet-assoc nil))
+ ;; Initialize content.xml and kick-off the export process.
+ (let ((out-buf (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect
+ (concat org-e-odt-zip-dir "content.xml") t)))))
+ (org-export-to-buffer 'e-odt out-buf subtreep visible-only body-only)))))
+
+
+
+
+(defun org-e-odt-reachable-p (in-fmt out-fmt)
+ "Return non-nil if IN-FMT can be converted to OUT-FMT."
+ (catch 'done
+ (let ((reachable-formats (org-e-odt-do-reachable-formats in-fmt)))
+ (dolist (e reachable-formats)
+ (let ((out-fmt-spec (assoc out-fmt (cdr e))))
+ (when out-fmt-spec
+ (throw 'done (cons (car e) out-fmt-spec))))))))
+
+(defun org-e-odt-do-convert (in-file out-fmt &optional prefix-arg)
+ "Workhorse routine for `org-e-odt-convert'."
+ (require 'browse-url)
+ (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
+ (dummy (or (file-readable-p in-file)
+ (error "Cannot read %s" in-file)))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt (or out-fmt (error "Output format unspecified")))
+ (how (or (org-e-odt-reachable-p in-fmt out-fmt)
+ (error "Cannot convert from %s format to %s format?"
+ in-fmt out-fmt)))
+ (convert-process (car how))
+ (out-file (concat (file-name-sans-extension in-file) "."
+ (nth 1 (or (cdr how) out-fmt))))
+ (extra-options (or (nth 2 (cdr how)) ""))
+ (out-dir (file-name-directory in-file))
+ (cmd (format-spec convert-process
+ `((?i . ,(shell-quote-argument in-file))
+ (?I . ,(browse-url-file-url in-file))
+ (?f . ,out-fmt)
+ (?o . ,out-file)
+ (?O . ,(browse-url-file-url out-file))
+ (?d . , (shell-quote-argument out-dir))
+ (?D . ,(browse-url-file-url out-dir))
+ (?x . ,extra-options)))))
+ (when (file-exists-p out-file)
+ (delete-file out-file))
+
+ (message "Executing %s" cmd)
+ (let ((cmd-output (shell-command-to-string cmd)))
+ (message "%s" cmd-output))
+
+ (cond
+ ((file-exists-p out-file)
+ (message "Exported to %s" out-file)
+ (when prefix-arg
+ (message "Opening %s..." out-file)
+ (org-open-file out-file))
+ out-file)
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defun org-e-odt-do-reachable-formats (in-fmt)
+ "Return verbose info about formats to which IN-FMT can be converted.
+Return a list where each element is of the
+form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
+`org-e-odt-convert-processes' for CONVERTER-PROCESS and see
+`org-e-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
+ (let* ((converter
+ (and org-e-odt-convert-process
+ (cadr (assoc-string org-e-odt-convert-process
+ org-e-odt-convert-processes t))))
+ (capabilities
+ (and org-e-odt-convert-process
+ (cadr (assoc-string org-e-odt-convert-process
+ org-e-odt-convert-processes t))
+ org-e-odt-convert-capabilities))
+ reachable-formats)
+ (when converter
+ (dolist (c capabilities)
+ (when (member in-fmt (nth 1 c))
+ (push (cons converter (nth 2 c)) reachable-formats))))
+ reachable-formats))
+
+(defun org-e-odt-reachable-formats (in-fmt)
+ "Return list of formats to which IN-FMT can be converted.
+The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
+ (let (l)
+ (mapc (lambda (e) (add-to-list 'l e))
+ (apply 'append (mapcar
+ (lambda (e) (mapcar 'car (cdr e)))
+ (org-e-odt-do-reachable-formats in-fmt))))
+ l))
+
+(defun org-e-odt-convert-read-params ()
+ "Return IN-FILE and OUT-FMT params for `org-e-odt-do-convert'.
+This is a helper routine for interactive use."
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (in-file (read-file-name "File to be converted: "
+ nil buffer-file-name t))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt-choices (org-e-odt-reachable-formats in-fmt))
+ (out-fmt
+ (or (and out-fmt-choices
+ (funcall input "Output format: "
+ out-fmt-choices nil nil nil))
+ (error
+ "No known converter or no known output formats for %s files"
+ in-fmt))))
+ (list in-file out-fmt)))
+
+;;;###autoload
+(defun org-e-odt-convert (&optional in-file out-fmt prefix-arg)
+ "Convert IN-FILE to format OUT-FMT using a command line converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. OUT-FMT is the desired output
+format. Use `org-e-odt-convert-process' as the converter.
+If PREFIX-ARG is non-nil then the newly converted file is opened
+using `org-open-file'."
+ (interactive
+ (append (org-e-odt-convert-read-params) current-prefix-arg))
+ (org-e-odt-do-convert in-file out-fmt prefix-arg))
+
+;;; Library Initializations
+
+(mapc
+ (lambda (desc)
+ ;; Let Org open all OpenDocument files using system-registered app
+ (add-to-list 'org-file-apps
+ (cons (concat "\\." (car desc) "\\'") 'system))
+ ;; Let Emacs open all OpenDocument files in archive mode
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
+ org-e-odt-file-extensions)
+
+(provide 'org-e-odt)
+
+;;; org-e-odt.el ends here
diff --git a/contrib/lisp/org-e-publish.el b/contrib/lisp/org-e-publish.el
new file mode 100644
index 0000000..894ee07
--- /dev/null
+++ b/contrib/lisp/org-e-publish.el
@@ -0,0 +1,1200 @@
+;;; org-e-publish.el --- publish related org-mode files as a website
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+;; Author: David O'Toole <dto@gnu.org>
+;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
+;; Keywords: hypermedia, outlines, wp
+
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This program allow configurable publishing of related sets of
+;; Org mode files as a complete website.
+;;
+;; org-e-publish.el can do the following:
+;;
+;; + Publish all one's Org files to HTML or PDF
+;; + Upload HTML, images, attachments and other files to a web server
+;; + Exclude selected private pages from publishing
+;; + Publish a clickable sitemap of pages
+;; + Manage local timestamps for publishing only changed files
+;; + Accept plugin functions to extend range of publishable content
+;;
+;; Documentation for publishing is in the manual.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'format-spec)
+(require 'org-export)
+
+(declare-function org-e-latex-compile "org-e-latex" (texfile))
+
+
+
+;;; Variables
+(defvar org-e-publish-initial-buffer nil
+ "The buffer `org-e-publish' has been called from.")
+
+(defvar org-e-publish-temp-files nil
+ "Temporary list of files to be published.")
+
+;; Here, so you find the variable right before it's used the first time:
+(defvar org-e-publish-cache nil
+ "This will cache timestamps and titles for files in publishing projects.
+Blocks could hash sha1 values here.")
+
+(defgroup org-e-publish nil
+ "Options for publishing a set of Org-mode and related files."
+ :tag "Org Publishing"
+ :group 'org)
+
+(defcustom org-e-publish-project-alist nil
+ "Association list to control publishing behavior.
+Each element of the alist is a publishing 'project.' The CAR of
+each element is a string, uniquely identifying the project. The
+CDR of each element is in one of the following forms:
+
+1. A well-formed property list with an even number of elements,
+ alternating keys and values, specifying parameters for the
+ publishing process.
+
+ \(:property value :property value ... )
+
+2. A meta-project definition, specifying of a list of
+ sub-projects:
+
+ \(:components \(\"project-1\" \"project-2\" ...))
+
+When the CDR of an element of org-e-publish-project-alist is in
+this second form, the elements of the list after `:components'
+are taken to be components of the project, which group together
+files requiring different publishing options. When you publish
+such a project with \\[org-e-publish], the components all
+publish.
+
+When a property is given a value in
+`org-e-publish-project-alist', its setting overrides the value of
+the corresponding user variable \(if any) during publishing.
+However, options set within a file override everything.
+
+Most properties are optional, but some should always be set:
+
+ `:base-directory'
+
+ Directory containing publishing source files.
+
+ `:base-extension'
+
+ Extension \(without the dot!) of source files. This can be
+ a regular expression. If not given, \"org\" will be used as
+ default extension.
+
+ `:publishing-directory'
+
+ Directory \(possibly remote) where output files will be
+ published.
+
+The `:exclude' property may be used to prevent certain files from
+being published. Its value may be a string or regexp matching
+file names you don't want to be published.
+
+The `:include' property may be used to include extra files. Its
+value may be a list of filenames to include. The filenames are
+considered relative to the base directory.
+
+When both `:include' and `:exclude' properties are given values,
+the exclusion step happens first.
+
+One special property controls which back-end function to use for
+publishing files in the project. This can be used to extend the
+set of file types publishable by `org-e-publish', as well as the
+set of output formats.
+
+ `:publishing-function'
+
+ Function to publish file. The default is
+ `org-e-publish-org-to-ascii', but other values are possible.
+ May also be a list of functions, in which case each function
+ in the list is invoked in turn.
+
+Another property allows you to insert code that prepares
+a project for publishing. For example, you could call GNU Make
+on a certain makefile, to ensure published files are built up to
+date.
+
+ `:preparation-function'
+
+ Function to be called before publishing this project. This
+ may also be a list of functions.
+
+ `:completion-function'
+
+ Function to be called after publishing this project. This
+ may also be a list of functions.
+
+Some properties control details of the Org publishing process,
+and are equivalent to the corresponding user variables listed in
+the right column. Back-end specific properties may also be
+included. See the back-end documentation for more information.
+
+ :author `user-full-name'
+ :creator `org-export-creator-string'
+ :email `user-mail-address'
+ :exclude-tags `org-export-exclude-tags'
+ :headline-levels `org-export-headline-levels'
+ :language `org-export-default-language'
+ :preserve-breaks `org-export-preserve-breaks'
+ :section-numbers `org-export-with-section-numbers'
+ :select-tags `org-export-select-tags'
+ :time-stamp-file `org-export-time-stamp-file'
+ :with-archived-trees `org-export-with-archived-trees'
+ :with-author `org-export-with-author'
+ :with-creator `org-export-with-creator'
+ :with-drawers `org-export-with-drawers'
+ :with-email `org-export-with-email'
+ :with-emphasize `org-export-with-emphasize'
+ :with-entities `org-export-with-entities'
+ :with-fixed-width `org-export-with-fixed-width'
+ :with-footnotes `org-export-with-footnotes'
+ :with-priority `org-export-with-priority'
+ :with-special-strings `org-export-with-special-strings'
+ :with-sub-superscript `org-export-with-sub-superscripts'
+ :with-toc `org-export-with-toc'
+ :with-tables `org-export-with-tables'
+ :with-tags `org-export-with-tags'
+ :with-tasks `org-export-with-tasks'
+ :with-timestamps `org-export-with-timestamps'
+ :with-todo-keywords `org-export-with-todo-keywords'
+
+The following properties may be used to control publishing of
+a site-map of files or summary page for a given project.
+
+ `:auto-sitemap'
+
+ Whether to publish a site-map during
+ `org-e-publish-current-project' or `org-e-publish-all'.
+
+ `:sitemap-filename'
+
+ Filename for output of sitemap. Defaults to \"sitemap.org\".
+
+ `:sitemap-title'
+
+ Title of site-map page. Defaults to name of file.
+
+ `:sitemap-function'
+
+ Plugin function to use for generation of site-map. Defaults to
+ `org-e-publish-org-sitemap', which generates a plain list of
+ links to all files in the project.
+
+ `:sitemap-style'
+
+ Can be `list' \(site-map is just an itemized list of the
+ titles of the files involved) or `tree' \(the directory
+ structure of the source files is reflected in the site-map).
+ Defaults to `tree'.
+
+ `:sitemap-sans-extension'
+
+ Remove extension from site-map's file-names. Useful to have
+ cool URIs \(see http://www.w3.org/Provider/Style/URI).
+ Defaults to nil.
+
+If you create a site-map file, adjust the sorting like this:
+
+ `:sitemap-sort-folders'
+
+ Where folders should appear in the site-map. Set this to
+ `first' \(default) or `last' to display folders first or
+ last, respectively. Any other value will mix files and
+ folders.
+
+ `:sitemap-sort-files'
+
+ The site map is normally sorted alphabetically. You can
+ change this behaviour setting this to `anti-chronologically',
+ `chronologically', or nil.
+
+ `:sitemap-ignore-case'
+
+ Should sorting be case-sensitive? Default nil.
+
+The following properties control the creation of a concept index.
+
+ `:makeindex'
+
+ Create a concept index.
+
+Other properties affecting publication.
+
+ `:body-only'
+
+ Set this to t to publish only the body of the documents."
+ :group 'org-e-publish
+ :type 'alist)
+
+(defcustom org-e-publish-use-timestamps-flag t
+ "Non-nil means use timestamp checking to publish only changed files.
+When nil, do no timestamp checking and always publish all files."
+ :group 'org-e-publish
+ :type 'boolean)
+
+(defcustom org-e-publish-timestamp-directory
+ (convert-standard-filename "~/.org-timestamps/")
+ "Name of directory in which to store publishing timestamps."
+ :group 'org-e-publish
+ :type 'directory)
+
+(defcustom org-e-publish-list-skipped-files t
+ "Non-nil means show message about files *not* published."
+ :group 'org-e-publish
+ :type 'boolean)
+
+(defcustom org-e-publish-sitemap-sort-files 'alphabetically
+ "Method to sort files in site-maps.
+Possible values are `alphabetically', `chronologically',
+`anti-chronologically' and nil.
+
+If `alphabetically', files will be sorted alphabetically. If
+`chronologically', files will be sorted with older modification
+time first. If `anti-chronologically', files will be sorted with
+newer modification time first. nil won't sort files.
+
+You can overwrite this default per project in your
+`org-e-publish-project-alist', using `:sitemap-sort-files'."
+ :group 'org-e-publish
+ :type 'symbol)
+
+(defcustom org-e-publish-sitemap-sort-folders 'first
+ "A symbol, denoting if folders are sorted first in sitemaps.
+Possible values are `first', `last', and nil.
+If `first', folders will be sorted before files.
+If `last', folders are sorted to the end after the files.
+Any other value will not mix files and folders.
+
+You can overwrite this default per project in your
+`org-e-publish-project-alist', using `:sitemap-sort-folders'."
+ :group 'org-e-publish
+ :type 'symbol)
+
+(defcustom org-e-publish-sitemap-sort-ignore-case nil
+ "Non-nil when site-map sorting should ignore case.
+
+You can overwrite this default per project in your
+`org-e-publish-project-alist', using `:sitemap-ignore-case'."
+ :group 'org-e-publish
+ :type 'boolean)
+
+(defcustom org-e-publish-sitemap-date-format "%Y-%m-%d"
+ "Format for `format-time-string' which is used to print a date
+in the sitemap."
+ :group 'org-e-publish
+ :type 'string)
+
+(defcustom org-e-publish-sitemap-file-entry-format "%t"
+ "Format string for site-map file entry.
+You could use brackets to delimit on what part the link will be.
+
+%t is the title.
+%a is the author.
+%d is the date formatted using `org-e-publish-sitemap-date-format'."
+ :group 'org-e-publish
+ :type 'string)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Timestamp-related functions
+
+(defun org-e-publish-timestamp-filename (filename &optional pub-dir pub-func)
+ "Return path to timestamp file for filename FILENAME."
+ (setq filename (concat filename "::" (or pub-dir "") "::"
+ (format "%s" (or pub-func ""))))
+ (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+
+(defun org-e-publish-needed-p
+ (filename &optional pub-dir pub-func true-pub-dir base-dir)
+ "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
+TRUE-PUB-DIR is where the file will truly end up. Currently we
+are not using this - maybe it can eventually be used to check if
+the file is present at the target location, and how old it is.
+Right now we cannot do this, because we do not know under what
+file name the file will be stored - the publishing function can
+still decide about that independently."
+ (let ((rtn (if (not org-e-publish-use-timestamps-flag) t
+ (org-e-publish-cache-file-needs-publishing
+ filename pub-dir pub-func base-dir))))
+ (if rtn (message "Publishing file %s using `%s'" filename pub-func)
+ (when org-e-publish-list-skipped-files
+ (message "Skipping unmodified file %s" filename)))
+ rtn))
+
+(defun org-e-publish-update-timestamp
+ (filename &optional pub-dir pub-func base-dir)
+ "Update publishing timestamp for file FILENAME.
+If there is no timestamp, create one."
+ (let ((key (org-e-publish-timestamp-filename filename pub-dir pub-func))
+ (stamp (org-e-publish-cache-ctime-of-src filename base-dir)))
+ (org-e-publish-cache-set key stamp)))
+
+(defun org-e-publish-remove-all-timestamps ()
+ "Remove all files in the timestamp directory."
+ (let ((dir org-e-publish-timestamp-directory)
+ files)
+ (when (and (file-exists-p dir) (file-directory-p dir))
+ (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (org-e-publish-reset-cache))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Getting project information out of `org-e-publish-project-alist'
+
+(defun org-e-publish-expand-projects (projects-alist)
+ "Expand projects in PROJECTS-ALIST.
+This splices all the components into the list."
+ (let ((rest projects-alist) rtn p components)
+ (while (setq p (pop rest))
+ (if (setq components (plist-get (cdr p) :components))
+ (setq rest (append
+ (mapcar (lambda (x) (assoc x org-e-publish-project-alist))
+ components)
+ rest))
+ (push p rtn)))
+ (nreverse (delete-dups (delq nil rtn)))))
+
+(defvar org-sitemap-sort-files)
+(defvar org-sitemap-sort-folders)
+(defvar org-sitemap-ignore-case)
+(defvar org-sitemap-requested)
+(defvar org-sitemap-date-format)
+(defvar org-sitemap-file-entry-format)
+(defun org-e-publish-compare-directory-files (a b)
+ "Predicate for `sort', that sorts folders and files for sitemap."
+ (let ((retval t))
+ (when (or org-sitemap-sort-files org-sitemap-sort-folders)
+ ;; First we sort files:
+ (when org-sitemap-sort-files
+ (case org-sitemap-sort-files
+ (alphabetically
+ (let* ((adir (file-directory-p a))
+ (aorg (and (string-match "\\.org$" a) (not adir)))
+ (bdir (file-directory-p b))
+ (borg (and (string-match "\\.org$" b) (not bdir)))
+ (A (if aorg (concat (file-name-directory a)
+ (org-e-publish-find-title a)) a))
+ (B (if borg (concat (file-name-directory b)
+ (org-e-publish-find-title b)) b)))
+ (setq retval (if org-sitemap-ignore-case
+ (not (string-lessp (upcase B) (upcase A)))
+ (not (string-lessp B A))))))
+ ((anti-chronologically chronologically)
+ (let* ((adate (org-e-publish-find-date a))
+ (bdate (org-e-publish-find-date b))
+ (A (+ (lsh (car adate) 16) (cadr adate)))
+ (B (+ (lsh (car bdate) 16) (cadr bdate))))
+ (setq retval
+ (if (eq org-sitemap-sort-files 'chronologically) (<= A B)
+ (>= A B)))))))
+ ;; Directory-wise wins:
+ (when org-sitemap-sort-folders
+ ;; a is directory, b not:
+ (cond
+ ((and (file-directory-p a) (not (file-directory-p b)))
+ (setq retval (equal org-sitemap-sort-folders 'first)))
+ ;; a is not a directory, but b is:
+ ((and (not (file-directory-p a)) (file-directory-p b))
+ (setq retval (equal org-sitemap-sort-folders 'last))))))
+ retval))
+
+(defun org-e-publish-get-base-files-1
+ (base-dir &optional recurse match skip-file skip-dir)
+ "Set `org-e-publish-temp-files' with files from BASE-DIR directory.
+If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
+non-nil, restrict this list to the files matching the regexp
+MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
+SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
+matching the regexp SKIP-DIR when recursing through BASE-DIR."
+ (mapc (lambda (f)
+ (let ((fd-p (file-directory-p f))
+ (fnd (file-name-nondirectory f)))
+ (if (and fd-p recurse
+ (not (string-match "^\\.+$" fnd))
+ (if skip-dir (not (string-match skip-dir fnd)) t))
+ (org-e-publish-get-base-files-1
+ f recurse match skip-file skip-dir)
+ (unless (or fd-p ;; this is a directory
+ (and skip-file (string-match skip-file fnd))
+ (not (file-exists-p (file-truename f)))
+ (not (string-match match fnd)))
+
+ (pushnew f org-e-publish-temp-files)))))
+ (if org-sitemap-requested
+ (sort (directory-files base-dir t (unless recurse match))
+ 'org-e-publish-compare-directory-files)
+ (directory-files base-dir t (unless recurse match)))))
+
+(defun org-e-publish-get-base-files (project &optional exclude-regexp)
+ "Return a list of all files in PROJECT.
+If EXCLUDE-REGEXP is set, this will be used to filter out
+matching filenames."
+ (let* ((project-plist (cdr project))
+ (base-dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (include-list (plist-get project-plist :include))
+ (recurse (plist-get project-plist :recursive))
+ (extension (or (plist-get project-plist :base-extension) "org"))
+ ;; sitemap-... variables are dynamically scoped for
+ ;; org-e-publish-compare-directory-files:
+ (org-sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-filename
+ (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
+ (org-sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-e-publish-sitemap-sort-folders))
+ (org-sitemap-sort-files
+ (cond ((plist-member project-plist :sitemap-sort-files)
+ (plist-get project-plist :sitemap-sort-files))
+ ;; For backward compatibility:
+ ((plist-member project-plist :sitemap-alphabetically)
+ (if (plist-get project-plist :sitemap-alphabetically)
+ 'alphabetically nil))
+ (t org-e-publish-sitemap-sort-files)))
+ (org-sitemap-ignore-case
+ (if (plist-member project-plist :sitemap-ignore-case)
+ (plist-get project-plist :sitemap-ignore-case)
+ org-e-publish-sitemap-sort-ignore-case))
+ (match (if (eq extension 'any) "^[^\\.]"
+ (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
+ ;; Make sure `org-sitemap-sort-folders' has an accepted value
+ (unless (memq org-sitemap-sort-folders '(first last))
+ (setq org-sitemap-sort-folders nil))
+
+ (setq org-e-publish-temp-files nil)
+ (if org-sitemap-requested
+ (pushnew (expand-file-name (concat base-dir sitemap-filename))
+ org-e-publish-temp-files))
+ (org-e-publish-get-base-files-1 base-dir recurse match
+ ;; FIXME distinguish exclude regexp
+ ;; for skip-file and skip-dir?
+ exclude-regexp exclude-regexp)
+ (mapc (lambda (f)
+ (pushnew
+ (expand-file-name (concat base-dir f))
+ org-e-publish-temp-files))
+ include-list)
+ org-e-publish-temp-files))
+
+(defun org-e-publish-get-project-from-filename (filename &optional up)
+ "Return the project that FILENAME belongs to."
+ (let* ((filename (expand-file-name filename))
+ project-name)
+
+ (catch 'p-found
+ (dolist (prj org-e-publish-project-alist)
+ (unless (plist-get (cdr prj) :components)
+ ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+ (let* ((r (plist-get (cdr prj) :recursive))
+ (b (expand-file-name (file-name-as-directory
+ (plist-get (cdr prj) :base-directory))))
+ (x (or (plist-get (cdr prj) :base-extension) "org"))
+ (e (plist-get (cdr prj) :exclude))
+ (i (plist-get (cdr prj) :include))
+ (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+ (when
+ (or (and i
+ (member filename
+ (mapcar (lambda (file)
+ (expand-file-name file b))
+ i)))
+ (and (not (and e (string-match e filename)))
+ (string-match xm filename)))
+ (setq project-name (car prj))
+ (throw 'p-found project-name))))))
+ (when up
+ (dolist (prj org-e-publish-project-alist)
+ (if (member project-name (plist-get (cdr prj) :components))
+ (setq project-name (car prj)))))
+ (assoc project-name org-e-publish-project-alist)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Pluggable publishing back-end functions
+
+(defun org-e-publish-org-to (backend filename extension plist pub-dir)
+ "Publish an Org file to a specified back-end.
+
+BACKEND is a symbol representing the back-end used for
+transcoding. FILENAME is the filename of the Org file to be
+published. EXTENSION is the extension used for the output
+string, with the leading dot. PLIST is the property list for the
+given project. PUB-DIR is the publishing directory.
+
+Return output file name."
+ (unless (file-exists-p pub-dir) (make-directory pub-dir t))
+ ;; Check if a buffer visiting FILENAME is already open.
+ (let* ((visitingp (find-buffer-visiting filename))
+ (work-buffer (or visitingp (find-file-noselect filename))))
+ (prog1 (with-current-buffer work-buffer
+ (let ((output-file
+ (org-export-output-file-name extension nil pub-dir))
+ (body-p (plist-get plist :body-only)))
+ (org-export-to-file
+ backend output-file nil nil body-p
+ ;; Install `org-e-publish-collect-index' in parse tree
+ ;; filters. It isn't dependent on `:makeindex', since
+ ;; we want to keep it up-to-date in cache anyway.
+ (org-combine-plists
+ plist `(:filter-parse-tree
+ (org-e-publish-collect-index
+ ,@(plist-get plist :filter-parse-tree)))))))
+ ;; Remove opened buffer in the process.
+ (unless visitingp (kill-buffer work-buffer)))))
+
+(defvar project-plist)
+(defun org-e-publish-org-to-latex (plist filename pub-dir)
+ "Publish an Org file to LaTeX.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-publish-org-to 'e-latex filename ".tex" plist pub-dir))
+
+(defun org-e-publish-org-to-pdf (plist filename pub-dir)
+ "Publish an Org file to PDF \(via LaTeX).
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-latex-compile
+ (org-e-publish-org-to 'e-latex filename ".tex" plist pub-dir)))
+
+(defun org-e-publish-org-to-html (plist filename pub-dir)
+ "Publish an org file to HTML.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-publish-org-to 'e-html filename ".html" plist pub-dir))
+
+;; TODO: Not implemented yet.
+;; (defun org-e-publish-org-to-org (plist filename pub-dir)
+;; "Publish an org file to HTML.
+;;
+;; FILENAME is the filename of the Org file to be published. PLIST
+;; is the property list for the given project. PUB-DIR is the
+;; publishing directory.
+;;
+;; Return output file name."
+;; (org-e-publish-org-to "org" plist filename pub-dir))
+
+(defun org-e-publish-org-to-ascii (plist filename pub-dir)
+ "Publish an Org file to ASCII.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-publish-org-to
+ 'e-ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir))
+
+(defun org-e-publish-org-to-latin1 (plist filename pub-dir)
+ "Publish an Org file to Latin-1.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-publish-org-to
+ 'e-ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir))
+
+(defun org-e-publish-org-to-utf8 (plist filename pub-dir)
+ "Publish an org file to UTF-8.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-e-publish-org-to
+ 'e-ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir))
+
+(defun org-e-publish-attachment (plist filename pub-dir)
+ "Publish a file with no transformation of any kind.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (unless (file-directory-p pub-dir)
+ (make-directory pub-dir t))
+ (or (equal (expand-file-name (file-name-directory filename))
+ (file-name-as-directory (expand-file-name pub-dir)))
+ (copy-file filename
+ (expand-file-name (file-name-nondirectory filename) pub-dir)
+ t)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Publishing files, sets of files, and indices
+
+(defun org-e-publish-file (filename &optional project no-cache)
+ "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-e-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-e-publish-projects'."
+ (let* ((project
+ (or project
+ (or (org-e-publish-get-project-from-filename filename)
+ (error "File %s not part of any known project"
+ (abbreviate-file-name filename)))))
+ (project-plist (cdr project))
+ (ftname (expand-file-name filename))
+ (publishing-function
+ (or (plist-get project-plist :publishing-function)
+ 'org-e-publish-org-to-ascii))
+ (base-dir
+ (file-name-as-directory
+ (expand-file-name
+ (or (plist-get project-plist :base-directory)
+ (error "Project %s does not have :base-directory defined"
+ (car project))))))
+ (pub-dir
+ (file-name-as-directory
+ (file-truename
+ (or (eval (plist-get project-plist :publishing-directory))
+ (error "Project %s does not have :publishing-directory defined"
+ (car project))))))
+ tmp-pub-dir)
+
+ (unless no-cache (org-e-publish-initialize-cache (car project)))
+
+ (setq tmp-pub-dir
+ (file-name-directory
+ (concat pub-dir
+ (and (string-match (regexp-quote base-dir) ftname)
+ (substring ftname (match-end 0))))))
+ (if (listp publishing-function)
+ ;; allow chain of publishing functions
+ (mapc (lambda (f)
+ (when (org-e-publish-needed-p
+ filename pub-dir f tmp-pub-dir base-dir)
+ (funcall f project-plist filename tmp-pub-dir)
+ (org-e-publish-update-timestamp filename pub-dir f base-dir)))
+ publishing-function)
+ (when (org-e-publish-needed-p
+ filename pub-dir publishing-function tmp-pub-dir base-dir)
+ (funcall publishing-function project-plist filename tmp-pub-dir)
+ (org-e-publish-update-timestamp
+ filename pub-dir publishing-function base-dir)))
+ (unless no-cache (org-e-publish-write-cache-file))))
+
+(defun org-e-publish-projects (projects)
+ "Publish all files belonging to the PROJECTS alist.
+If `:auto-sitemap' is set, publish the sitemap too. If
+`:makeindex' is set, also produce a file theindex.org."
+ (mapc
+ (lambda (project)
+ ;; Each project uses its own cache file:
+ (org-e-publish-initialize-cache (car project))
+ (let* ((project-plist (cdr project))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (sitemap-p (plist-get project-plist :auto-sitemap))
+ (sitemap-filename (or (plist-get project-plist :sitemap-filename)
+ "sitemap.org"))
+ (sitemap-function (or (plist-get project-plist :sitemap-function)
+ 'org-e-publish-org-sitemap))
+ (org-sitemap-date-format
+ (or (plist-get project-plist :sitemap-date-format)
+ org-e-publish-sitemap-date-format))
+ (org-sitemap-file-entry-format
+ (or (plist-get project-plist :sitemap-file-entry-format)
+ org-e-publish-sitemap-file-entry-format))
+ (preparation-function
+ (plist-get project-plist :preparation-function))
+ (completion-function (plist-get project-plist :completion-function))
+ (files (org-e-publish-get-base-files project exclude-regexp)) file)
+ (when preparation-function (run-hooks 'preparation-function))
+ (if sitemap-p (funcall sitemap-function project sitemap-filename))
+ (dolist (file files) (org-e-publish-file file project t))
+ (when (plist-get project-plist :makeindex)
+ (org-e-publish-index-generate-theindex
+ project (plist-get project-plist :base-directory))
+ (org-e-publish-file
+ (expand-file-name
+ "theindex.org" (plist-get project-plist :base-directory))
+ project t))
+ (when completion-function (run-hooks 'completion-function))
+ (org-e-publish-write-cache-file)))
+ (org-e-publish-expand-projects projects)))
+
+(defun org-e-publish-org-sitemap (project &optional sitemap-filename)
+ "Create a sitemap of pages in set defined by PROJECT.
+Optionally set the filename of the sitemap with SITEMAP-FILENAME.
+Default for SITEMAP-FILENAME is 'sitemap.org'."
+ (let* ((project-plist (cdr project))
+ (dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (localdir (file-name-directory dir))
+ (indent-str (make-string 2 ?\ ))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (files (nreverse
+ (org-e-publish-get-base-files project exclude-regexp)))
+ (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
+ (sitemap-title (or (plist-get project-plist :sitemap-title)
+ (concat "Sitemap for project " (car project))))
+ (sitemap-style (or (plist-get project-plist :sitemap-style)
+ 'tree))
+ (sitemap-sans-extension
+ (plist-get project-plist :sitemap-sans-extension))
+ (visiting (find-buffer-visiting sitemap-filename))
+ (ifn (file-name-nondirectory sitemap-filename))
+ file sitemap-buffer)
+ (with-current-buffer (setq sitemap-buffer
+ (or visiting (find-file sitemap-filename)))
+ (erase-buffer)
+ (insert (concat "#+TITLE: " sitemap-title "\n\n"))
+ (while (setq file (pop files))
+ (let ((fn (file-name-nondirectory file))
+ (link (file-relative-name file dir))
+ (oldlocal localdir))
+ (when sitemap-sans-extension
+ (setq link (file-name-sans-extension link)))
+ ;; sitemap shouldn't list itself
+ (unless (equal (file-truename sitemap-filename)
+ (file-truename file))
+ (if (eq sitemap-style 'list)
+ (message "Generating list-style sitemap for %s" sitemap-title)
+ (message "Generating tree-style sitemap for %s" sitemap-title)
+ (setq localdir (concat (file-name-as-directory dir)
+ (file-name-directory link)))
+ (unless (string= localdir oldlocal)
+ (if (string= localdir dir)
+ (setq indent-str (make-string 2 ?\ ))
+ (let ((subdirs
+ (split-string
+ (directory-file-name
+ (file-name-directory
+ (file-relative-name localdir dir))) "/"))
+ (subdir "")
+ (old-subdirs (split-string
+ (file-relative-name oldlocal dir) "/")))
+ (setq indent-str (make-string 2 ?\ ))
+ (while (string= (car old-subdirs) (car subdirs))
+ (setq indent-str (concat indent-str (make-string 2 ?\ )))
+ (pop old-subdirs)
+ (pop subdirs))
+ (dolist (d subdirs)
+ (setq subdir (concat subdir d "/"))
+ (insert (concat indent-str " + " d "\n"))
+ (setq indent-str (make-string
+ (+ (length indent-str) 2) ?\ )))))))
+ ;; This is common to 'flat and 'tree
+ (let ((entry
+ (org-e-publish-format-file-entry
+ org-sitemap-file-entry-format file project-plist))
+ (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
+ (cond ((string-match-p regexp entry)
+ (string-match regexp entry)
+ (insert (concat indent-str " + " (match-string 1 entry)
+ "[[file:" link "]["
+ (match-string 2 entry)
+ "]]" (match-string 3 entry) "\n")))
+ (t
+ (insert (concat indent-str " + [[file:" link "]["
+ entry
+ "]]\n"))))))))
+ (save-buffer))
+ (or visiting (kill-buffer sitemap-buffer))))
+
+(defun org-e-publish-format-file-entry (fmt file project-plist)
+ (format-spec fmt
+ `((?t . ,(org-e-publish-find-title file t))
+ (?d . ,(format-time-string org-sitemap-date-format
+ (org-e-publish-find-date file)))
+ (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+
+(defun org-e-publish-find-title (file &optional reset)
+ "Find the title of FILE in project."
+ (or
+ (and (not reset) (org-e-publish-cache-get-file-property file :title nil t))
+ (let* ((visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file)))
+ title)
+ (with-current-buffer buffer
+ (org-mode)
+ (setq title
+ (or (plist-get (org-export-get-environment) :title)
+ (file-name-nondirectory (file-name-sans-extension file)))))
+ (unless visiting (kill-buffer buffer))
+ (org-e-publish-cache-set-file-property file :title title)
+ title)))
+
+(defun org-e-publish-find-date (file)
+ "Find the date of FILE in project.
+If FILE provides a #+date keyword use it else use the file
+system's modification time.
+
+It returns time in `current-time' format."
+ (let* ((visiting (find-buffer-visiting file))
+ (file-buf (or visiting (find-file-noselect file nil)))
+ (date (plist-get
+ (with-current-buffer file-buf
+ (org-mode)
+ (org-export--get-inbuffer-options))
+ :date)))
+ (unless visiting (kill-buffer file-buf))
+ (if date (org-time-string-to-time date)
+ (when (file-exists-p file)
+ (nth 5 (file-attributes file))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive publishing functions
+
+;;;###autoload
+(defalias 'org-e-publish-project 'org-e-publish)
+
+;;;###autoload
+(defun org-e-publish (project &optional force)
+ "Publish PROJECT."
+ (interactive
+ (list
+ (assoc (org-icompleting-read
+ "Publish project: "
+ org-e-publish-project-alist nil t)
+ org-e-publish-project-alist)
+ current-prefix-arg))
+ (setq org-e-publish-initial-buffer (current-buffer))
+ (save-window-excursion
+ (let* ((org-e-publish-use-timestamps-flag
+ (if force nil org-e-publish-use-timestamps-flag)))
+ (org-e-publish-projects
+ (if (stringp project)
+ ;; If this function is called in batch mode, project is
+ ;; still a string here.
+ (list (assoc project org-e-publish-project-alist))
+ (list project))))))
+
+;;;###autoload
+(defun org-e-publish-all (&optional force)
+ "Publish all projects.
+With prefix argument, remove all files in the timestamp
+directory and force publishing all files."
+ (interactive "P")
+ (when force (org-e-publish-remove-all-timestamps))
+ (save-window-excursion
+ (let ((org-e-publish-use-timestamps-flag
+ (if force nil org-e-publish-use-timestamps-flag)))
+ (org-e-publish-projects org-e-publish-project-alist))))
+
+
+;;;###autoload
+(defun org-e-publish-current-file (&optional force)
+ "Publish the current file.
+With prefix argument, force publish the file."
+ (interactive "P")
+ (save-window-excursion
+ (let ((org-e-publish-use-timestamps-flag
+ (if force nil org-e-publish-use-timestamps-flag)))
+ (org-e-publish-file (buffer-file-name (buffer-base-buffer))))))
+
+;;;###autoload
+(defun org-e-publish-current-project (&optional force)
+ "Publish the project associated with the current file.
+With a prefix argument, force publishing of all files in
+the project."
+ (interactive "P")
+ (save-window-excursion
+ (let ((project (org-e-publish-get-project-from-filename
+ (buffer-file-name (buffer-base-buffer)) 'up))
+ (org-e-publish-use-timestamps-flag
+ (if force nil org-e-publish-use-timestamps-flag)))
+ (if project (org-e-publish project)
+ (error "File %s is not part of any known project"
+ (buffer-file-name (buffer-base-buffer)))))))
+
+
+
+;;; Index generation
+
+(defun org-e-publish-collect-index (tree backend info)
+ "Update index for a file with TREE in cache.
+
+BACKEND is the back-end being used for transcoding. INFO is
+a plist containing publishing options.
+
+The index relative to current file is stored as an alist. An
+association has the following shape: \(TERM FILE-NAME PARENT),
+where TERM is the indexed term, as a string, FILE-NAME is the
+original full path of the file where the term in encountered, and
+PARENT is the headline element containing the original index
+keyword."
+ (org-e-publish-cache-set-file-property
+ (plist-get info :input-file) :index
+ (delete-dups
+ (org-element-map
+ tree 'keyword
+ (lambda (k)
+ (when (string= (downcase (org-element-property :key k))
+ "index")
+ (let ((index (org-element-property :value k))
+ (parent (org-export-get-parent-headline k)))
+ (list index (plist-get info :input-file) parent))))
+ info)))
+ ;; Return parse-tree to avoid altering output.
+ tree)
+
+(defun org-e-publish-index-generate-theindex (project directory)
+ "Retrieve full index from cache and build \"theindex.org\".
+PROJECT is the project the index relates to. DIRECTORY is the
+publishing directory."
+ (let ((all-files (org-e-publish-get-base-files
+ project (plist-get (cdr project) :exclude)))
+ full-index)
+ ;; Compile full index.
+ (mapc
+ (lambda (file)
+ (let ((index (org-e-publish-cache-get-file-property file :index)))
+ (dolist (term index)
+ (unless (member term full-index) (push term full-index)))))
+ all-files)
+ ;; Sort it alphabetically.
+ (setq full-index
+ (sort full-index (lambda (a b) (string< (downcase (car a))
+ (downcase (car b))))))
+ ;; Fill "theindex.org".
+ (with-temp-buffer
+ (insert "#+TITLE: Index\n#+OPTIONS: num:nil author:nil\n")
+ (let ((current-letter nil) (last-entry nil))
+ (dolist (idx full-index)
+ (let* ((entry (org-split-string (car idx) "!"))
+ (letter (upcase (substring (car entry) 0 1)))
+ ;; Transform file into a path relative to publishing
+ ;; directory.
+ (file (file-relative-name
+ (nth 1 idx)
+ (plist-get (cdr project) :base-directory))))
+ ;; Check if another letter has to be inserted.
+ (unless (string= letter current-letter)
+ (insert (format "* %s\n" letter)))
+ ;; Compute the first difference between last entry and
+ ;; current one: it tells the level at which new items
+ ;; should be added.
+ (let* ((rank (loop for n from 0 to (length entry)
+ unless (equal (nth n entry) (nth n last-entry))
+ return n))
+ (len (length (nthcdr rank entry))))
+ ;; For each term after the first difference, create
+ ;; a new sub-list with the term as body. Moreover,
+ ;; linkify the last term.
+ (dotimes (n len)
+ (insert
+ (concat
+ (make-string (* (+ rank n) 2) ? ) " - "
+ (if (not (= (1- len) n)) (nth (+ rank n) entry)
+ ;; Last term: Link it to TARGET, if possible.
+ (let ((target (nth 2 idx)))
+ (format
+ "[[%s][%s]]"
+ ;; Destination.
+ (cond
+ ((not target) (format "file:%s" file))
+ ((let ((id (org-element-property :id target)))
+ (and id (format "id:%s" id))))
+ ((let ((id (org-element-property :custom-id target)))
+ (and id (format "file:%s::#%s" file id))))
+ (t (format "file:%s::*%s" file
+ (org-element-property :raw-value target))))
+ ;; Description.
+ (car (last entry)))))
+ "\n"))))
+ (setq current-letter letter last-entry entry))))
+ ;; Write index.
+ (write-file (expand-file-name "theindex.org" directory)))))
+
+
+
+;;; Caching functions
+
+(defun org-e-publish-write-cache-file (&optional free-cache)
+ "Write `org-e-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (unless org-e-publish-cache
+ (error "`org-e-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-e-publish-cache-get ":cache-file:")))
+ (unless cache-file
+ (error "Cannot find cache-file name in `org-e-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let (print-level print-length)
+ (insert "(setq org-e-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
+ (maphash (lambda (k v)
+ (insert
+ (format (concat "(puthash %S "
+ (if (or (listp v) (symbolp v))
+ "'" "")
+ "%S org-e-publish-cache)\n") k v)))
+ org-e-publish-cache)))
+ (when free-cache (org-e-publish-reset-cache))))
+
+(defun org-e-publish-initialize-cache (project-name)
+ "Initialize the projects cache if not initialized yet and return it."
+
+ (unless project-name
+ (error "Cannot initialize `org-e-publish-cache' without projects name in `org-e-publish-initialize-cache'"))
+
+ (unless (file-exists-p org-e-publish-timestamp-directory)
+ (make-directory org-e-publish-timestamp-directory t))
+ (unless (file-directory-p org-e-publish-timestamp-directory)
+ (error "Org publish timestamp: %s is not a directory"
+ org-e-publish-timestamp-directory))
+
+ (unless (and org-e-publish-cache
+ (string= (org-e-publish-cache-get ":project:") project-name))
+ (let* ((cache-file
+ (concat
+ (expand-file-name org-e-publish-timestamp-directory)
+ project-name ".cache"))
+ (cexists (file-exists-p cache-file)))
+
+ (when org-e-publish-cache (org-e-publish-reset-cache))
+
+ (if cexists (load-file cache-file)
+ (setq org-e-publish-cache
+ (make-hash-table :test 'equal :weakness nil :size 100))
+ (org-e-publish-cache-set ":project:" project-name)
+ (org-e-publish-cache-set ":cache-file:" cache-file))
+ (unless cexists (org-e-publish-write-cache-file nil))))
+ org-e-publish-cache)
+
+(defun org-e-publish-reset-cache ()
+ "Empty org-e-publish-cache and reset it nil."
+ (message "%s" "Resetting org-e-publish-cache")
+ (when (hash-table-p org-e-publish-cache)
+ (clrhash org-e-publish-cache))
+ (setq org-e-publish-cache nil))
+
+(defun org-e-publish-cache-file-needs-publishing
+ (filename &optional pub-dir pub-func base-dir)
+ "Check the timestamp of the last publishing of FILENAME.
+Non-nil if the file needs publishing. The function also checks
+if any included files have been more recently published, so that
+the file including them will be republished as well."
+ (unless org-e-publish-cache
+ (error
+ "`org-e-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((case-fold-search t)
+ (key (org-e-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-e-publish-cache-get key))
+ (visiting (find-buffer-visiting filename))
+ included-files-ctime buf)
+
+ (when (equal (file-name-extension filename) "org")
+ (setq buf (find-file (expand-file-name filename)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
+ (let* ((included-file (expand-file-name (match-string 1))))
+ (add-to-list
+ 'included-files-ctime
+ (org-e-publish-cache-ctime-of-src included-file base-dir)
+ t))))
+ ;; FIXME: don't kill current buffer.
+ (unless visiting (kill-buffer buf)))
+ (if (null pstamp) t
+ (let ((ctime (org-e-publish-cache-ctime-of-src filename base-dir)))
+ (or (< pstamp ctime)
+ (when included-files-ctime
+ (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
+ included-files-ctime))))))))))
+
+(defun org-e-publish-cache-set-file-property
+ (filename property value &optional project-name)
+ "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
+Use cache file of PROJECT-NAME. If the entry does not exist, it
+will be created. Return VALUE."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-e-publish-initialize-cache project-name))
+ (let ((pl (org-e-publish-cache-get filename)))
+ (if pl (progn (plist-put pl property value) value)
+ (org-e-publish-cache-get-file-property
+ filename property value nil project-name))))
+
+(defun org-e-publish-cache-get-file-property
+ (filename property &optional default no-create project-name)
+ "Return the value for a PROPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY
+or DEFAULT, if the value does not yet exist. If the entry will
+be created, unless NO-CREATE is not nil."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-e-publish-initialize-cache project-name))
+ (let ((pl (org-e-publish-cache-get filename)) retval)
+ (if pl
+ (if (plist-member pl property)
+ (setq retval (plist-get pl property))
+ (setq retval default))
+ ;; no pl yet:
+ (unless no-create
+ (org-e-publish-cache-set filename (list property default)))
+ (setq retval default))
+ retval))
+
+(defun org-e-publish-cache-get (key)
+ "Return the value stored in `org-e-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+ (unless org-e-publish-cache
+ (error "`org-e-publish-cache-get' called, but no cache present"))
+ (gethash key org-e-publish-cache))
+
+(defun org-e-publish-cache-set (key value)
+ "Store KEY VALUE pair in `org-e-publish-cache'.
+Returns value on success, else nil."
+ (unless org-e-publish-cache
+ (error "`org-e-publish-cache-set' called, but no cache present"))
+ (puthash key value org-e-publish-cache))
+
+(defun org-e-publish-cache-ctime-of-src (f base-dir)
+ "Get the FILENAME ctime as an integer."
+ (let ((attr (file-attributes
+ (expand-file-name (or (file-symlink-p f) f) base-dir))))
+ (+ (lsh (car (nth 5 attr)) 16)
+ (cadr (nth 5 attr)))))
+
+
+(provide 'org-e-publish)
+
+;;; org-e-publish.el ends here
diff --git a/contrib/lisp/org-e-texinfo.el b/contrib/lisp/org-e-texinfo.el
new file mode 100644
index 0000000..a19139f
--- /dev/null
+++ b/contrib/lisp/org-e-texinfo.el
@@ -0,0 +1,1844 @@
+;;; org-e-texinfo.el --- Texinfo Back-End For Org Export Engine
+
+;; Copyright (C) 2012 Jonathan Leech-Pepin
+;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;;
+;; 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 library implements a Texinfo back-end for Org generic
+;; exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'e-texinfo "*Test e-texinfo*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the Texinfo
+;; export. See contrib/lisp/org-export.el for more details on how
+;; this exporter works.
+;;
+;; It introduces eight new buffer keywords: "TEXINFO_CLASS",
+;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_DIR_CATEGORY",
+;; "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC" "SUBTITLE" and "SUBAUTHOR".
+;;
+;; To include inline code snippets (for example for generating @kbd{}
+;; and @key{} commands), the following export-snippet keys are
+;; accepted:
+;;
+;; info
+;; e-info
+;; e-texinfo
+;;
+;; You can add them for export snippets via any of the below:
+;;
+;; (add-to-list 'org-export-snippet-translation-alist
+;; '("e-info" . "e-texinfo"))
+;; (add-to-list 'org-export-snippet-translation-alist
+;; '("e-texinfo" . "e-texinfo"))
+;; (add-to-list 'org-export-snippet-translation-alist
+;; '("info" . "e-texinfo"))
+;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-export)
+
+(defvar orgtbl-exp-regexp)
+
+
+;;; Define Back-End
+
+(defvar org-e-texinfo-translate-alist
+ '((babel-call . org-e-texinfo-babel-call)
+ (bold . org-e-texinfo-bold)
+ (center-block . org-e-texinfo-center-block)
+ (clock . org-e-texinfo-clock)
+ (code . org-e-texinfo-code)
+ (comment . org-e-texinfo-comment)
+ (comment-block . org-e-texinfo-comment-block)
+ (drawer . org-e-texinfo-drawer)
+ (dynamic-block . org-e-texinfo-dynamic-block)
+ (entity . org-e-texinfo-entity)
+ (example-block . org-e-texinfo-example-block)
+ (export-block . org-e-texinfo-export-block)
+ (export-snippet . org-e-texinfo-export-snippet)
+ (fixed-width . org-e-texinfo-fixed-width)
+ (footnote-definition . org-e-texinfo-footnote-definition)
+ (footnote-reference . org-e-texinfo-footnote-reference)
+ (headline . org-e-texinfo-headline)
+ (horizontal-rule . org-e-texinfo-horizontal-rule)
+ (inline-babel-call . org-e-texinfo-inline-babel-call)
+ (inline-src-block . org-e-texinfo-inline-src-block)
+ (inlinetask . org-e-texinfo-inlinetask)
+ (italic . org-e-texinfo-italic)
+ (item . org-e-texinfo-item)
+ (keyword . org-e-texinfo-keyword)
+ (latex-environment . org-e-texinfo-latex-environment)
+ (latex-fragment . org-e-texinfo-latex-fragment)
+ (line-break . org-e-texinfo-line-break)
+ (link . org-e-texinfo-link)
+ (macro . org-e-texinfo-macro)
+ (paragraph . org-e-texinfo-paragraph)
+ (plain-list . org-e-texinfo-plain-list)
+ (plain-text . org-e-texinfo-plain-text)
+ (planning . org-e-texinfo-planning)
+ (property-drawer . org-e-texinfo-property-drawer)
+ (quote-block . org-e-texinfo-quote-block)
+ (quote-section . org-e-texinfo-quote-section)
+ (radio-target . org-e-texinfo-radio-target)
+ (section . org-e-texinfo-section)
+ (special-block . org-e-texinfo-special-block)
+ (src-block . org-e-texinfo-src-block)
+ (statistics-cookie . org-e-texinfo-statistics-cookie)
+ (strike-through . org-e-texinfo-strike-through)
+ (subscript . org-e-texinfo-subscript)
+ (superscript . org-e-texinfo-superscript)
+ (table . org-e-texinfo-table)
+ (table-cell . org-e-texinfo-table-cell)
+ (table-row . org-e-texinfo-table-row)
+ (target . org-e-texinfo-target)
+ (template . org-e-texinfo-template)
+ (timestamp . org-e-texinfo-timestamp)
+ (underline . org-e-texinfo-underline)
+ (verbatim . org-e-texinfo-verbatim)
+ (verse-block . org-e-texinfo-verse-block))
+ "Alist between element or object types and translators.")
+
+(defconst org-e-texinfo-options-alist
+ '((:texinfo-filename "TEXINFO_FILENAME" nil org-e-texinfo-filename t)
+ (:texinfo-class "TEXINFO_CLASS" nil org-e-texinfo-default-class t)
+ (:texinfo-header "TEXINFO_HEADER" nil nil newline)
+ (:subtitle "SUBTITLE" nil nil newline)
+ (:subauthor "SUBAUTHOR" nil nil newline)
+ (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t)
+ (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t)
+ (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t))
+ "Alist between Texinfo export properties and ways to set them.
+See `org-export-options-alist' for more information on the
+structure of the values.
+
+SUBAUTHOR and SUBTITLE are for the inclusion of additional author
+and title information beyond the initial variable.")
+
+(defconst org-e-texinfo-filters-alist
+ '((:filter-headline . org-e-texinfo-filter-section-blank-lines)
+ (:filter-section . org-e-texinfo-filter-section-blank-lines))
+ "Alist between filters keywords and back-end specific filters.
+ See `org-export-filters-alist' for more information")
+
+
+;;; Internal Variables
+
+;; Add TEXINFO to the list of available of available export blocks.
+(add-to-list 'org-element-block-name-alist
+ '("TEXINFO" . org-element-export-block-parser))
+
+;;; User Configurable Variables
+
+(defgroup org-export-e-texinfo nil
+ "Options for exporting Org mode files to Texinfo."
+ :tag "Org Export Texinfo"
+ :group 'org-export)
+
+;;; Preamble
+
+(defcustom org-e-texinfo-filename nil
+ "Default filename for texinfo output."
+ :group 'org-export-e-texinfo
+ :type '(string :tag "Export Filename"))
+
+(defcustom org-e-texinfo-default-class "info"
+ "The default Texinfo class."
+ :group 'org-export-e-texinfo
+ :type '(string :tag "Texinfo class"))
+
+(defcustom org-e-texinfo-classes
+ '(("info"
+ "\\input texinfo @c -*- texinfo -*-"
+ ("@chapter %s" . "@unnumbered %s")
+ ("@section %s" . "@unnumberedsec %s")
+ ("@subsection %s" . "@unnumberedsubsec %s")
+ ("@subsubsection %s" . "@unnumberedsubsubsec %s")))
+ "Alist of Texinfo classes and associated header and structure.
+If #+Texinfo_CLASS is set in the buffer, use its value and the
+associated information. Here is the structure of each cell:
+
+ \(class-name
+ header-string
+ \(numbered-section . unnumbered-section\)
+ ...\)
+
+The sectioning structure
+------------------------
+
+The sectioning structure of the class is given by the elements
+following the header string. For each sectioning level, a number
+of strings is specified. A %s formatter is mandatory in each
+section string and will be replaced by the title of the section.
+
+Instead of a list of sectioning commands, you can also specify
+a function name. That function will be called with two
+parameters, the \(reduced) level of the headline, and a predicate
+non-nil when the headline should be numbered. It must return
+a format string in which the section title will be added."
+ :group 'org-export-e-texinfo
+ :type '(repeat
+ (list (string :tag "Texinfo class")
+ (string :tag "Texinfo header")
+ (repeat :tag "Levels" :inline t
+ (choice
+ (cons :tag "Heading"
+ (string :tag " numbered")
+ (string :tag "unnumbered"))
+ (function :tag "Hook computing sectioning"))))))
+
+;;; Headline
+
+(defcustom org-e-texinfo-format-headline-function nil
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags as a list of strings (list of strings or nil).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-e-texinfo-format-headline (todo todo-type priority text tags)
+ \"Default format function for an headline.\"
+ \(concat (when todo
+ \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
+ \(when priority
+ \(format \"\\\\framebox{\\\\#%c} \" priority))
+ text
+ \(when tags
+ \(format \"\\\\hfill{}\\\\textsc{%s}\"
+ \(mapconcat 'identity tags \":\"))))"
+ :group 'org-export-e-texinfo
+ :type 'function)
+
+
+;;; Footnotes
+;;
+;; Footnotes are inserted directly
+
+;;; Timestamps
+
+(defcustom org-e-texinfo-active-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-e-texinfo
+ :type 'string)
+
+(defcustom org-e-texinfo-inactive-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-e-texinfo
+ :type 'string)
+
+(defcustom org-e-texinfo-diary-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-e-texinfo
+ :type 'string)
+
+;;; Links
+
+(defcustom org-e-texinfo-link-with-unknown-path-format "@indicateurl{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-e-texinfo
+ :type 'string)
+
+;;; Tables
+
+(defcustom org-e-texinfo-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-e-texinfo
+ :type 'boolean)
+
+(defcustom org-e-texinfo-table-scientific-notation "%s\\,(%s)"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-e-texinfo
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+(defcustom org-e-texinfo-def-table-markup "@samp"
+ "Default setting for @table environments.")
+
+;;; Text markup
+
+(defcustom org-e-texinfo-text-markup-alist '((bold . "@strong{%s}")
+ (code . code)
+ (italic . "@emph{%s}")
+ (verbatim . verb)
+ (comment . "@c %s"))
+ "Alist of Texinfo expressions to convert text markup.
+
+The key must be a symbol among `bold', `italic' and `comment'.
+The value is a formatting string to wrap fontified text with.
+
+Value can also be set to the following symbols: `verb' and
+`code'. For the former, Org will use \"@verb\" to
+create a format string and select a delimiter character that
+isn't in the string. For the latter, Org will use \"@code\"
+to typeset and try to protect special characters.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-e-texinfo
+ :type 'alist
+ :options '(bold code italic verbatim comment))
+
+;;; Drawers
+
+(defcustom org-e-texinfo-format-drawer-function nil
+ "Function called to format a drawer in Texinfo code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-texinfo-format-drawer-default \(name contents\)
+ \"Format a drawer element for Texinfo export.\"
+ contents\)"
+ :group 'org-export-e-texinfo
+ :type 'function)
+
+;;; Inlinetasks
+
+(defcustom org-e-texinfo-format-inlinetask-function nil
+ "Function called to format an inlinetask in Texinfo code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behaviour:
+
+\(defun org-e-texinfo-format-inlinetask \(todo type priority name tags contents\)
+\"Format an inline task element for Texinfo export.\"
+ \(let ((full-title
+ \(concat
+ \(when todo
+ \(format \"@strong{%s} \" todo))
+ \(when priority (format \"#%c \" priority))
+ title
+ \(when tags
+ \(format \":%s:\"
+ \(mapconcat 'identity tags \":\")))))
+ \(format (concat \"@center %s\n\n\"
+ \"%s\"
+ \"\n\"))
+ full-title contents))"
+ :group 'org-export-e-texinfo
+ :type 'function)
+
+;;; Src blocks
+;;
+;; Src Blocks are example blocks, except for LISP
+
+;;; Plain text
+
+(defcustom org-e-texinfo-quotes
+ '(("quotes"
+ ("\\(\\s-\\|[[(]\\|^\\)\"" . "``")
+ ("\\(\\S-\\)\"" . "''")
+ ("\\(\\s-\\|(\\|^\\)'" . "`")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-e-texinfo
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+;;; Compilation
+
+(defcustom org-e-texinfo-info-process
+ '("makeinfo %f")
+ "Commands to process a texinfo file to an INFO file.
+This is list of strings, each of them will be given to the shell
+as a command. %f in the command will be replaced by the full
+file name, %b by the file base name \(i.e without extension) and
+%o by the base directory of the file."
+ :group 'org-export-texinfo
+ :type '(repeat :tag "Shell command sequence"
+ (string :tag "Shell command")))
+
+
+;;; Internal Functions
+
+(defun org-e-texinfo-filter-section-blank-lines (headline back-end info)
+ "Filter controlling number of blank lines after a section."
+ (let ((blanks (make-string 2 ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))
+
+(defun org-e-texinfo--find-copying (info)
+ "Retrieve the headline identified by the property :copying:.
+
+INFO is the plist containing the export options and tree. It is
+used to find and extract the single desired headline. This
+cannot be treated as a standard headline since it must be
+inserted in a specific location."
+ (let (copying)
+ (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (copy)
+ (when (org-element-property :copying copy)
+ (push copy copying))) info 't)
+ ;; Retrieve the single entry
+ (car copying)))
+
+(defun org-e-texinfo--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-e-texinfo--make-option-string (options)
+ "Return a comma separated string of keywords and values.
+OPTIONS is an alist where the key is the options keyword as
+a string, and the value a list containing the keyword value, or
+nil."
+ (mapconcat (lambda (pair)
+ (concat (first pair)
+ (when (> (length (second pair)) 0)
+ (concat "=" (second pair)))))
+ options
+ ","))
+
+(defun org-e-texinfo--quotation-marks (text info)
+ "Export quotation marks using ` and ' as the markers.
+TEXT is a string containing quotation marks to be replaced. INFO
+is a plist used as a communication channel."
+ (mapc (lambda(l)
+ (let ((start 0))
+ (while (setq start (string-match (car l) text start))
+ (let ((new-quote (concat (match-string 1 text) (cdr l))))
+ (setq text (replace-match new-quote t t text))))))
+ (cdr org-e-texinfo-quotes))
+ text)
+
+(defun org-e-texinfo--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-e-texinfo-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-e-texinfo-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ((eq 'verb fmt)
+ (let ((separator (org-e-texinfo--find-verb-separator text)))
+ (concat "@verb{" separator text separator "}")))
+ ((eq 'code fmt)
+ (let ((start 0)
+ (rtn "")
+ char)
+ (while (string-match "[@{}]" text)
+ (setq char (match-string 0 text))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
+ (setq text (substring text (1+ (match-beginning 0))))
+ (setq char (concat "@" char)
+ rtn (concat rtn char)))
+ (setq text (concat rtn text)
+ fmt "@code{%s}")
+ (format fmt text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
+
+;;; Headline sanitizing
+
+(defun org-e-texinfo--sanitize-headline (headline info)
+ "Remove all formatting from the text of a headline for use in
+ node and menu listing."
+ (mapconcat 'identity
+ (org-e-texinfo--sanitize-headline-contents headline info) " "))
+
+(defun org-e-texinfo--sanitize-headline-contents (headline info)
+ "Retrieve the content of the headline.
+
+Any content that can contain further formatting is checked
+recursively, to ensure that nested content is also properly
+retrieved."
+ (loop for contents in headline append
+ (cond
+ ;; already a string
+ ((stringp contents)
+ (list (replace-regexp-in-string " $" "" contents)))
+ ;; Is exported as-is (value)
+ ((org-element-map contents '(verbatim code)
+ (lambda (value)
+ (org-element-property :value value))))
+ ;; Has content and recurse into the content
+ ((org-element-contents contents)
+ (org-e-texinfo--sanitize-headline-contents
+ (org-element-contents contents) info)))))
+
+;;; Menu sanitizing
+
+(defun org-e-texinfo--sanitize-menu (title)
+ "Remove invalid characters from TITLE for use in menus and
+nodes.
+
+Based on TEXINFO specifications, the following must be removed:
+@ { } ( ) : . ,"
+ (replace-regexp-in-string "[@{}():,.]" "" title))
+
+;;; Content sanitizing
+
+(defun org-e-texinfo--sanitize-content (text)
+ "Ensure characters are properly escaped when used in headlines or blocks.
+
+Escape characters are: @ { }"
+ (replace-regexp-in-string "\\\([@{}]\\\)" "@\\1" text))
+
+;;; Menu creation
+
+(defun org-e-texinfo--build-menu (tree level info &optional detailed)
+ "Create the @menu/@end menu information from TREE at headline
+level LEVEL.
+
+TREE contains the parse-tree to work with, either of the entire
+document or of a specific parent headline. LEVEL indicates what
+level of headlines to look at when generating the menu. INFO is
+a plist containing contextual information.
+
+Detailed determines whether to build a single level of menu, or
+recurse into all children as well."
+ (let ((menu (org-e-texinfo--generate-menu-list tree level info))
+ output text-menu)
+ (cond
+ (detailed
+ ;; Looping is done within the menu generation.
+ (setq text-menu (org-e-texinfo--generate-detailed menu level info)))
+ (t
+ (setq text-menu (org-e-texinfo--generate-menu-items menu info))))
+ (when text-menu
+ (setq output (org-e-texinfo--format-menu text-menu))
+ (mapconcat 'identity output "\n"))))
+
+(defun org-e-texinfo--generate-detailed (menu level info)
+ "Generate a detailed listing of all subheadings within MENU starting at LEVEL.
+
+MENU is the parse-tree to work with. LEVEL is the starting level
+for the menu headlines and from which recursion occurs. INFO is
+a plist containing contextual information."
+ (when level
+ (let ((max-depth (plist-get info :headline-levels)))
+ (when (> max-depth level)
+ (loop for headline in menu append
+ (let* ((title (org-e-texinfo--menu-headlines headline info))
+ ;; Create list of menu entries for the next level
+ (sublist (org-e-texinfo--generate-menu-list
+ headline (1+ level) info))
+ ;; Generate the menu items for that level. If
+ ;; there are none omit that heading completely,
+ ;; otherwise join the title to it's related entries.
+ (submenu (if (org-e-texinfo--generate-menu-items sublist info)
+ (append (list title)
+ (org-e-texinfo--generate-menu-items sublist info))
+ 'nil))
+ ;; Start the process over the next level down.
+ (recursion (org-e-texinfo--generate-detailed sublist (1+ level) info)))
+ (setq recursion (append submenu recursion))
+ recursion))))))
+
+(defun org-e-texinfo--generate-menu-list (tree level info)
+ "Generate the list of headlines that are within a given level
+of the tree for further formatting.
+
+TREE is the parse-tree containing the headlines. LEVEL is the
+headline level to generate a list of. INFO is a plist holding
+contextual information."
+ (let (seq)
+ (org-element-map
+ tree 'headline
+ (lambda (head)
+ (when (org-element-property :level head)
+ (if (and (eq level (org-element-property :level head))
+ ;; Do not take note of footnotes or copying headlines
+ (not (org-element-property :copying head))
+ (not (org-element-property :footnote-section-p head)))
+ (push head seq)))))
+ ;; Return the list of headlines (reverse to have in actual order)
+ (reverse seq)))
+
+(defun org-e-texinfo--generate-menu-items (items info)
+ "Generate a list of headline information from the listing ITEMS.
+
+ITEMS is a list of the headlines to be converted into entries.
+INFO is a plist containing contextual information.
+
+Returns a list containing the following information from each
+headline: length, title, description. This is used to format the
+menu using `org-e-texinfo--format-menu'."
+ (loop for headline in items collect
+ (let* ((title (org-e-texinfo--sanitize-menu
+ (org-e-texinfo--sanitize-headline
+ (org-element-property :title headline) info)))
+ (descr (org-export-data
+ (org-element-property :description headline) info))
+ (len (length title))
+ (output (list len title descr)))
+ output)))
+
+(defun org-e-texinfo--menu-headlines (headline info)
+ "Retrieve the title from HEADLINE.
+
+INFO is a plist holding contextual information.
+
+Return the headline as a list of (length title description) with
+length of -1 and nil description. This is used in
+`org-e-texinfo--format-menu' to identify headlines as opposed to
+entries."
+ (let ((title (org-export-data
+ (org-element-property :title headline) info)))
+ (list -1 title 'nil)))
+
+(defun org-e-texinfo--format-menu (text-menu)
+ "Format the TEXT-MENU items to be properly printed in the menu.
+
+Each entry in the menu should be provided as (length title
+description).
+
+Headlines in the detailed menu are given length -1 to ensure they
+are never confused with other entries. They also have no
+description.
+
+Other menu items are output as:
+ Title:: description
+
+With the spacing between :: and description based on the length
+of the longest menu entry."
+
+ (let* ((lengths (mapcar 'car text-menu))
+ (max-length (apply 'max lengths))
+ output)
+ (setq output
+ (mapcar (lambda (name)
+ (let* ((title (nth 1 name))
+ (desc (nth 2 name))
+ (length (nth 0 name)))
+ (if (> length -1)
+ (concat "* " title ":: "
+ (make-string
+ (- (+ 3 max-length) length)
+ ?\s)
+ (if desc
+ (concat desc)))
+ (concat "\n" title "\n"))))
+ text-menu))
+ output))
+
+;;; Template
+
+(defun org-e-texinfo-template (contents info)
+ "Return complete document string after Texinfo conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (info-filename (or (plist-get info :texinfo-filename)
+ (file-name-nondirectory
+ (org-export-output-file-name ".info"))))
+ (author (org-export-data (plist-get info :author) info))
+ (texinfo-header (plist-get info :texinfo-header))
+ (subtitle (plist-get info :subtitle))
+ (subauthor (plist-get info :subauthor))
+ (class (plist-get info :texinfo-class))
+ (header (nth 1 (assoc class org-e-texinfo-classes)))
+ (copying (org-e-texinfo--find-copying info))
+ (dircat (plist-get info :texinfo-dircat))
+ (dirtitle (plist-get info :texinfo-dirtitle))
+ (dirdesc (plist-get info :texinfo-dirdesc))
+ ;; Spacing to align description (column 32 - 3 for `* ' and
+ ;; `.' in text.
+ (dirspacing (- 29 (length dirtitle)))
+ (menu (org-e-texinfo-make-menu info 'main))
+ (detail-menu (org-e-texinfo-make-menu info 'detailed)))
+ (concat
+ ;; Header
+ header "\n"
+ "@c %**start of header\n"
+ ;; Filename and Title
+ "@setfilename " info-filename "\n"
+ "@settitle " title "\n"
+ "\n\n"
+ "@c Version and Contact Info\n"
+ "@set AUTHOR " author "\n"
+
+ ;; Additional Header Options set by `#+TEXINFO_HEADER
+ (if texinfo-header
+ (concat "\n"
+ texinfo-header
+ "\n"))
+
+ "@c %**end of header\n"
+ "@finalout\n"
+ "\n\n"
+
+ ;; Copying
+ "@copying\n"
+ ;; Only export the content of the headline, do not need the
+ ;; initial headline.
+ (org-export-data (nth 2 copying) info)
+ "@end copying\n"
+ "\n\n"
+
+ ;; Info directory information
+ ;; Only supply if both title and category are provided
+ (if (and dircat dirtitle)
+ (concat "@dircategory " dircat "\n"
+ "@direntry\n"
+ "* " dirtitle "."
+ (make-string dirspacing ?\s)
+ dirdesc "\n"
+ "@end direntry\n"))
+ "\n\n"
+
+ ;; Title
+ "@titlepage\n"
+ "@title " title "\n\n"
+ (if subtitle
+ (concat "@subtitle " subtitle "\n"))
+ "@author " author "\n"
+ (if subauthor
+ (concat subauthor "\n"))
+ "\n"
+ "@c The following two commands start the copyright page.\n"
+ "@page\n"
+ "@vskip 0pt plus 1filll\n"
+ "@insertcopying\n"
+ "@end titlepage\n\n"
+ "@c Output the table of contents at the beginning.\n"
+ "@contents\n\n"
+
+ ;; Configure Top Node when not for Tex
+ "@ifnottex\n"
+ "@node Top\n"
+ "@top " title " Manual\n"
+ "@insertcopying\n"
+ "@end ifnottex\n\n"
+
+ ;; Do not output menus if they are empty
+ (if menu
+ ;; Menu
+ (concat "@menu\n"
+ menu
+ "\n\n"
+ ;; Detailed Menu
+ (if detail-menu
+ (concat "@detailmenu\n"
+ " --- The Detailed Node Listing ---\n"
+ detail-menu
+ "\n\n"
+ "@end detailmenu\n"))
+ "@end menu\n"))
+ "\n\n"
+
+ ;; Document's body.
+ contents
+ "\n"
+ ;; Creator.
+ (let ((creator-info (plist-get info :with-creator)))
+ (cond
+ ((not creator-info) "")
+ ((eq creator-info 'comment)
+ (format "@c %s\n" (plist-get info :creator)))
+ (t (concat (plist-get info :creator) "\n"))))
+ ;; Document end.
+ "\n@bye")))
+
+
+
+;;; Transcode Functions
+
+;;; Babel Call
+;;
+;; Babel Calls are ignored.
+
+;;; Bold
+
+(defun org-e-texinfo-bold (bold contents info)
+ "Transcode BOLD from Org to Texinfo.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (org-e-texinfo--text-markup contents 'bold))
+
+;;; Center Block
+;;
+;; Center blocks are ignored
+
+;;; Clock
+
+(defun org-e-texinfo-clock (clock contents info)
+ "Transcode a CLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "@noindent"
+ (format "@strong{%s} " org-clock-string)
+ (format org-e-texinfo-inactive-timestamp-format
+ (concat (org-translate-time (org-element-property :value clock))
+ (let ((time (org-element-property :time clock)))
+ (and time (format " (%s)" time)))))
+ "@*"))
+
+;;; Code
+
+(defun org-e-texinfo-code (code contents info)
+ "Transcode a CODE object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-texinfo--text-markup (org-element-property :value code) 'code))
+
+;;; Comment
+
+(defun org-e-texinfo-comment (comment contents info)
+ "Transcode a COMMENT object from Org to Texinfo.
+CONTENTS is the text in the comment. INFO is a plist holding
+contextual information."
+ (org-e-texinfo--text-markup (org-element-property :value comment) 'comment))
+
+;;; Comment Block
+
+(defun org-e-texinfo-comment-block (comment-block contents info)
+ "Transcode a COMMENT-BLOCK object from Org to Texinfo.
+CONTENTS is the text within the block. INFO is a plist holding
+contextual information."
+ (format "@ignore\n%s@end ignore" (org-element-property :value comment-block)))
+
+;;; Drawer
+
+(defun org-e-texinfo-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (if (functionp org-e-texinfo-format-drawer-function)
+ (funcall org-e-texinfo-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ output))
+
+;;; Dynamic Block
+
+(defun org-e-texinfo-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ contents)
+
+;;; Entity
+
+(defun org-e-texinfo-entity (entity contents info)
+ "Transcode an ENTITY object from Org to Texinfo.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :latex entity)))
+ (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent)))
+
+;;; Example Block
+
+(defun org-e-texinfo-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "@verbatim\n%s@end verbatim"
+ (org-export-format-code-default example-block info)))
+
+;;; Export Block
+
+(defun org-e-texinfo-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "TEXINFO")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+;;; Export Snippet
+
+(defun org-e-texinfo-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'e-texinfo)
+ (org-element-property :value export-snippet)))
+
+;;; Fixed Width
+
+(defun org-e-texinfo-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "@example\n%s\n@end example"
+ (org-remove-indentation
+ (org-e-texinfo--sanitize-content
+ (org-element-property :value fixed-width)))))
+
+;;; Footnote Definition
+;;
+;; Footnote Definitions are ignored.
+
+;;; Footnote Reference
+;;
+
+(defun org-e-texinfo-footnote-reference (footnote contents info)
+ "Create a footnote reference for FOOTNOTE.
+
+FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a
+plist holding contextual information."
+ (let ((def (org-export-get-footnote-definition footnote info)))
+ (format "@footnote{%s}"
+ (org-trim (org-export-data def info)))))
+
+;;; Headline
+
+(defun org-e-texinfo-headline (headline contents info)
+ "Transcode an HEADLINE element from Org to Texinfo.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((class (plist-get info :texinfo-class))
+ (level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ (class-sectionning (assoc class org-e-texinfo-classes))
+ ;; Find the index type, if any
+ (index (org-element-property :index headline))
+ ;; Retrieve headline text
+ (text (org-e-texinfo--sanitize-headline
+ (org-element-property :title headline) info))
+ ;; Create node info, to insert it before section formatting.
+ (node (format "@node %s\n"
+ (org-e-texinfo--sanitize-menu
+ (replace-regexp-in-string "%" "%%" text))))
+ ;; Menus must be generated with first child, otherwise they
+ ;; will not nest properly
+ (menu (let* ((first (org-export-first-sibling-p headline info))
+ (parent (org-export-get-parent-headline headline))
+ (title (org-e-texinfo--sanitize-headline
+ (org-element-property :title parent) info))
+ heading listing
+ (tree (plist-get info :parse-tree)))
+ (if first
+ (org-element-map
+ (plist-get info :parse-tree) 'headline
+ (lambda (ref)
+ (if (member title (org-element-property :title ref))
+ (push ref heading)))
+ info 't))
+ (setq listing (org-e-texinfo--build-menu
+ (car heading) level info))
+ (if listing
+ (setq listing (replace-regexp-in-string
+ "%" "%%" listing)
+ listing (format
+ "\n@menu\n%s\n@end menu\n\n" listing))
+ 'nil)))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (let ((sec (if (and (symbolp (nth 2 class-sectionning))
+ (fboundp (nth 2 class-sectionning)))
+ (funcall (nth 2 class-sectionning) level numberedp)
+ (nth (1+ level) class-sectionning))))
+ (cond
+ ;; No section available for that LEVEL.
+ ((not sec) nil)
+ ;; Section format directly returned by a function.
+ ((stringp sec) sec)
+ ;; (numbered-section . unnumbered-section)
+ ((not (consp (cdr sec)))
+ ;; If an index, always unnumbered
+ (if index
+ (concat menu node (cdr sec) "\n%s")
+ ;; Otherwise number as needed.
+ (concat menu node
+ (funcall
+ (if numberedp #'car #'cdr) sec) "\n%s"))))))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ ;; Create the headline text along with a no-tag version. The
+ ;; latter is required to remove tags from table of contents.
+ (full-text (org-e-texinfo--sanitize-content
+ (if (functionp org-e-texinfo-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-texinfo-format-headline-function
+ todo todo-type priority text tags)
+ ;; Default formatting.
+ (concat
+ (when todo
+ (format "@strong{%s} " todo))
+ (when priority (format "@emph{#%s} " priority))
+ text
+ (when tags
+ (format ":%s:"
+ (mapconcat 'identity tags ":")))))))
+ (full-text-no-tag
+ (org-e-texinfo--sanitize-content
+ (if (functionp org-e-texinfo-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-e-texinfo-format-headline-function
+ todo todo-type priority text nil)
+ ;; Default formatting.
+ (concat
+ (when todo (format "@strong{%s} " todo))
+ (when priority (format "@emph{#%c} " priority))
+ text))))
+ (pre-blanks
+ (make-string (org-element-property :pre-blank headline) 10)))
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+ ;; Case 2: This is the `copying' section: ignore it
+ ;; This is used elsewhere.
+ ((org-element-property :copying headline) nil)
+ ;; Case 3: An index. If it matches one of the known indexes,
+ ;; print it as such following the contents, otherwise
+ ;; print the contents and leave the index up to the user.
+ (index
+ (format
+ section-fmt full-text
+ (concat pre-blanks contents "\n"
+ (if (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
+ (concat "@printindex " index)))))
+ ;; Case 4: This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (let ((low-level-body
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "@%s\n" (if numberedp 'enumerate 'itemize)))
+ ;; Itemize headline
+ "@item\n" full-text "\n" pre-blanks contents)))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ (format "\n@end %s" (if numberedp 'enumerate 'itemize))
+ low-level-body))))
+ ;; Case 5: Standard headline. Export it as a section.
+ (t
+ (cond
+ ((not (and tags (eq (plist-get info :with-tags) 'not-in-toc)))
+ ;; Regular section. Use specified format string.
+ (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text
+ (concat pre-blanks contents)))
+ ((string-match "\\`@\\(.*?\\){" section-fmt)
+ ;; If tags should be removed from table of contents, insert
+ ;; title without tags as an alternative heading in sectioning
+ ;; command.
+ (format (replace-match (concat (match-string 1 section-fmt) "[%s]")
+ nil nil section-fmt 1)
+ ;; Replace square brackets with parenthesis since
+ ;; square brackets are not supported in optional
+ ;; arguments.
+ (replace-regexp-in-string
+ "\\[" "("
+ (replace-regexp-in-string
+ "\\]" ")"
+ full-text-no-tag))
+ full-text
+ (concat pre-blanks contents)))
+ (t
+ ;; Impossible to add an alternative heading. Fallback to
+ ;; regular sectioning format string.
+ (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text
+ (concat pre-blanks contents))))))))
+
+;;; Horizontal Rule
+;;
+;; Horizontal rules are ignored
+
+;;; Inline Babel Call
+;;
+;; Inline Babel Calls are ignored.
+
+;;; Inline Src Block
+
+(defun org-e-texinfo-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block))
+ (separator (org-e-texinfo--find-verb-separator code)))
+ (concat "@verb{" separator code separator "}")))
+
+;;; Inlinetask
+
+(defun org-e-texinfo-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((title (org-export-data (org-element-property :title inlinetask) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (org-element-property :todo-type inlinetask))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))))
+ ;; If `org-e-texinfo-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-e-texinfo-format-inlinetask-function)
+ (funcall org-e-texinfo-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (let ((full-title
+ (concat
+ (when todo (format "@strong{%s} " todo))
+ (when priority (format "#%c " priority))
+ title
+ (when tags (format ":%s:"
+ (mapconcat 'identity tags ":"))))))
+ (format (concat "@center %s\n\n"
+ "%s"
+ "\n")
+ full-title contents)))))
+
+;;; Italic
+
+(defun org-e-texinfo-italic (italic contents info)
+ "Transcode ITALIC from Org to Texinfo.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (org-e-texinfo--text-markup contents 'italic))
+
+;;; Item
+
+(defun org-e-texinfo-item (item contents info)
+ "Transcode an ITEM element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((tag (org-element-property :tag item))
+ (desc (org-export-data tag info)))
+ (concat "\n@item " (if tag desc) "\n"
+ (org-trim contents) "\n")))
+
+;;; Keyword
+
+(defun org-e-texinfo-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "TEXINFO") value)
+ ((string= key "CINDEX") (format "@cindex %s" value))
+ ((string= key "FINDEX") (format "@findex %s" value))
+ ((string= key "KINDEX") (format "@kindex %s" value))
+ ((string= key "PINDEX") (format "@pindex %s" value))
+ ((string= key "TINDEX") (format "@tindex %s" value))
+ ((string= key "VINDEX") (format "@vindex %s" value)))))
+
+;;; Latex Environment
+;;
+;; Latex environments are ignored
+
+;;; Latex Fragment
+;;
+;; Latex fragments are ignored.
+
+;;; Line Break
+
+(defun org-e-texinfo-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "@*")
+
+;;; Link
+
+(defun org-e-texinfo-link (link desc info)
+ "Transcode a LINK object from Org to Texinfo.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (path (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ (email (if (string= type "mailto")
+ (let ((text (replace-regexp-in-string
+ "@" "@@" raw-path)))
+ (concat text (if desc (concat "," desc))))))
+ protocol)
+ (cond
+ ;; Links pointing to an headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "id"))
+ (let ((destination (org-export-resolve-id-link link info)))
+ (case (org-element-type destination)
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "@uref{file://%s,%s}" destination desc)
+ (format "@uref{file://%s}" destination)))
+ ;; LINK points to an headline. Use the headline as the NODE target
+ (headline
+ (format "@ref{%s}"
+ (org-export-data
+ (org-element-property :title destination) info)))
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "@ref{%s}" path)
+ (format "@ref{%s,,%s}" path desc)))))))
+ ((member type '("fuzzy"))
+ (let ((destination (org-export-resolve-fuzzy-link link info)))
+ (case (org-element-type destination)
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "@uref{file://%s,%s}" destination desc)
+ (format "@uref{file://%s}" destination)))
+ ;; LINK points to an headline. Use the headline as the NODE target
+ (headline
+ (format "@ref{%s}"
+ (org-export-data
+ (org-element-property :title destination) info)))
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "@ref{%s}" path)
+ (format "@ref{%s,,%s}" path desc)))))))
+ ;; Special case for email addresses
+ (email
+ (format "@email{%s}" email))
+ ;; External link with a description part.
+ ((and path desc) (format "@uref{%s,%s}" path desc))
+ ;; External link without a description part.
+ (path (format "@uref{%s}" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format org-e-texinfo-link-with-unknown-path-format desc)))))
+
+;;; Macro
+
+(defun org-e-texinfo-macro (macro contents info)
+ "Transcode a MACRO element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ;; Use available tools.
+ (org-export-expand-macro macro info))
+
+;;; Menu
+
+(defun org-e-texinfo-make-menu (info level)
+ "Create the menu for inclusion in the texifo document.
+
+INFO is the parsed buffer that contains the headlines. LEVEL
+determines whether to make the main menu, or the detailed menu.
+
+This is only used for generating the primary menu. In-Node menus
+are generated directly."
+ (let* ((parse (plist-get info :parse-tree))
+ ;; Top determines level to build menu from, it finds the
+ ;; level of the first headline in the export.
+ (top (org-element-map
+ parse 'headline
+ (lambda (headline)
+ (org-element-property :level headline)) info 't)))
+ (cond
+ ;; Generate the main menu
+ ((eq level 'main)
+ (org-e-texinfo--build-menu parse top info))
+ ;; Generate the detailed (recursive) menu
+ ((eq level 'detailed)
+ ;; Requires recursion
+ ;;(org-e-texinfo--build-detailed-menu parse top info)
+ (org-e-texinfo--build-menu parse top info 'detailed))
+ ;; Otherwise do nothing
+ (t))))
+
+;;; Paragraph
+
+(defun org-e-texinfo-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to Texinfo.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ contents)
+
+;;; Plain List
+
+(defun org-e-texinfo-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to Texinfo.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
+ (indic (or (plist-get attr :indic)
+ org-e-texinfo-def-table-markup))
+ (type (org-element-property :type plain-list))
+ (table-type (or (plist-get attr :table-type)
+ "table"))
+ ;; Ensure valid texinfo table type.
+ (table-type (if (memq table-type '("table" "ftable" "vtable"))
+ table-type
+ "table"))
+ (list-type (cond
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'unordered) "itemize")
+ ((eq type 'descriptive) table-type))))
+ (format "@%s%s\n@end %s"
+ (if (eq type 'descriptive)
+ (concat list-type " " indic)
+ list-type)
+ contents
+ list-type)))
+
+;;; Plain Text
+
+(defun org-e-texinfo-plain-text (text info)
+ "Transcode a TEXT string from Org to Texinfo.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; LaTeX into @LaTeX{} and TeX into @TeX{}
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\(\\(?:La\\)?TeX\\)" text start)
+ (setq text (replace-match
+ (format "@%s{}" (match-string 1 text)) nil t text)
+ start (match-end 0))))
+ ;; Handle quotation marks
+ (setq text (org-e-texinfo--quotation-marks text info))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (while (string-match (regexp-quote "...") text)
+ (setq text (replace-match "@dots{}" nil t text))))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n"
+ text)))
+ ;; Return value with @ { and } protected.
+ (org-e-texinfo--sanitize-content text))
+
+;;; Planning
+
+(defun org-e-texinfo-planning (planning contents info)
+ "Transcode a PLANNING element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "@noindent"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "@strong%s} " org-closed-string)
+ (format org-e-texinfo-inactive-timestamp-format
+ (org-translate-time closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "@strong{%s} " org-deadline-string)
+ (format org-e-texinfo-active-timestamp-format
+ (org-translate-time deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "@strong{%s} " org-scheduled-string)
+ (format org-e-texinfo-active-timestamp-format
+ (org-translate-time scheduled)))))))
+ " ")
+ "@*"))
+
+;;; Property Drawer
+
+(defun org-e-texinfo-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+;;; Quote Block
+
+(defun org-e-texinfo-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((title (org-element-property :name quote-block))
+ (start-quote (concat "@quotation"
+ (if title
+ (format " %s" title)))))
+ (format "%s\n%s@end quotation" start-quote contents)))
+
+;;; Quote Section
+
+(defun org-e-texinfo-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "@verbatim\n%s@end verbatim" value))))
+
+;;; Radio Target
+
+(defun org-e-texinfo-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to Texinfo.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "@anchor{%s}%s"
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+;;; Section
+
+(defun org-e-texinfo-section (section contents info)
+ "Transcode a SECTION element from Org to Texinfo.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+;;; Special Block
+;;
+;; Are ignored at the moment
+
+;;; Src Block
+
+(defun org-e-texinfo-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (lisp-p (string-match-p "lisp" lang)))
+ (cond
+ ;; Case 1. Lisp Block
+ (lisp-p
+ (format "@lisp\n%s\n@end lisp"
+ (org-export-format-code-default src-block info)))
+ ;; Case 2. Other blocks
+ (t
+ (format "@example\n%s\n@end example"
+ (org-export-format-code-default src-block info))))))
+
+;;; Statistics Cookie
+
+(defun org-e-texinfo-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+;;; Strike-Through
+;;
+;; Strikethrough is ignored
+
+;;; Subscript
+
+(defun org-e-texinfo-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to Texinfo.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "@math{_%s}" contents))
+
+;;; Superscript
+
+(defun org-e-texinfo-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to Texinfo.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "@math{^%s}" contents))
+
+;;; Table
+;;
+;; `org-e-texinfo-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" attribute. Otherwise, it
+;; delegates the job to either `org-e-texinfo-table--table.el-table' or
+;; `org-e-texinfo-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-e-texinfo-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-e-texinfo-table (table contents info)
+ "Transcode a TABLE element from Org to Texinfo.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (cond
+ ;; Case 1: verbatim table.
+ ((or org-e-texinfo-tables-verbatim
+ (let ((attr (mapconcat 'identity
+ (org-element-property :attr_latex table)
+ " ")))
+ (and attr (string-match "\\<verbatim\\>" attr))))
+ (format "@verbatim \n%s\n@end verbatim"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+ ;; Case 2: table.el table. Convert it using appropriate tools.
+ ((eq (org-element-property :type table) 'table.el)
+ (org-e-texinfo-table--table.el-table table contents info))
+ ;; Case 3: Standard table.
+ (t (org-e-texinfo-table--org-table table contents info))))
+
+(defun org-e-texinfo-table-column-widths (table info)
+ "Determine the largest table cell in each column to process alignment.
+
+TABLE is the table element to transcode. INFO is a plist used as
+a communication channel."
+ (let* ((rows (org-element-map table 'table-row 'identity info))
+ (collected (loop for row in rows collect
+ (org-element-map
+ row 'table-cell 'identity info)))
+ (number-cells (length (car collected)))
+ cells counts)
+ (loop for row in collected do
+ (push (mapcar (lambda (ref)
+ (let* ((start (org-element-property :contents-begin ref))
+ (end (org-element-property :contents-end ref))
+ (length (- end start)))
+ length)) row) cells))
+ (setq cells (remove-if #'null cells))
+ (push (loop for count from 0 to (- number-cells 1) collect
+ (loop for item in cells collect
+ (nth count item))) counts)
+ (mapconcat (lambda (size)
+ (make-string size ?a)) (mapcar (lambda (ref)
+ (apply 'max `,@ref)) (car counts))
+ "} {")))
+
+(defun org-e-texinfo-table--org-table (table contents info)
+ "Return appropriate Texinfo code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' attribute."
+ (let* ((attr (org-export-read-attribute :attr_texinfo table))
+ (col-width (plist-get attr :columns))
+ (columns (if col-width
+ (format "@columnfractions %s"
+ col-width)
+ (format "{%s}"
+ (org-e-texinfo-table-column-widths
+ table info)))))
+ ;; Prepare the final format string for the table.
+ (cond
+ ;; Longtable.
+ ;; Others.
+ (t (concat
+ (format "@multitable %s\n%s@end multitable"
+ columns
+ contents))))))
+
+(defun org-e-texinfo-table--table.el-table (table contents info)
+ "Returns nothing.
+
+Rather than return an invalid table, nothing is returned."
+ 'nil)
+
+;;; Table Cell
+
+(defun org-e-texinfo-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to Texinfo.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-e-texinfo-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-e-texinfo-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) "\n@tab ")))
+
+;;; Table Row
+
+(defun org-e-texinfo-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to Texinfo.
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (concat "@item " contents "\n")))
+
+;;; Target
+
+(defun org-e-texinfo-target (target contents info)
+ "Transcode a TARGET object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "@anchor{%s}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+;;; Timestamp
+
+(defun org-e-texinfo-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-translate-time (org-element-property :value timestamp)))
+ (type (org-element-property :type timestamp)))
+ (cond ((memq type '(active active-range))
+ (format org-e-texinfo-active-timestamp-format value))
+ ((memq type '(inactive inactive-range))
+ (format org-e-texinfo-inactive-timestamp-format value))
+ (t (format org-e-texinfo-diary-timestamp-format value)))))
+
+;;; Underline
+;;
+;; Underline is ignored
+
+;;; Verbatim
+
+(defun org-e-texinfo-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-e-texinfo--text-markup (org-element-property :value verbatim) 'verbatim))
+
+;;; Verse Block
+
+(defun org-e-texinfo-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to Texinfo.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ ;; In a verse environment, add a line break to each newline
+ ;; character and change each white space at beginning of a line
+ ;; into a space of 1 em. Also change each blank line with
+ ;; a vertical space of 1 em.
+ (progn
+ (setq contents (replace-regexp-in-string
+ "^ *\\\\\\\\$" "\\\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents)))
+ (while (string-match "^[ \t]+" contents)
+ (let ((new-str (format "\\hspace*{%dem}"
+ (length (match-string 0 contents)))))
+ (setq contents (replace-match new-str nil t contents))))
+ (format "\\begin{verse}\n%s\\end{verse}" contents)))
+
+
+;;; Interactive functions
+
+(defun org-e-texinfo-export-to-texinfo
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to a Texinfo file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".texi" subtreep pub-dir)))
+ (org-export-to-file
+ 'e-texinfo outfile subtreep visible-only body-only ext-plist)))
+
+(defun org-e-texinfo-export-to-info
+ (&optional subtreep visible-only body-only ext-plist pub-dir)
+ "Export current buffer to Texinfo then process through to INFO.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return INFO file's name."
+ (interactive)
+ (org-e-texinfo-compile
+ (org-e-texinfo-export-to-texinfo
+ subtreep visible-only body-only ext-plist pub-dir)))
+
+(defun org-e-texinfo-compile (texifile)
+ "Compile a texinfo file.
+
+TEXIFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-e-texinfo-info-process'.
+
+Return INFO file name or an error if it couldn't be produced."
+ (let* ((wconfig (current-window-configuration))
+ (texifile (file-truename texifile))
+ (base (file-name-sans-extension texifile))
+ errors)
+ (message (format "Processing Texinfo file %s ..." texifile))
+ (unwind-protect
+ (progn
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-e-texinfo-info-process)
+ (funcall org-e-texinfo-info-process (shell-quote-argument texifile)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org INFO Texinfo Output*" buffer.
+ ((consp org-e-texinfo-info-process)
+ (let* ((out-dir (or (file-name-directory texifile) "./"))
+ (outbuf (get-buffer-create "*Org Info Texinfo Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument texifile)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-e-texinfo-info-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-e-texinfo-collect-errors outbuf))))
+ (t (error "No valid command to process to Info")))
+ (let ((infofile (concat base ".info")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p infofile))
+ (error (concat (format "INFO file %s wasn't produced" infofile)
+ (when errors (concat ": " errors))))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ infofile))
+ (set-window-configuration wconfig))))
+
+(defun org-e-texinfo-collect-errors (buffer)
+ "Collect some kind of errors from \"makeinfo\" command output.
+
+BUFFER is the buffer containing output.
+
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ ;; Find final "makeinfo" run.
+ (when t
+ (let ((case-fold-search t)
+ (errors ""))
+ (when (save-excursion
+ (re-search-forward "perhaps incorrect sectioning?" nil t))
+ (setq errors (concat errors " [incorrect sectionnng]")))
+ (when (save-excursion
+ (re-search-forward "missing close brace" nil t))
+ (setq errors (concat errors " [syntax error]")))
+ (when (save-excursion
+ (re-search-forward "Unknown command" nil t))
+ (setq errors (concat errors " [undefined @command]")))
+ (when (save-excursion
+ (re-search-forward "No matching @end" nil t))
+ (setq errors (concat errors " [block incomplete]")))
+ (when (save-excursion
+ (re-search-forward "requires a sectioning" nil t))
+ (setq errors (concat errors " [invalid section command]")))
+ (when (save-excursion
+ (re-search-forward "\\[unexpected\]" nil t))
+ (setq errors (concat errors " [unexpected error]")))
+ (when (save-excursion
+ (re-search-forward "misplaced " nil t))
+ (setq errors (concat errors " [syntax error]")))
+ (and (org-string-nw-p errors) (org-trim errors)))))))
+
+(provide 'org-e-texinfo)
+;;; org-e-texinfo.el ends here
diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el
new file mode 100644
index 0000000..96b0e5d
--- /dev/null
+++ b/contrib/lisp/org-elisp-symbol.el
@@ -0,0 +1,161 @@
+;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols
+;;
+;; Copyright 2007-2012 Free Software Foundation, Inc.
+;;
+;; Author: bzg AT gnu DOT org
+;; Version: 0.2
+;; Keywords: org, remember, lisp
+;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el
+;;
+;; 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, 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:
+;;
+;; Org-mode already lets you store/insert links to emacs-lisp files,
+;; just like any other file. This package lets you precisely link to
+;; any emacs-lisp symbol and access useful information about the symbol.
+;;
+;; Here is the list of available properties when linking from a elisp-symbol:
+;;
+;; :name The symbol's name.
+;; :stype The symbol's type (commandp, function, etc.)
+;; :def The function used to set the symbol's value (defun, etc.)
+;; :keys The keys associated with the command.
+;; :args The arguments of the function.
+;; :docstring The docstring of the symbol.
+;; :doc The first line of the dostring.
+;; :comment A comment line just above the sexp, if any.
+;; :fixme A FIXME comment line just above the sexp, if any.
+;;
+;; Let's say we have a defun like this one:
+;;
+;; ;; FIXME update docstring
+;; (defun org-export-latex-lists ()
+;; "Convert lists to LaTeX."
+;; (goto-char (point-min))
+;; (while (re-search-forward org-export-latex-list-beginning-re nil t)
+;; (beginning-of-line)
+;; (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
+;;
+;; And a remember template like:
+;;
+;; (setq org-remember-templates
+;; '((?s "* DEBUG `%:name' (%:args)\n\n%?\n\nFixme: %:fixme\n \
+;; Doc: \"%:doc\"\n\n%a")))
+;;
+;; Then M-x `org-remember' on this sexp will produce this buffer:
+;;
+;; =====================================================================
+;; * DEBUG `org-export-latex-lists' ()
+;;
+;; <== point
+;;
+;; Fixme: update the docstring
+;; Doc: "Convert lists to LaTeX."
+;;
+;; [[file:~/path/file.el::defun%20my-func][Function: my-func]]
+;; =====================================================================
+;;
+;; Put this file into your load-path and the following into your ~/.emacs:
+;; (require 'org-elisp-symbol)
+
+;;; Code:
+
+(provide 'org-elisp-symbol)
+
+(require 'org)
+
+(org-add-link-type "elisp-symbol" 'org-elisp-symbol-open)
+(add-hook 'org-store-link-functions 'org-elisp-symbol-store-link)
+
+(defun org-elisp-symbol-open (path)
+ "Visit the emacs-lisp elisp-symbol at PATH."
+ (let* ((search (when (string-match "::\\(.+\\)\\'" path)
+ (match-string 1 path)))
+ (path (substring path 0 (match-beginning 0))))
+ (org-open-file path t nil search)))
+
+(defun org-elisp-symbol-store-link ()
+ "Store a link to an emacs-lisp elisp-symbol."
+ (when (eq major-mode 'emacs-lisp-mode)
+ (save-excursion
+ (or (looking-at "^(") (beginning-of-defun))
+ (looking-at "^(\\([a-z]+\\) \\([^)\n ]+\\) ?\n?[ \t]*\\(?:(\\(.*\\))\\)?")
+ (let* ((end (save-excursion
+ (save-match-data
+ (end-of-defun) (point))))
+ (def (match-string 1))
+ (name (match-string 2))
+ (sym-name (intern-soft name))
+ (stype (cond ((commandp sym-name) "Command")
+ ((functionp sym-name) "Function")
+ ((user-variable-p sym-name) "User variable")
+ ((string= def "defvar") "Variable")
+ ((string= def "defmacro") "Macro")
+ ((string= def "defun") "Function or command")
+ (t "Symbol")))
+ (args (if (match-string 3)
+ (mapconcat (lambda (a) (unless (string-match "^&" a) a))
+ (split-string (match-string 3)) " ")
+ "no arg"))
+ (docstring (cond ((functionp sym-name)
+ (or (documentation sym-name)
+ "[no documentation]"))
+ ((string-match "[Vv]ariable" stype)
+ (documentation-property sym-name
+ 'variable-documentation))
+ (t "no documentation")))
+ (doc (and (string-match "^\\([^\n]+\\)$" docstring)
+ (match-string 1 docstring)))
+ (fixme (save-excursion
+ (beginning-of-defun) (end-of-defun)
+ (if (re-search-forward "^;+ ?FIXME[ :]*\\(.*\\)$" end t)
+ (match-string 1) "nothing to fix")))
+ (comment (save-excursion
+ (beginning-of-defun) (end-of-defun)
+ (if (re-search-forward "^;;+ ?\\(.*\\)$" end t)
+ (match-string 1) "no comment")))
+ keys keys-desc link description)
+ (if (equal stype "Command")
+ (setq keys (where-is-internal sym-name)
+ keys-desc
+ (if keys (mapconcat 'key-description keys " ") "none")))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" def " " name))
+ (setq description (concat stype ": " name))
+ (org-store-link-props
+ :type "elisp-symbol"
+ :link link
+ :description description
+ :def def
+ :name name
+ :stype stype
+ :args args
+ :keys keys-desc
+ :docstring docstring
+ :doc doc
+ :fixme fixme
+ :comment comment)))))
+
+(provide 'org-elisp-symbol)
+
+
+;;;;##########################################################################
+;;;; User Options, Variables
+;;;;##########################################################################
+
+;;; org-elisp-symbol.el ends here
diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el
new file mode 100644
index 0000000..36f3c6d
--- /dev/null
+++ b/contrib/lisp/org-eval-light.el
@@ -0,0 +1,201 @@
+;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>,
+;; Eric Schulte <schulte dot eric at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp, literate programming,
+;; reproducible research
+;; Homepage: http://orgmode.org
+;; Version: 0.04
+
+;; This file is not yet 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, 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; 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 is based off of org-eval, with the following changes.
+;;
+;; 1) forms are only executed manually, (allowing for the execution of
+;; an entire subtree of forms)
+;; 2) use the org-mode style src blocks, rather than the muse style
+;; <code></code> blocks
+;; 3) forms are not replaced by their outputs, but rather the output
+;; is placed in the buffer immediately following the src block
+;; commented by `org-eval-light-make-region-example' (when
+;; evaluated with a prefix argument no output is placed in the
+;; buffer)
+;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of
+;; a source block it will call `org-eval-light-current-snippet'
+
+;;; Code:
+(require 'org)
+
+(defgroup org-eval-light nil
+ "Options concerning including output from commands into the Org-mode buffer."
+ :tag "Org Eval"
+ :group 'org)
+
+(defvar org-eval-light-example-size-cutoff 10
+ "The number of lines under which an example is considered
+'small', and is exported with the '^:' syntax instead of in a
+large example block")
+
+(defvar org-eval-light-regexp nil)
+
+(defun org-eval-light-set-interpreters (var value)
+ (set-default var value)
+ (setq org-eval-light-regexp
+ (concat "#\\+begin_src \\("
+ (mapconcat 'regexp-quote value "\\|")
+ "\\)\\([^\000]+?\\)#\\+end_src")))
+
+(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell")
+ "Interpreters allows for evaluation tags.
+This is a list of program names (as strings) that can evaluate code and
+insert the output into an Org-mode buffer. Valid choices are
+
+lisp Interpret Emacs Lisp code and display the result
+shell Pass command to the shell and display the result
+perl The perl interpreter
+python Thy python interpreter
+ruby The ruby interpreter"
+ :group 'org-eval-light
+ :set 'org-eval-light-set-interpreters
+ :type '(set :greedy t
+ (const "lisp")
+ (const "emacs-lisp")
+ (const "perl")
+ (const "python")
+ (const "ruby")
+ (const "shell")))
+
+;;; functions
+(defun org-eval-light-inside-snippet ()
+ (interactive)
+ (save-excursion
+ (let ((case-fold-search t)
+ (start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n")
+ (end-re "\n#\\+end_src")
+ (pos (point))
+ beg end)
+ (if (and (setq beg (re-search-backward start-re nil t))
+ (setq end (re-search-forward end-re nil t))
+ (<= beg pos) (>= end pos))
+ t))))
+
+(defun org-eval-light-make-region-example (beg end)
+ "Comment out region using either the '^:' or the BEGIN_EXAMPLE
+syntax based on the size of the region as compared to
+`org-eval-light-example-size-cutoff'."
+ (interactive "*r")
+ (let ((size (abs (- (line-number-at-pos end)
+ (line-number-at-pos beg)))))
+ (if (= size 0)
+ (let ((result (buffer-substring beg end)))
+ (delete-region beg end)
+ (insert (concat ": " result)))
+ (if (<= size org-eval-light-example-size-cutoff)
+ (save-excursion
+ (goto-char beg)
+ (dotimes (n size)
+ (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
+ (let ((result (buffer-substring beg end)))
+ (delete-region beg end)
+ (insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n")))))))
+
+(defun org-eval-light-current-snippet (&optional arg)
+ "Execute the current #+begin_src #+end_src block, and dump the
+results into the buffer immediately following the src block,
+commented by `org-eval-light-make-region-example'."
+ (interactive "P")
+ (let ((line (org-current-line))
+ (case-fold-search t)
+ (info (org-edit-src-find-region-and-lang))
+ beg end lang result)
+ (setq beg (nth 0 info)
+ end (nth 1 info)
+ lang (nth 2 info))
+ (unless (member lang org-eval-light-interpreters)
+ (error "Language is not in `org-eval-light-interpreters': %s" lang))
+ (goto-line line)
+ (setq result (org-eval-light-code lang (buffer-substring beg end)))
+ (unless arg
+ (save-excursion
+ (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
+ (let ((beg (point))
+ (end (progn (insert result)
+ (point))))
+ (message (format "from %S %S" beg end))
+ (org-eval-light-make-region-example beg end))))))
+
+(defun org-eval-light-eval-subtree (&optional arg)
+ "Replace EVAL snippets in the entire subtree."
+ (interactive "P")
+ (save-excursion
+ (org-narrow-to-subtree)
+ (goto-char (point-min))
+ (while (re-search-forward org-eval-light-regexp nil t)
+ (org-eval-light-current-snippet arg))
+ (widen)))
+
+(defun org-eval-light-code (interpreter code)
+ (cond
+ ((member interpreter '("lisp" "emacs-lisp"))
+ (org-eval-light-lisp (concat "(progn\n" code "\n)")))
+ ((equal interpreter "shell")
+ (shell-command-to-string code))
+ ((member interpreter '("perl" "python" "ruby"))
+ (org-eval-light-run (executable-find interpreter) code))
+ (t (error "Cannot evaluate code type %s" interpreter))))
+
+(defun org-eval-light-lisp (form)
+ "Evaluate the given form and return the result as a string."
+ (require 'pp)
+ (save-match-data
+ (condition-case err
+ (let ((object (eval (read form))))
+ (cond
+ ((stringp object) object)
+ ((and (listp object)
+ (not (eq object nil)))
+ (let ((string (pp-to-string object)))
+ (substring string 0 (1- (length string)))))
+ ((numberp object)
+ (number-to-string object))
+ ((eq object nil) "")
+ (t
+ (pp-to-string object))))
+ (error
+ (org-display-warning (format "%s: Error evaluating %s: %s"
+ "???" form err))
+ "; INVALID LISP CODE"))))
+
+(defun org-eval-light-run (cmd code)
+ (with-temp-buffer
+ (insert code)
+ (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
+ (buffer-string)))
+
+(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate)
+ (if (org-eval-light-inside-snippet)
+ (call-interactively 'org-eval-light-current-snippet)
+ ad-do-it))
+
+(provide 'org-eval-light)
+
+;;; org-eval-light.el ends here
diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el
new file mode 100644
index 0000000..9968669
--- /dev/null
+++ b/contrib/lisp/org-eval.el
@@ -0,0 +1,219 @@
+;;; org-eval.el --- Display result of evaluating code in various languages
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.04
+;;
+;; This file is not yet 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, 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; 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 modules allows to include output from various commands into an
+;; Org-mode buffer, both for live display, and for export.
+;; This technique has been copied from emacs-wiki and Emacs Muse, and
+;; we try to make it work here in a way as similar as possible to
+;; Muse, so that people who move between both worlds don't need to learn
+;; new syntax.
+;;
+;; Basically it works like this:
+;;
+;; <lisp>(concat "aaa" "bbb")</lisp>
+;;
+;; will display "aaabbb" in the buffer and export like that as well.
+;; The leading lisp tag will also accept the attributes "markup" and
+;; "lang", to specify how the text should be formatted during export.
+;; For example,
+;;
+;; <lisp markup="src" lang="emacs-lisp"> .... </lisp>
+;;
+;; will format the result of the lisp form as if it was lisp source
+;; code. Internally, it will wrap the text into a
+;;
+;; #+begin_src emacs-lisp
+;; #+end_src
+;;
+;; structure so that the right things happen when the exporter is running.
+;;
+;; By default, only the <lisp> tag is turned on, but you can configure
+;; the variable `org-eval-interpreters' to add more interpreters like
+;; `perl', `python', or the `shell'.
+;;
+;; You can edit the code snippets with "C-c '" (org-edit-src-code).
+;;
+;; Please note that this mechanism is potentially dangerous, because it
+;; executes code that you don't even see. This gives you great power,
+;; but also enough rope to hang yourself. And, it gives your friends
+;; who send you Org files plenty of opportunity for good and bad jokes.
+;; This is also why this module is not turned on by default, but only
+;; available as a contributed package.
+;;
+;;
+;;
+(require 'org)
+
+;;; Customization
+
+(defgroup org-eval nil
+ "Options concerning including output from commands into the Org-mode buffer."
+ :tag "Org Eval"
+ :group 'org)
+
+(defface org-eval
+ (org-compatible-face nil
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey40"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey60"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face for command output that is included into an Org-mode buffer."
+ :group 'org-eval
+ :group 'org-faces
+ :version "22.1")
+
+(defvar org-eval-regexp nil)
+
+(defun org-eval-set-interpreters (var value)
+ (set-default var value)
+ (setq org-eval-regexp
+ (concat "<\\("
+ (mapconcat 'regexp-quote value "\\|")
+ "\\)"
+ "\\([^>]\\{0,50\\}?\\)>"
+ "\\([^\000]+?\\)</\\1>")))
+
+(defcustom org-eval-interpreters '("lisp")
+ "Interpreters allows for evaluation tags.
+This is a list of program names (as strings) that can evaluate code and
+insert the output into an Org-mode buffer. Valid choices are
+
+lisp Interpret Emacs Lisp code and display the result
+shell Pass command to the shell and display the result
+perl The perl interpreter
+python Thy python interpreter
+ruby The ruby interpreter"
+ :group 'org-eval
+ :set 'org-eval-set-interpreters
+ :type '(set :greedy t
+ (const "lisp")
+ (const "perl")
+ (const "python")
+ (const "ruby")
+ (const "shell")))
+
+(defun org-eval-handle-snippets (limit &optional replace)
+ "Evaluate code snippets and display the results as display property.
+When REPLACE is non-nil, replace the code region with the result (used
+for export)."
+ (let (a)
+ (while (setq a (text-property-any (point) (or limit (point-max))
+ 'org-eval t))
+ (remove-text-properties
+ a (next-single-property-change a 'org-eval nil limit)
+ '(display t intangible t org-eval t))))
+ (while (re-search-forward org-eval-regexp limit t)
+ (let* ((beg (match-beginning 0))
+ (end (match-end 0))
+ (kind (match-string 1))
+ (attr (match-string 2))
+ (code (match-string 3))
+ (value (org-eval-code kind code))
+ markup lang)
+ (if replace
+ (progn
+ (setq attr (save-match-data (org-eval-get-attributes attr))
+ markup (cdr (assoc "markup" attr))
+ lang (cdr (assoc "lang" attr)))
+ (replace-match
+ (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
+ (if (and markup (equal (downcase markup) "src"))
+ (concat " " (or lang "fundamental")))
+ "\n"
+ value
+ (if markup (format "\n#+END_%s\n" (upcase markup))))
+ t t))
+ (add-text-properties
+ beg end
+ (list 'display value 'intangible t 'font-lock-multiline t
+ 'face 'org-eval
+ 'org-eval t))))))
+
+(defun org-eval-replace-snippts ()
+ "Replace EVAL snippets in the entire buffer.
+This should go into the `org-export-preprocess-hook'."
+ (goto-char (point-min))
+ (org-eval-handle-snippets nil 'replace))
+
+(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
+(add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
+
+(defun org-eval-get-attributes (str)
+ (let ((start 0) key value rtn)
+ (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
+ (setq key (match-string 1 str)
+ value (match-string 2 str)
+ start (match-end 0))
+ (push (cons key value) rtn))
+ rtn))
+
+(defun org-eval-code (interpreter code)
+ (cond
+ ((equal interpreter "lisp")
+ (org-eval-lisp (concat "(progn\n" code "\n)")))
+ ((equal interpreter "shell")
+ (shell-command-to-string code))
+ ((member interpreter '("perl" "python" "ruby"))
+ (org-eval-run (executable-find interpreter) code))
+ (t (error "Cannot evaluate code type %s" interpreter))))
+
+(defun org-eval-lisp (form)
+ "Evaluate the given form and return the result as a string."
+ (require 'pp)
+ (save-match-data
+ (condition-case err
+ (let ((object (eval (read form))))
+ (cond
+ ((stringp object) object)
+ ((and (listp object)
+ (not (eq object nil)))
+ (let ((string (pp-to-string object)))
+ (substring string 0 (1- (length string)))))
+ ((numberp object)
+ (number-to-string object))
+ ((eq object nil) "")
+ (t
+ (pp-to-string object))))
+ (error
+ (org-display-warning (format "%s: Error evaluating %s: %s"
+ "???" form err))
+ "; INVALID LISP CODE"))))
+
+(defun org-eval-run (cmd code)
+ (with-temp-buffer
+ (insert code)
+ (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
+ (buffer-string)))
+
+(provide 'org-eval)
+
+;;; org-eval.el ends here
diff --git a/contrib/lisp/org-exp-bibtex.el b/contrib/lisp/org-exp-bibtex.el
new file mode 100644
index 0000000..8a99243
--- /dev/null
+++ b/contrib/lisp/org-exp-bibtex.el
@@ -0,0 +1,148 @@
+;;; org-exp-bibtex.el --- Export bibtex fragments
+
+;; Copyright (C) 2009-2012 Taru Karttunen
+
+;; Author: Taru Karttunen <taruti@taruti.net>
+
+;; This file is not currently 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, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program ; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This is an utility to handle BibTeX export to both LaTeX and html
+;; exports. It uses the bibtex2html software from
+;; http://www.lri.fr/~filliatr/bibtex2html/
+;;
+;; The usage is as follows:
+;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
+;; e.g. given foo.bib and using style plain:
+;; #+BIBLIOGRAPHY: foo plain option:-d
+;;
+;; Optional options are of the form:
+;;
+;; option:-foobar pass '-foobar' to bibtex2html
+;; e.g.
+;; option:-d sort by date.
+;; option:-a sort as BibTeX (usually by author) *default*
+;; option:-u unsorted i.e. same order as in .bib file
+;; option:-r reverse the sort.
+;; see the bibtex2html man page for more. Multiple options can be combined like:
+;; option:-d option:-r
+;;
+;; Limiting to only the entries cited in the document:
+;; limit:t
+
+;; For LaTeX export this simply inserts the lines
+;; \bibliographystyle{plain}
+;; \bibliography{foo}
+;; into the tex-file when exporting.
+
+;; For Html export it:
+;; 1) converts all \cite{foo} to links to the bibliography
+;; 2) creates a foo.html and foo_bib.html
+;; 3) includes the contents of foo.html in the exported html file
+
+(require 'org)
+(require 'org-exp)
+
+(defvar org-export-current-backend) ; dynamically bound in org-exp.el
+(defun org-export-bibtex-preprocess ()
+ "Export all BibTeX."
+ (interactive)
+ (save-window-excursion
+ (setq oebp-cite-plist '())
+
+ ;; Convert #+BIBLIOGRAPHY: name style
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t)
+ (let ((file (match-string 1))
+ (style (match-string 2))
+ (opt (org-exp-bibtex-options-to-plist (match-string 3))))
+ (replace-match
+ (cond
+ ((eq org-export-current-backend 'html) ;; We are exporting to HTML
+ (let (extra-args cite-list end-hook tmp-files)
+ (dolist (elt opt)
+ (when (equal "option" (car elt))
+ (setq extra-args (cons (cdr elt) extra-args))))
+
+ (when (assoc "limit" opt) ;; Limit is true - collect references
+ (org-exp-bibtex-docites (lambda ()
+ (dolist (c (org-split-string (match-string 1) ","))
+ (add-to-list 'cite-list c))))
+;; (message "cites: %s" cite-list)
+ (let ((tmp (make-temp-file "org-exp-bibtex")))
+ (with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n"))))
+ (setq tmp-files (cons tmp tmp-files))
+ (setq extra-args (append extra-args `("-citefile" ,tmp)))))
+
+ (when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil)
+ `("-a" "--nodoc" "--style" ,style "--no-header")
+ extra-args
+ (list (concat file ".bib"))))))
+ (error "Executing bibtex2html failed"))
+
+ (dolist (f tmp-files) (delete-file f)))
+
+ (with-temp-buffer
+ (save-match-data
+ (insert-file-contents (concat file ".html"))
+ (goto-char (point-min))
+ (while (re-search-forward (org-re "a name=\"\\([-_[:word:]]+\\)\">\\([[:word:]]+\\)") nil t)
+ (setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist)))
+ (goto-char (point-min))
+ (while (re-search-forward "<hr>" nil t)
+ (replace-match "<hr/>" t t))
+ (concat "\n#+BEGIN_HTML\n<div id=\"bibliography\">\n<h2>References</h2>\n" (buffer-string) "\n</div>\n#+END_HTML\n"))))
+ ((eq org-export-current-backend 'latex) ;; Latex export
+ (concat "\n#+LATEX: \\bibliographystyle{" style "}"
+ "\n#+LATEX: \\bibliography{" file "}\n"))) t t)))
+
+ ;; Convert cites to links in html
+ (when (eq org-export-current-backend 'html)
+ ;; Split citation commands with multiple keys
+ (org-exp-bibtex-docites
+ (lambda ()
+ (let ((keys (save-match-data (org-split-string (match-string 1) ","))))
+ (when (> (length keys) 1)
+ (replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "")
+ t t)))))
+ ;; Replace the citation commands with links
+ (org-exp-bibtex-docites
+ (lambda () (let* ((cn (match-string 1))
+ (cv (assoc cn oebp-cite-plist)))
+;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]"))
+ (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t))))))
+
+(defun org-exp-bibtex-docites (fun)
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (when (eq org-export-current-backend 'html)
+ (while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t)
+ (apply fun nil))))))
+
+(defun org-exp-bibtex-options-to-plist (options)
+ (save-match-data
+ (flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s)))))
+ (mapcar 'f (split-string options nil t)))))
+
+(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess)
+
+(provide 'org-exp-bibtex)
+
+;;; org-exp-bibtex.el ends here
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el
new file mode 100644
index 0000000..9f4517d
--- /dev/null
+++ b/contrib/lisp/org-expiry.el
@@ -0,0 +1,361 @@
+;;; org-expiry.el --- expiry mechanism for Org entries
+;;
+;; Copyright 2007-2012 Free Software Foundation, Inc.
+;;
+;; Author: bzg AT gnu DOT org
+;; Version: 0.2
+;; Keywords: org expiry
+
+;; 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, 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 gives you a chance to get rid of old entries in your Org files
+;; by expiring them.
+;;
+;; By default, entries that have no EXPIRY property are considered to be
+;; new (i.e. 0 day old) and only entries older than one year go to the
+;; expiry process, which consist in adding the ARCHIVE tag. None of
+;; your tasks will be deleted with the default settings.
+;;
+;; When does an entry expires?
+;;
+;; Consider this entry:
+;;
+;; * Stop watching TV
+;; :PROPERTIES:
+;; :CREATED: <2008-01-07 lun 08:01>
+;; :EXPIRY: <2008-01-09 08:01>
+;; :END:
+;;
+;; This entry will expire on the 9th, january 2008.
+
+;; * Stop watching TV
+;; :PROPERTIES:
+;; :CREATED: <2008-01-07 lun 08:01>
+;; :EXPIRY: +1w
+;; :END:
+;;
+;; This entry will expire on the 14th, january 2008, one week after its
+;; creation date.
+;;
+;; What happen when an entry is expired? Nothing until you explicitely
+;; M-x org-expiry-process-entries When doing this, org-expiry will check
+;; for expired entries and request permission to process them.
+;;
+;; Processing an expired entries means calling the function associated
+;; with `org-expiry-handler-function'; the default is to add the tag
+;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive
+;; the subtree.
+;;
+;; Is this useful? Well, when you're in a brainstorming session, it
+;; might be useful to know about the creation date of an entry, and be
+;; able to archive those entries that are more than xxx days/weeks old.
+;;
+;; When you're in such a session, you can insinuate org-expiry like
+;; this: M-x org-expiry-insinuate
+;;
+;; Then, each time you're pressing M-RET to insert an item, the CREATION
+;; property will be automatically added. Same when you're scheduling or
+;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate
+
+;;; Code:
+
+;;; User variables:
+
+(defgroup org-expiry nil
+ "Org expiry process."
+ :tag "Org Expiry"
+ :group 'org)
+
+(defcustom org-expiry-inactive-timestamps nil
+ "Insert inactive timestamps for the created and expired time properties"
+ :type 'boolean
+ :group 'org-expiry)
+
+(defcustom org-expiry-created-property-name "CREATED"
+ "The name of the property for setting the creation date."
+ :type 'string
+ :group 'org-expiry)
+
+(defcustom org-expiry-expiry-property-name "EXPIRY"
+ "The name of the property for setting the expiry date/delay."
+ :type 'string
+ :group 'org-expiry)
+
+(defcustom org-expiry-keyword "EXPIRED"
+ "The default keyword for `org-expiry-add-keyword'."
+ :type 'string
+ :group 'org-expiry)
+
+(defcustom org-expiry-wait "+1y"
+ "Time span between the creation date and the expiry.
+The default value for this variable (\"+1y\") means that entries
+will expire if there are at least one year old.
+
+If the expiry delay cannot be retrieved from the entry or the
+subtree above, the expiry process compares the expiry delay with
+`org-expiry-wait'. This can be either an ISO date or a relative
+time specification. See `org-read-date' for details."
+ :type 'string
+ :group 'org-expiry)
+
+(defcustom org-expiry-created-date "+0d"
+ "The default creation date.
+The default value of this variable (\"+0d\") means that entries
+without a creation date will be handled as if they were created
+today.
+
+If the creation date cannot be retrieved from the entry or the
+subtree above, the expiry process will compare the expiry delay
+with this date. This can be either an ISO date or a relative
+time specification. See `org-read-date' for details on relative
+time specifications."
+ :type 'string
+ :group 'org-expiry)
+
+(defcustom org-expiry-handler-function 'org-toggle-archive-tag
+ "Function to process expired entries.
+Possible candidates for this function are:
+
+`org-toggle-archive-tag'
+`org-expiry-add-keyword'
+`org-expiry-archive-subtree'"
+ :type 'function
+ :group 'org-expiry)
+
+(defcustom org-expiry-confirm-flag t
+ "Non-nil means confirm expiration process."
+ :type '(choice
+ (const :tag "Always require confirmation" t)
+ (const :tag "Do not require confirmation" nil)
+ (const :tag "Require confirmation in interactive expiry process"
+ interactive))
+ :group 'org-expiry)
+
+(defcustom org-expiry-advised-functions
+ '(org-scheduled org-deadline org-time-stamp)
+ "A list of advised functions.
+`org-expiry-insinuate' will activate the expiry advice for these
+functions. `org-expiry-deinsinuate' will deactivate them."
+ :type 'boolean
+ :group 'list)
+
+;;; Advices and insinuation:
+
+(defadvice org-schedule (after org-schedule-update-created)
+ "Update the creation-date property when calling `org-schedule'."
+ (org-expiry-insert-created))
+
+(defadvice org-deadline (after org-deadline-update-created)
+ "Update the creation-date property when calling `org-deadline'."
+ (org-expiry-insert-created))
+
+(defadvice org-time-stamp (after org-time-stamp-update-created)
+ "Update the creation-date property when calling `org-time-stamp'."
+ (org-expiry-insert-created))
+
+(defun org-expiry-insinuate (&optional arg)
+ "Add hooks and activate advices for org-expiry.
+If ARG, also add a hook to `before-save-hook' in `org-mode' and
+restart `org-mode' if necessary."
+ (interactive "P")
+ (ad-activate 'org-schedule)
+ (ad-activate 'org-time-stamp)
+ (ad-activate 'org-deadline)
+ (add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
+ (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
+ (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
+ (when arg
+ (add-hook 'org-mode-hook
+ (lambda() (add-hook 'before-save-hook
+ 'org-expiry-process-entries t t)))
+ ;; need this to refresh org-mode hooks
+ (when (eq major-mode 'org-mode)
+ (org-mode)
+ (if (org-called-interactively-p)
+ (message "Org-expiry insinuated, `org-mode' restarted.")))))
+
+(defun org-expiry-deinsinuate (&optional arg)
+ "Remove hooks and deactivate advices for org-expiry.
+If ARG, also remove org-expiry hook in Org's `before-save-hook'
+and restart `org-mode' if necessary."
+ (interactive "P")
+ (ad-deactivate 'org-schedule)
+ (ad-deactivate 'org-time-stamp)
+ (ad-deactivate 'org-deadline)
+ (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
+ (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
+ (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
+ (remove-hook 'org-mode-hook
+ (lambda() (add-hook 'before-save-hook
+ 'org-expiry-process-entries t t)))
+ (when arg
+ ;; need this to refresh org-mode hooks
+ (when (eq major-mode 'org-mode)
+ (org-mode)
+ (if (org-called-interactively-p)
+ (message "Org-expiry de-insinuated, `org-mode' restarted.")))))
+
+;;; org-expiry-expired-p:
+
+(defun org-expiry-expired-p ()
+ "Check if the entry at point is expired.
+Return nil if the entry is not expired. Otherwise return the
+amount of time between today and the expiry date.
+
+If there is no creation date, use `org-expiry-created-date'.
+If there is no expiry date, use `org-expiry-expiry-date'."
+ (let* ((ex-prop org-expiry-expiry-property-name)
+ (cr-prop org-expiry-created-property-name)
+ (ct (current-time))
+ (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d")))
+ (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait))
+ (ex (if (string-match "^[ \t]?[+-]" ex-field)
+ (time-add cr (time-subtract (org-read-date nil t ex-field) ct))
+ (org-read-date nil t ex-field))))
+ (if (time-less-p ex ct)
+ (time-subtract ct ex))))
+
+;;; Expire an entry or a region/buffer:
+
+(defun org-expiry-process-entry (&optional force)
+ "Call `org-expiry-handler-function' on entry.
+If FORCE is non-nil, don't require confirmation from the user.
+Otherwise rely on `org-expiry-confirm-flag' to decide."
+ (interactive "P")
+ (save-excursion
+ (when (org-called-interactively-p) (org-reveal))
+ (when (org-expiry-expired-p)
+ (org-back-to-heading)
+ (looking-at org-complex-heading-regexp)
+ (let* ((ov (make-overlay (point) (match-end 0)))
+ (e (org-expiry-expired-p))
+ (d (time-to-number-of-days e)))
+ (overlay-put ov 'face 'secondary-selection)
+ (if (or force
+ (null org-expiry-confirm-flag)
+ (and (eq org-expiry-confirm-flag 'interactive)
+ (not (interactive)))
+ (and org-expiry-confirm-flag
+ (y-or-n-p (format "Entry expired by %d days. Process? " d))))
+ (funcall 'org-expiry-handler-function))
+ (delete-overlay ov)))))
+
+(defun org-expiry-process-entries (beg end)
+ "Process all expired entries between BEG and END.
+The expiry process will run the function defined by
+`org-expiry-handler-functions'."
+ (interactive "r")
+ (save-excursion
+ (let ((beg (if (org-region-active-p)
+ (region-beginning) (point-min)))
+ (end (if (org-region-active-p)
+ (region-end) (point-max))))
+ (goto-char beg)
+ (let ((expired 0) (processed 0))
+ (while (and (outline-next-heading) (< (point) end))
+ (when (org-expiry-expired-p)
+ (setq expired (1+ expired))
+ (if (if (org-called-interactively-p)
+ (call-interactively 'org-expiry-process-entry)
+ (org-expiry-process-entry))
+ (setq processed (1+ processed)))))
+ (if (equal expired 0)
+ (message "No expired entry")
+ (message "Processed %d on %d expired entries"
+ processed expired))))))
+
+;;; Insert created/expiry property:
+
+(defun org-expiry-insert-created (&optional arg)
+ "Insert or update a property with the creation date.
+If ARG, always update it. With one `C-u' prefix, silently update
+to today's date. With two `C-u' prefixes, prompt the user for to
+update the date."
+ (interactive "P")
+ (let* ((d (org-entry-get (point) org-expiry-created-property-name))
+ d-time d-hour timestr)
+ (when (or (null d) arg)
+ ;; update if no date or non-nil prefix argument
+ ;; FIXME Use `org-time-string-to-time'
+ (setq d-time (if d (org-time-string-to-time d)
+ (current-time)))
+ (setq d-hour (format-time-string "%H:%M" d-time))
+ (setq timestr
+ ;; two C-u prefixes will call org-read-date
+ (if (equal arg '(16))
+ (concat "<" (org-read-date
+ nil nil nil nil d-time d-hour) ">")
+ (format-time-string (cdr org-time-stamp-formats))))
+ ;; maybe transform to inactive timestamp
+ (if org-expiry-inactive-timestamps
+ (setq timestr (concat "[" (substring timestr 1 -1) "]")))
+ (save-excursion
+ (org-entry-put
+ (point) org-expiry-created-property-name timestr)))))
+
+(defun org-expiry-insert-expiry (&optional today)
+ "Insert a property with the expiry date.
+With one `C-u' prefix, don't prompt interactively for the date
+and insert today's date."
+ (interactive "P")
+ (let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
+ d-time d-hour)
+ (setq d-time (if d (org-time-string-to-time d)
+ (current-time)))
+ (setq d-hour (format-time-string "%H:%M" d-time))
+ (setq timestr (if today
+ (format-time-string (cdr org-time-stamp-formats))
+ (concat "<" (org-read-date
+ nil nil nil nil d-time d-hour) ">")))
+ ;; maybe transform to inactive timestamp
+ (if org-expiry-inactive-timestamps
+ (setq timestr (concat "[" (substring timestr 1 -1) "]")))
+
+ (save-excursion
+ (org-entry-put
+ (point) org-expiry-expiry-property-name timestr))))
+
+;;; Functions to process expired entries:
+
+(defun org-expiry-archive-subtree ()
+ "Archive the entry at point if it is expired."
+ (interactive)
+ (save-excursion
+ (if (org-expiry-expired-p)
+ (org-archive-subtree)
+ (if (org-called-interactively-p)
+ (message "Entry at point is not expired.")))))
+
+(defun org-expiry-add-keyword (&optional keyword)
+ "Add KEYWORD to the entry at point if it is expired."
+ (interactive "sKeyword: ")
+ (if (or (member keyword org-todo-keywords-1)
+ (setq keyword org-expiry-keyword))
+ (save-excursion
+ (if (org-expiry-expired-p)
+ (org-todo keyword)
+ (if (org-called-interactively-p)
+ (message "Entry at point is not expired."))))
+ (error "\"%s\" is not a to-do keyword in this buffer" keyword)))
+
+;; FIXME what about using org-refile ?
+
+(provide 'org-expiry)
+
+;;; org-expiry.el ends here
diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el
new file mode 100644
index 0000000..4de38c7
--- /dev/null
+++ b/contrib/lisp/org-export-generic.el
@@ -0,0 +1,1504 @@
+;; org-export-generic.el --- Export frameworg with custom backends
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Wes Hardaker <hardaker at users dot sourceforge dot net>
+;; Keywords: outlines, hypermedia, calendar, wp, export
+;; Homepage: http://orgmode.org
+;; Version: 6.25trans
+;; Acks: Much of this code was stolen form the ascii export from Carsten
+;;
+;; This file is not yet 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/>.
+;;
+;; ----------------------------------------------------------------------
+;;
+;; OVERVIEW
+;;
+;; org-export-generic is basically a simple translation system that
+;; knows how to parse at least most of a .org buffer and then add
+;; various formatting prefixes before and after each section type. It
+;; does this by examining a property list stored in org-generic-alist.
+;; You can dynamically add propety lists of your own using the
+;; org-set-generic-type function:
+;;
+;; (org-set-generic-type
+;; "really-basic-text"
+;; '(:file-suffix ".txt"
+;; :key-binding ?R
+;;
+;; :title-format "=== %s ===\n"
+;; :body-header-section-numbers t
+;; :body-header-section-number-format "%s) "
+;; :body-section-header-prefix "\n"
+;; :body-section-header-suffix "\n"
+;; :body-line-format " %s\n"
+;; :body-line-wrap 75
+;; ))
+;;
+;; Note: Upper case key-bindings are reserved for your use. Lower
+;; case key bindings may conflict with future export-generic
+;; publications.
+;;
+;; Then run org-export (ctrl-c ctrl-e) and select generic or run
+;; org-export-generic. You'll then be prompted with a list of export
+;; types to choose from which will include your new type assigned to
+;; the key "r".
+;;
+;; ----------------------------------------------------------------------
+;;
+;; TODO (non-ordered)
+;; * handle function references
+;; * handle other types of multi-complex-listy-things to do
+;; ideas: (t ?- "%s" ?-)
+;; * handle indent specifiers better
+;; ideas: (4 ?\ "%s")
+;; * need flag to remove indents from body text
+;; * handle links
+;; * handle internationalization strings better
+;; * date/author/etc needs improvment (internationalization too)
+;; * allow specifying of section ordering
+;; ideas: :ordering ("header" "toc" "body" "footer")
+;; ^ matches current hard coded ordering
+;; * err, actually *do* a footer
+;; * deal with usage of org globals
+;; *** should we even consider them, or let the per-section specifiers do it
+;; *** answer: remove; mostly removed now
+;; * deal with interactive support for picking a export specifier label
+;; * char specifiers that need extra length because of formatting
+;; idea: (?- 4) for 4-longer
+;; * centering specifier
+;; idea: ('center " -- %s -- ")
+;; * remove more of the unneeded export-to-ascii copy code
+;; * tags
+;; *** supported now, but need separate format per tag
+;; *** allow different open/closing prefixes
+;; * properties
+;; * drawers
+;; * Escape camel-case for wiki exporters.
+;; * Adjust to depth limits on headers --- need to roll-over from headers
+;; to lists, as per other exporters
+;; * optmization (many plist extracts should be in let vars)
+;; * define defcustom spec for the specifier list
+;; * fonts: at least monospace is not handled at all here.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'org-exp)
+(require 'assoc)
+(eval-when-compile (require 'cl))
+
+(defgroup org-export-generic nil
+ "Options specific for ASCII export of Org-mode files."
+ :tag "Org Export ASCII"
+ :group 'org-export)
+
+(defcustom org-export-generic-links-to-notes t
+ "Non-nil means convert links to notes before the next headline.
+When nil, the link will be exported in place. If the line becomes long
+in this way, it will be wrapped."
+ :group 'org-export-generic
+ :type 'boolean)
+
+
+(defvar org-generic-current-indentation nil) ; For communication
+
+(defvar org-generic-alist
+ '(
+ ;;
+ ;; generic DEMO exporter
+ ;;
+ ;; (this tries to use every specifier for demo purposes)
+ ;;
+ ("demo"
+ :file-suffix ".txt"
+ :key-binding ?d
+
+ :header-prefix "<header>\n"
+ :header-suffix "</header>\n"
+
+ :author-export t
+ :tags-export t
+
+ :drawers-export t
+
+
+ :title-prefix ?=
+ :title-format "<h1>%s</h1>\n"
+ :title-suffix ?=
+
+ :date-export t
+ :date-prefix "<date>"
+ :date-format "<br /><b>Date:</b> <i>%s</i><br />"
+ :date-suffix "</date>\n\n"
+
+ :toc-export t
+ :toc-header-prefix "<tocname>\n"
+ :toc-header-format "__%s__\n"
+ :toc-header-suffix "</tocname>\n"
+
+ :toc-prefix "<toc>\n"
+ :toc-suffix "</toc>\n"
+
+ :toc-section-numbers t
+ :toc-section-number-format "\#(%s) "
+ :toc-format "--%s--"
+ :toc-format-with-todo "!!%s!!\n"
+ :toc-indent-char ?\
+ :toc-indent-depth 4
+
+ :toc-tags-export t
+ :toc-tags-prefix " <tags>"
+ :toc-tags-format "*%s*"
+ :toc-tags-suffix "</tags>\n"
+ :toc-tags-none-string "\n"
+
+ :body-header-section-numbers 3 ; t = all, nil = none
+
+ ; lists indicate different things per level
+ ; list contents or straight value can either be a
+ ; ?x char reference for printing strings that match the header len
+ ; "" string to print directly
+ :body-section-header-prefix ("<h1>" "<h2>" "<h3>"
+ "<h4>" "<h5>" "<h6>")
+ :body-section-header-format "%s"
+ :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n"
+ "</h4>\n" "</h5>\n" "</h6>\n")
+
+ :timestamps-export t
+ :priorities-export t
+ :todo-keywords-export t
+
+ :body-tags-export t
+ :body-tags-prefix " <tags>"
+ :body-tags-suffix "</tags>\n"
+
+ ; section prefixes/suffixes can be direct strings or lists as well
+ :body-section-prefix "<secprefix>\n"
+ :body-section-suffix "</secsuffix>\n"
+ ; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n")
+ ; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n")
+
+
+ ; if preformated text should be included (eg, : prefixed)
+ :body-line-export-preformated t
+ :body-line-fixed-prefix "<pre>\n"
+ :body-line-fixed-suffix "\n</pre>\n"
+ :body-line-fixed-format "%s\n"
+
+
+ :body-list-prefix "<list>\n"
+ :body-list-suffix "</list>\n"
+ :body-list-format "<li>%s</li>\n"
+
+ :body-number-list-prefix "<ol>\n"
+ :body-number-list-suffix "</ol>\n"
+ :body-number-list-format "<li>%s</li>\n"
+ :body-number-list-leave-number t
+
+ :body-list-checkbox-todo "<checkbox type=\"todo\">"
+ :body-list-checkbox-todo-end "</checkbox (todo)>"
+ :body-list-checkbox-done "<checkbox type=\"done\">"
+ :body-list-checkbox-done-end "</checkbox (done)>"
+ :body-list-checkbox-half "<checkbox type=\"half\">"
+ :body-list-checkbox-half-end "</checkbox (half)>"
+
+
+
+
+ ; other body lines
+ :body-line-format "%s"
+ :body-line-wrap 60 ; wrap at 60 chars
+
+ ; print above and below all body parts
+ :body-text-prefix "<p>\n"
+ :body-text-suffix "</p>\n"
+
+ )
+
+ ;;
+ ;; ascii exporter
+ ;;
+ ;; (close to the original ascii specifier)
+ ;;
+ ("ascii"
+ :file-suffix ".txt"
+ :key-binding ?a
+
+ :header-prefix ""
+ :header-suffix ""
+
+ :title-prefix ?=
+ :title-format "%s\n"
+ :title-suffix ?=
+
+ :date-export t
+ :date-prefix ""
+ :date-format "Date: %s\n"
+ :date-suffix ""
+
+ :toc-header-prefix ""
+ :toc-header-format "%s\n"
+ :toc-header-suffix ?=
+
+ :toc-export t
+ :toc-section-numbers t
+ :toc-section-number-format "%s "
+ :toc-format "%s\n"
+ :toc-format-with-todo "%s (*)\n"
+ :toc-indent-char ?\
+ :toc-indent-depth 4
+
+ :body-header-section-numbers 3
+ :body-section-prefix "\n"
+
+ ; :body-section-header-prefix "\n"
+ ; :body-section-header-format "%s\n"
+ ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-)
+
+ :body-section-header-prefix ("" "" "" "* " " + " " - ")
+ :body-section-header-format "%s\n"
+ :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n")
+
+ ; :body-section-marker-prefix ""
+ ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-)
+ ; :body-section-marker-suffix "\n"
+
+ :body-line-export-preformated t
+ :body-line-format "%s\n"
+ :body-line-wrap 75
+
+ ; :body-text-prefix "<t>\n"
+ ; :body-text-suffix "</t>\n"
+
+
+ :body-bullet-list-prefix (?* ?+ ?-)
+ ; :body-bullet-list-suffix (?* ?+ ?-)
+ )
+
+ ;;
+ ;; wikipedia
+ ;;
+ ("wikipedia"
+ :file-suffix ".txt"
+ :key-binding ?w
+
+ :header-prefix ""
+ :header-suffix ""
+
+ :title-format "= %s =\n"
+
+ :date-export nil
+
+ :toc-export nil
+
+ :body-header-section-numbers nil
+ :body-section-prefix "\n"
+
+ :body-section-header-prefix ("= " "== " "=== "
+ "==== " "===== " "====== ")
+ :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
+ " ====\n\n" " =====\n\n" " ======\n\n")
+
+ :body-line-export-preformated t ;; yes/no/maybe???
+ :body-line-format "%s\n"
+ :body-line-wrap 75
+
+ :body-line-fixed-format " %s\n"
+
+ :body-list-format "* %s\n"
+ :body-number-list-format "# %s\n"
+
+ :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
+ )
+ ;;
+ ;; mediawiki
+ ;;
+ ("mediawiki"
+ :file-suffix ".txt"
+ :key-binding ?m
+
+ :header-prefix ""
+ :header-suffix ""
+
+ :title-format "= %s =\n"
+
+ :date-export nil
+
+ :toc-export nil
+
+ :body-header-section-numbers nil
+ :body-section-prefix "\n"
+
+ :body-section-header-prefix ("= " "== " "=== "
+ "==== " "===== " "====== ")
+ :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n"
+ " ====\n\n" " =====\n\n" " ======\n\n")
+
+ :body-line-export-preformated t ;; yes/no/maybe???
+ :body-line-format "%s\n"
+ :body-line-wrap 75
+
+ :body-line-fixed-format " %s\n"
+
+ :body-list-format "* %s\n"
+ :body-number-list-format "# %s\n"
+
+ :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
+ :body-list-checkbox-todo "&#9744; "
+ :body-list-checkbox-done "&#9746; "
+ :body-table-start "{|"
+ :body-table-end "|}"
+ :body-table-cell-start "|"
+ :body-table-cell-end "\n"
+ :body-table-last-cell-end "|-"
+ :body-table-hline-start ""
+
+
+ )
+ ;;
+ ;; internet-draft .xml for xml2rfc exporter
+ ;;
+ ("ietfid"
+ ;; this tries to use every specifier for demo purposes
+ :file-suffix ".xml"
+ :key-binding ?i
+
+ :title-prefix "<?xml version=\"1.0\"\?>
+<!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [
+<!ENTITY rfcs PUBLIC '' 'blah'>
+<?rfc strict=\"yes\" ?>
+<?rfc toc=\"yes\" ?>
+<?rfc tocdepth=\"4\" ?>
+<?rfc symrefs=\"yes\" ?>
+<?rfc compact=\"yes\" ?>
+<?rfc subcompact=\"no\" ?>
+<rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\">
+ <front>
+"
+ :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n"
+ :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\">
+ <organization>Comany, Inc..</organization>
+ <address>
+ <postal>
+ <street></street>
+ <city></city>
+ <region></region>
+ <code></code>
+ <country></country>
+ </postal>
+ <phone></phone>
+ <email></email>
+ </address>
+ </author>
+ <date month=\"FILLMONTH\" year=\"FILLYEAR\"/>
+ <area>Operations and Management</area>
+ <workgroup>FIXME</workgroup>
+<abstract>\n"
+ :date-export nil
+
+ :toc-export nil
+
+ :body-header-section-numbers nil
+
+ :body-section-header-format "<section title=\"%s\">\n"
+ :body-section-suffix "</section>\n"
+
+ ; if preformated text should be included (eg, : prefixed)
+ :body-line-export-preformated t
+ :body-line-fixed-prefix "<figure>\n<artwork>\n"
+ :body-line-fixed-suffix "\n</artwork>\n</figure>\n"
+
+ ; other body lines
+ :body-line-format "%s"
+ :body-line-wrap 75
+
+ ; print above and below all body parts
+ :body-text-prefix "<t>\n"
+ :body-text-suffix "</t>\n"
+
+ :body-list-prefix "<list style=\"symbols\">\n"
+ :body-list-suffix "</list>\n"
+ :body-list-format "<t>%s</t>\n"
+
+ )
+ ("trac-wiki"
+ :file-suffix ".txt"
+ :key-binding ?T
+
+ ;; lifted from wikipedia exporter
+ :header-prefix ""
+ :header-suffix ""
+
+ :title-format "= %s =\n"
+
+ :date-export nil
+
+ :toc-export nil
+
+ :body-header-section-numbers nil
+ :body-section-prefix "\n"
+
+ :body-section-header-prefix (" == " " === " " ==== "
+ " ===== " )
+ :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n"
+ " =====\n\n" " ======\n\n" " =======\n\n")
+
+ :body-line-export-preformated t ;; yes/no/maybe???
+ :body-line-format "%s\n"
+ :body-line-wrap 75
+
+ :body-line-fixed-format " %s\n"
+
+ :body-list-format " * %s\n"
+ :body-number-list-format " # %s\n"
+ ;; :body-list-prefix "LISTSTART"
+ ;; :body-list-suffix "LISTEND"
+
+ ;; this is ignored! [2010/02/02:rpg]
+ :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")
+ )
+ ("tikiwiki"
+ :file-suffix ".txt"
+ :key-binding ?U
+
+ ;; lifted from wikipedia exporter
+ :header-prefix ""
+ :header-suffix ""
+
+ :title-format "-= %s =-\n"
+
+ :date-export nil
+
+ :toc-export nil
+
+ :body-header-section-numbers nil
+ :body-section-prefix "\n"
+
+ :body-section-header-prefix ("! " "!! " "!!! " "!!!! "
+ "!!!!! " "!!!!!! " "!!!!!!! ")
+ :body-section-header-suffix (" \n" " \n" " \n"
+ " \n" " \n" " \n")
+
+
+ :body-line-export-preformated t ;; yes/no/maybe???
+ :body-line-format "%s "
+ :body-line-wrap nil
+
+ :body-line-fixed-format " %s\n"
+
+ :body-list-format "* %s\n"
+ :body-number-list-format "# %s\n"
+ ;; :body-list-prefix "LISTSTART"
+ ;; :body-list-suffix "LISTEND"
+ :blockquote-start "\n^\n"
+ :blockquote-end "^\n\n"
+ :body-newline-paragraph "\n"
+ :bold-format "__%s__"
+ :italic-format "''%s''"
+ :underline-format "===%s==="
+ :strikethrough-format "--%s--"
+ :code-format "-+%s+-"
+ :verbatim-format "~pp~%s~/pp~"
+ )
+ )
+ "A assoc list of property lists to specify export definitions"
+)
+
+(setq org-generic-export-type "demo")
+
+(defvar org-export-generic-section-type "")
+(defvar org-export-generic-section-suffix "")
+
+;;;###autoload
+(defun org-set-generic-type (type definition)
+ "Adds a TYPE and DEFINITION to the existing list of defined generic
+export definitions."
+ (aput 'org-generic-alist type definition))
+
+;;; helper functions for org-set-generic-type
+(defvar org-export-generic-keywords nil)
+(defmacro* def-org-export-generic-keyword (keyword
+ &key documentation
+ type)
+ "Define KEYWORD as a legitimate element for inclusion in
+the body of an org-set-generic-type definition."
+ `(progn
+ (pushnew ,keyword org-export-generic-keywords)
+ ;; TODO: push the documentation and type information
+ ;; somewhere where it will do us some good.
+ ))
+
+(def-org-export-generic-keyword :body-newline-paragraph
+ :documentation "Bound either to NIL or to a pattern to be
+inserted in the output for every blank line in the input.
+ The intention is to handle formats where text is flowed, and
+newlines are interpreted as significant \(e.g., as indicating
+preformatted text\). A common non-nil value for this keyword
+is \"\\n\". Should typically be combined with a value for
+:body-line-format that does NOT end with a newline."
+ :type string)
+
+;;; fontification keywords
+(def-org-export-generic-keyword :bold-format)
+(def-org-export-generic-keyword :italic-format)
+(def-org-export-generic-keyword :underline-format)
+(def-org-export-generic-keyword :strikethrough-format)
+(def-org-export-generic-keyword :code-format)
+(def-org-export-generic-keyword :verbatim-format)
+
+
+
+
+(defun org-export-generic-remember-section (type suffix &optional prefix)
+ (setq org-export-generic-section-type type)
+ (setq org-export-generic-section-suffix suffix)
+ (if prefix
+ (insert prefix))
+)
+
+(defun org-export-generic-check-section (type &optional prefix suffix)
+ "checks to see if type is already in use, or we're switching parts
+If we're switching, then insert a potentially previously remembered
+suffix, and insert the current prefix immediately and then save the
+suffix a later change time."
+
+ (when (not (equal type org-export-generic-section-type))
+ (if org-export-generic-section-suffix
+ (insert org-export-generic-section-suffix))
+ (setq org-export-generic-section-type type)
+ (setq org-export-generic-section-suffix suffix)
+ (if prefix
+ (insert prefix))))
+
+;;;###autoload
+(defun org-export-generic (arg)
+ "Export the outline as generic output.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+underlined headlines. The default is 3."
+ (interactive "P")
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ (org-infile-export-plist)))
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend)))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+
+ helpstart
+ (bogus (mapc (lambda (x)
+ (setq helpstart
+ (concat helpstart "\["
+ (char-to-string
+ (plist-get (cdr x) :key-binding))
+ "] " (car x) "\n")))
+ org-generic-alist))
+
+ (help (concat helpstart "
+
+\[ ] the current setting of the org-generic-export-type variable
+"))
+
+ (cmds
+
+ (append
+ (mapcar (lambda (x)
+ (list
+ (plist-get (cdr x) :key-binding)
+ (car x)))
+ org-generic-alist)
+ (list (list ? "default"))))
+
+ r1 r2 ass
+
+ ;; read in the type to use
+ (export-plist
+ (progn
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Org Export/Generic Styles Help*"
+ (princ help))
+ (org-fit-window-to-buffer (get-buffer-window
+ "*Org Export/Generic Styles Help*"))
+ (message "Select command: ")
+ (setq r1 (read-char-exclusive))))
+ (setq r2 (if (< r1 27) (+ r1 96) r1))
+ (unless (setq ass (cadr (assq r2 cmds)))
+ (error "No command associated with key %c" r1))
+
+ (cdr (assoc
+ (if (equal ass "default") org-generic-export-type ass)
+ org-generic-alist))))
+
+ (custom-times org-display-custom-times)
+ (org-generic-current-indentation '(0 . 0))
+ (level 0) (old-level 0) line txt lastwastext
+ (umax nil)
+ (umax-toc nil)
+ (case-fold-search nil)
+ (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ (filesuffix (or (plist-get export-plist :file-suffix) ".foo"))
+ (filename (concat (file-name-as-directory
+ (org-export-directory :ascii opt-plist))
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory bfname)))
+ filesuffix))
+ (filename (if (equal (file-truename filename)
+ (file-truename bfname))
+ (concat filename filesuffix)
+ filename))
+ (buffer (find-file-noselect filename))
+ (org-levels-open (make-vector org-level-max nil))
+ (odd org-odd-levels-only)
+ (date (plist-get opt-plist :date))
+ (author (plist-get opt-plist :author))
+ (title (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (file-name-sans-extension
+ (file-name-nondirectory bfname))))
+ (email (plist-get opt-plist :email))
+ (language (plist-get opt-plist :language))
+ (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)"))
+ (todo nil)
+ (lang-words nil)
+ (region
+ (buffer-substring
+ (if (org-region-active-p) (region-beginning) (point-min))
+ (if (org-region-active-p) (region-end) (point-max))))
+ (org-export-current-backend 'org-export-generic)
+ (lines (org-split-string
+ (org-export-preprocess-string
+ region
+ :for-backend 'ascii
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get export-plist :drawers-export)
+ :tags (plist-get export-plist :tags-export)
+ :priority (plist-get export-plist :priority-export)
+ :footnotes (plist-get export-plist :footnotes-export)
+ :timestamps (plist-get export-plist :timestamps-export)
+ :todo-keywords (plist-get export-plist :todo-keywords-export)
+ :verbatim-multiline t
+ :select-tags (plist-get export-plist :select-tags-export)
+ :exclude-tags (plist-get export-plist :exclude-tags-export)
+ :emph-multiline t
+ :archived-trees
+ (plist-get export-plist :archived-trees-export)
+ :add-text (plist-get opt-plist :text))
+ "\n"))
+ ;; export-generic plist variables
+ (withtags (plist-get export-plist :tags-export))
+ (tagsintoc (plist-get export-plist :toc-tags-export))
+ (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) ""))
+ (tocdepth (plist-get export-plist :toc-indent-depth))
+ (tocindentchar (plist-get export-plist :toc-indent-char))
+ (tocsecnums (plist-get export-plist :toc-section-numbers))
+ (tocsecnumform (plist-get export-plist :toc-section-number-format))
+ (tocformat (plist-get export-plist :toc-format))
+ (tocformtodo (plist-get export-plist :toc-format-with-todo))
+ (tocprefix (plist-get export-plist :toc-prefix))
+ (tocsuffix (plist-get export-plist :toc-suffix))
+ (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix))
+ (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix))
+ (bodyfixedform (or (plist-get export-plist :body-line-fixed-format)
+ "%s"))
+ (listprefix (plist-get export-plist :body-list-prefix))
+ (listsuffix (plist-get export-plist :body-list-suffix))
+ (listformat (or (plist-get export-plist :body-list-format) "%s\n"))
+ (numlistleavenum
+ (plist-get export-plist :body-number-list-leave-number))
+ (numlistprefix (plist-get export-plist :body-number-list-prefix))
+ (numlistsuffix (plist-get export-plist :body-number-list-suffix))
+ (numlistformat
+ (or (plist-get export-plist :body-number-list-format) "%s\n"))
+ (listchecktodo
+ (or (plist-get export-plist :body-list-checkbox-todo) "\\1"))
+ (listcheckdone
+ (or (plist-get export-plist :body-list-checkbox-done) "\\1"))
+ (listcheckhalf
+ (or (plist-get export-plist :body-list-checkbox-half) "\\1"))
+ (listchecktodoend
+ (or (plist-get export-plist :body-list-checkbox-todo-end) ""))
+ (listcheckdoneend
+ (or (plist-get export-plist :body-list-checkbox-done-end) ""))
+ (listcheckhalfend
+ (or (plist-get export-plist :body-list-checkbox-half-end) ""))
+ (bodytablestart
+ (or (plist-get export-plist :body-table-start) ""))
+ (bodytableend
+ (or (plist-get export-plist :body-table-end) ""))
+ (bodytablerowstart
+ (or (plist-get export-plist :body-table-row-start) ""))
+ (bodytablerowend
+ (or (plist-get export-plist :body-table-row-end) ""))
+ (bodytablecellstart
+ (or (plist-get export-plist :body-table-cell-start) ""))
+ (bodytablecellend
+ (or (plist-get export-plist :body-table-cell-end) ""))
+ (bodytablefirstcellstart
+ (or (plist-get export-plist :body-table-first-cell-start) ""))
+ (bodytableinteriorcellstart
+ (or (plist-get export-plist :body-table-interior-cell-start) ""))
+ (bodytableinteriorcellend
+ (or (plist-get export-plist :body-table-interior-cell-end) ""))
+ (bodytablelastcellend
+ (or (plist-get export-plist :body-table-last-cell-end) ""))
+ (bodytablehlinestart
+ (or (plist-get export-plist :body-table-hline-start) " \\1"))
+ (bodytablehlineend
+ (or (plist-get export-plist :body-table-hline-end) ""))
+
+
+
+ (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph))
+ (bodytextpre (plist-get export-plist :body-text-prefix))
+ (bodytextsuf (plist-get export-plist :body-text-suffix))
+ (bodylinewrap (plist-get export-plist :body-line-wrap))
+ (bodylineform (or (plist-get export-plist :body-line-format) "%s"))
+ (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t"))
+ (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n"))
+
+ ;; dynamic variables used heinously in fontification
+ ;; not referenced locally...
+ (format-boldify (plist-get export-plist :bold-format))
+ (format-italicize (plist-get export-plist :italic-format))
+ (format-underline (plist-get export-plist :underline-format))
+ (format-strikethrough (plist-get export-plist :strikethrough-format))
+ (format-code (plist-get export-plist :code-format))
+ (format-verbatim (plist-get export-plist :verbatim-format))
+
+
+
+ thetoc toctags have-headings first-heading-pos
+ table-open table-buffer link-buffer link desc desc0 rpl wrap)
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (setq org-min-level (org-get-min-level lines level-offset))
+ (setq org-last-level org-min-level)
+ (org-init-section-numbers)
+
+ (find-file-noselect filename)
+
+ (setq lang-words (or (assoc language org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+ (switch-to-buffer-other-window buffer)
+ (erase-buffer)
+ (fundamental-mode)
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (org-set-local 'org-odd-levels-only odd)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc umax)
+
+ ;; File header
+ (if title
+ (insert
+ (org-export-generic-header title export-plist
+ :title-prefix
+ :title-format
+ :title-suffix)))
+
+ (if (and (or author email)
+ (plist-get export-plist :author-export))
+ (insert (concat (nth 1 lang-words) ": " (or author "")
+ (if email (concat " <" email ">") "")
+ "\n")))
+
+ (cond
+ ((and date (string-match "%" date))
+ (setq date (format-time-string date)))
+ (date)
+ (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
+
+ (if (and date (plist-get export-plist :date-export))
+ (insert
+ (org-export-generic-header date export-plist
+ :date-prefix
+ :date-format
+ :date-suffix)))
+
+ ;; export the table of contents first
+ (if (plist-get export-plist :toc-export)
+ (progn
+ (push
+ (org-export-generic-header (nth 3 lang-words) export-plist
+ :toc-header-prefix
+ :toc-header-format
+ :toc-header-suffix)
+ thetoc)
+
+ (if tocprefix
+ (push tocprefix thetoc))
+
+ (mapc '(lambda (line)
+ (if (string-match org-todo-line-regexp line)
+ ;; This is a headline
+ (progn
+ (setq have-headings t)
+ (setq level (- (match-end 1) (match-beginning 1)
+ level-offset)
+ level (org-tr-level level)
+ txt (match-string 3 line)
+ todo
+ (or (and org-export-mark-todo-in-toc
+ (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
+ ; TODO, not DONE
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
+ (org-search-todo-below
+ line lines level))))
+ (setq txt (org-html-expand-for-generic txt))
+
+ (while (string-match org-bracket-link-regexp txt)
+ (setq txt
+ (replace-match
+ (match-string (if (match-end 2) 3 1) txt)
+ t t txt)))
+
+ (if (and (not tagsintoc)
+ (string-match
+ (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
+ txt))
+ (setq txt (replace-match "" t t txt))
+ ; include tags but formated
+ (if (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$")
+ txt)
+ (progn
+ (setq
+ toctags
+ (org-export-generic-header
+ (match-string 1 txt)
+ export-plist :toc-tags-prefix
+ :toc-tags-format :toc-tags-suffix))
+ (string-match
+ (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$")
+ txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq toctags tocnotagsstr)))
+
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+
+ (if (<= level umax-toc)
+ (progn
+ (push
+ (concat
+
+ (make-string
+ (* (max 0 (- level org-min-level)) tocdepth)
+ tocindentchar)
+
+ (if tocsecnums
+ (format tocsecnumform
+ (org-section-number level))
+ "")
+
+ (format
+ (if todo tocformtodo tocformat)
+ txt)
+
+ toctags)
+
+ thetoc)
+ (setq org-last-level level))
+ ))))
+ lines)
+ (if tocsuffix
+ (push tocsuffix thetoc))
+ (setq thetoc (if have-headings (nreverse thetoc) nil))))
+
+ (org-init-section-numbers)
+ (org-export-generic-check-section "top")
+ (while (setq line (pop lines))
+ (when (and link-buffer (string-match org-outline-regexp-bol line))
+ (org-export-generic-push-links (nreverse link-buffer))
+ (setq link-buffer nil))
+ (setq wrap nil)
+ ;; Remove the quoted HTML tags.
+ ;; XXX
+ (setq line (org-html-expand-for-generic line))
+ ;; Replace links with the description when possible
+ ;; XXX
+ (while (string-match org-bracket-link-regexp line)
+ (setq link (match-string 1 line)
+ desc0 (match-string 3 line)
+ desc (or desc0 (match-string 1 line)))
+ (if (and (> (length link) 8)
+ (equal (substring link 0 8) "coderef:"))
+ (setq line (replace-match
+ (format (org-export-get-coderef-format (substring link 8) desc)
+ (cdr (assoc
+ (substring link 8)
+ org-export-code-refs)))
+ t t line))
+ (setq rpl (concat "["
+ (or (match-string 3 line) (match-string 1 line))
+ "]"))
+ (when (and desc0 (not (equal desc0 link)))
+ (if org-export-generic-links-to-notes
+ (push (cons desc0 link) link-buffer)
+ (setq rpl (concat rpl " (" link ")")
+ wrap (+ (length line) (- (length (match-string 0 line)))
+ (length desc)))))
+ (setq line (replace-match rpl t t line))))
+ (when custom-times
+ (setq line (org-translate-time line)))
+ (cond
+ ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
+ ;;
+ ;; a Headline
+ ;;
+ (org-export-generic-check-section "headline")
+
+ (setq first-heading-pos (or first-heading-pos (point)))
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (org-generic-level-start level old-level txt umax export-plist lines)
+ (setq old-level level))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ ;;
+ ;; a Table
+ ;;
+ (org-export-generic-check-section "table")
+
+ (if (not table-open)
+ ;; New table starts
+ (setq table-open t table-buffer nil))
+ ;; Accumulate table lines
+ (setq table-buffer (cons line table-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer))
+ (insert (mapconcat
+ (lambda (x)
+ (org-fix-indentation x org-generic-current-indentation))
+ (org-format-table-generic table-buffer)
+ "\n") "\n")))
+
+ ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)
+ ;;
+ ;; pre-formatted text
+ ;;
+ (setq line (replace-match "\\1" nil nil line))
+
+ (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf)
+
+ (insert (format bodyfixedform line)))
+
+ ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line)
+ ;; if the bullet list item is an asterisk, the leading space is /mandatory/
+ ;; [2010/02/02:rpg]
+ (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line))
+ ;;
+ ;; plain list item
+ ;; TODO: nested lists
+ ;;
+ ;; first add a line break between any previous paragraph or line item and this
+ ;; one
+ (when bodynewline-paragraph
+ (insert bodynewline-paragraph))
+
+ ;; I believe this gets rid of leading whitespace.
+ (setq line (replace-match "" nil nil line))
+
+ ;; won't this insert the suffix /before/ the last line of the list?
+ ;; also isn't it spoofed by bulleted lists that have a line skip between the list items
+ ;; unless 'org-empty-line-terminates-plain-lists' is true?
+ (org-export-generic-check-section "liststart" listprefix listsuffix)
+
+ ;; deal with checkboxes
+ (cond
+ ((string-match "^\\(\\[ \\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listchecktodo nil nil line)
+ listchecktodoend)))
+ ((string-match "^\\(\\[X\\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listcheckdone nil nil line)
+ listcheckdoneend)))
+ ((string-match "^\\(\\[/\\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listcheckhalf nil nil line)
+ listcheckhalfend)))
+ )
+
+ (insert (format listformat (org-export-generic-fontify line))))
+ ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line)
+ ;;
+ ;; numbered list item
+ ;;
+ ;; TODO: nested lists
+ ;;
+ (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line))
+
+ (org-export-generic-check-section "numliststart"
+ numlistprefix numlistsuffix)
+
+ ;; deal with checkboxes
+ ;; TODO: whoops; leaving the numbers is a problem for ^ matching
+ (cond
+ ((string-match "\\(\\[ \\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listchecktodo nil nil line)
+ listchecktodoend)))
+ ((string-match "\\(\\[X\\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listcheckdone nil nil line)
+ listcheckdoneend)))
+ ((string-match "\\(\\[/\\]\\)[ \t]*" line)
+ (setq line (concat (replace-match listcheckhalf nil nil line)
+ listcheckhalfend)))
+ )
+
+ (insert (format numlistformat (org-export-generic-fontify line))))
+
+ ((equal line "ORG-BLOCKQUOTE-START")
+ (setq line blockquotestart))
+ ((equal line "ORG-BLOCKQUOTE-END")
+ (setq line blockquoteend))
+ ((string-match "^\\s-*$" line)
+ ;; blank line
+ (if bodynewline-paragraph
+ (insert bodynewline-paragraph)))
+ (t
+ ;;
+ ;; body
+ ;;
+ (org-export-generic-check-section "body" bodytextpre bodytextsuf)
+
+ (setq line
+ (org-export-generic-fontify line))
+
+ ;; XXX: properties? list?
+ (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line)
+ (setq line (replace-match "\\1\\3:" t nil line)))
+
+ (setq line (org-fix-indentation line org-generic-current-indentation))
+
+ ;; Remove forced line breaks
+ (if (string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (replace-match "" t t line)))
+
+ (if bodylinewrap
+ ;; XXX: was dependent on wrap var which was calculated by???
+ (if (> (length line) bodylinewrap)
+ (setq line
+ (org-export-generic-wrap line bodylinewrap))
+ (setq line line)))
+ (insert (format bodylineform line)))))
+
+ ;; if we're at a level > 0; insert the closing body level stuff
+ (let ((counter 0))
+ (while (> (- level counter) 0)
+ (insert
+ (org-export-generic-format export-plist :body-section-suffix 0
+ (- level counter)))
+ (setq counter (1+ counter))))
+
+ (org-export-generic-check-section "bottom")
+
+ (org-export-generic-push-links (nreverse link-buffer))
+
+ (normal-mode)
+
+ ;; insert the table of contents
+ (when thetoc
+ (goto-char (point-min))
+ (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (replace-match ""))
+ (goto-char first-heading-pos))
+ (mapc 'insert thetoc)
+ (or (looking-at "[ \t]*\n[ \t]*\n")
+ (insert "\n\n")))
+
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (make-string (- end beg) ?\ ))))
+
+ (save-buffer)
+
+ ;; remove display and invisible chars
+ (let (beg end)
+ (goto-char (point-min))
+ (while (setq beg (next-single-property-change (point) 'display))
+ (setq end (next-single-property-change beg 'display))
+ (delete-region beg end)
+ (goto-char beg)
+ (insert "=>"))
+ (goto-char (point-min))
+ (while (setq beg (next-single-property-change (point) 'org-cwidth))
+ (setq end (next-single-property-change beg 'org-cwidth))
+ (delete-region beg end)
+ (goto-char beg)))
+ (goto-char (point-min))))
+
+
+(defun org-export-generic-format (export-plist prop &optional len n reverse)
+ "converts a property specification to a string given types of properties
+
+The EXPORT-PLIST should be defined as the lookup plist.
+The PROP should be the property name to search for in it.
+LEN is set to the length of multi-characters strings to generate (or 0)
+N is the tree depth
+REVERSE means to reverse the list if the plist match is a list
+ "
+ (let* ((prefixtype (plist-get export-plist prop))
+ subtype)
+ (cond
+ ((null prefixtype) "")
+ ((and len (char-or-string-p prefixtype) (not (stringp prefixtype)))
+ ;; sequence of chars
+ (concat (make-string len prefixtype) "\n"))
+ ((stringp prefixtype)
+ prefixtype)
+ ((and n (listp prefixtype))
+ (if reverse
+ (setq prefixtype (reverse prefixtype)))
+ (setq subtype (if (> n (length prefixtype))
+ (car (last prefixtype))
+ (nth (1- n) prefixtype)))
+ (if (stringp subtype)
+ subtype
+ (concat (make-string len subtype) "\n")))
+ (t ""))
+ ))
+
+(defun org-export-generic-header (header export-plist
+ prefixprop formatprop postfixprop
+ &optional n reverse)
+ "convert a header to an output string given formatting property names"
+ (let* ((formatspec (plist-get export-plist formatprop))
+ (len (length header)))
+ (concat
+ (org-export-generic-format export-plist prefixprop len n reverse)
+ (format (or formatspec "%s") header)
+ (org-export-generic-format export-plist postfixprop len n reverse))
+ ))
+
+(defun org-export-generic-preprocess (parameters)
+ "Do extra work for ASCII export"
+ ;; Put quotes around verbatim text
+ (goto-char (point-min))
+ (while (re-search-forward org-verbatim-re nil t)
+ (goto-char (match-end 2))
+ (backward-delete-char 1) (insert "'")
+ (goto-char (match-beginning 2))
+ (delete-char 1) (insert "`")
+ (goto-char (match-end 2)))
+ ;; Remove target markers
+ (goto-char (point-min))
+ (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
+ (replace-match "\\1\\2")))
+
+(defun org-html-expand-for-generic (line)
+ "Handle quoted HTML for ASCII export."
+ (if org-export-html-expand
+ (while (string-match "@<[^<>\n]*>" line)
+ ;; We just remove the tags for now.
+ (setq line (replace-match "" nil nil line))))
+ line)
+
+(defun org-export-generic-wrap (line where)
+ "Wrap LINE at or before WHERE."
+ (let* ((ind (org-get-indentation line))
+ (indstr (make-string ind ?\ ))
+ (len (length line))
+ (result "")
+ pos didfirst)
+ (while (> len where)
+ (catch 'found
+ (loop for i from where downto (/ where 2) do
+ (and (equal (aref line i) ?\ )
+ (setq pos i)
+ (throw 'found t))))
+ (if pos
+ (progn
+ (setq result
+ (concat result
+ (if didfirst indstr "")
+ (substring line 0 pos)
+ "\n"))
+ (setq didfirst t)
+ (setq line (substring line (1+ pos)))
+ (setq len (length line)))
+ (setq result (concat result line))
+ (setq len 0)))
+ (concat result indstr line)))
+
+(defun org-export-generic-push-links (link-buffer)
+ "Push out links in the buffer."
+ (when link-buffer
+ ;; We still have links to push out.
+ (insert "\n")
+ (let ((ind ""))
+ (save-match-data
+ (if (save-excursion
+ (re-search-backward
+ "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t))
+ (setq ind (or (match-string 2)
+ (make-string (length (match-string 3)) ?\ )))))
+ (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
+ link-buffer))
+ (insert "\n")))
+
+(defun org-generic-level-start (level old-level title umax export-plist
+ &optional lines)
+ "Insert a new level in a generic export."
+ (let ((n (- level umax 1))
+ (ind 0)
+ (diff (- level old-level)) (counter 0)
+ (secnums (plist-get export-plist :body-header-section-numbers))
+ (secnumformat
+ (plist-get export-plist :body-header-section-number-format))
+ char tagstring)
+ (unless org-export-with-tags
+ (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
+ (setq title (replace-match "" t t title))))
+
+ (cond
+ ;; going deeper
+ ((> level old-level)
+ (while (< (+ old-level counter) (1- level))
+ (insert
+ (org-export-generic-format export-plist :body-section-prefix 0
+ (+ old-level counter)))
+ (setq counter (1+ counter))
+ ))
+ ;; going up
+ ((< level old-level)
+ (while (> (- old-level counter) (1- level))
+ (insert
+ (org-export-generic-format export-plist :body-section-suffix 0
+ (- old-level counter)))
+ (setq counter (1+ counter))
+ ))
+ ;; same level
+ ((= level old-level)
+ (insert
+ (org-export-generic-format export-plist :body-section-suffix 0 level))
+ )
+ )
+ (insert
+ (org-export-generic-format export-plist :body-section-prefix 0 level))
+
+ (if (and org-export-with-section-numbers
+ secnums
+ (or (not (numberp secnums))
+ (< level secnums)))
+ (setq title
+ (concat (format (or secnumformat "%s ")
+ (org-section-number level)) title)))
+
+ ;; handle tags and formatting
+ (if (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title)
+ (progn
+ (if (plist-get export-plist :body-tags-export)
+ (setq tagstring (org-export-generic-header (match-string 1 title)
+ export-plist
+ :body-tags-prefix
+ :body-tags-format
+ :body-tags-suffix)))
+ (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title)
+ (setq title (replace-match "" t t title)))
+ (setq tagstring (plist-get export-plist :body-tags-none-string)))
+
+ (insert
+ (org-export-generic-header title export-plist
+ :body-section-header-prefix
+ :body-section-header-format
+ :body-section-header-suffix
+ level))
+ (if tagstring
+ (insert tagstring))
+
+ (setq org-generic-current-indentation '(0 . 0))))
+
+(defun org-insert-centered (s &optional underline)
+ "Insert the string S centered and underline it with character UNDERLINE."
+ (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
+ (insert (make-string ind ?\ ) s "\n")
+ (if underline
+ (insert (make-string ind ?\ )
+ (make-string (string-width s) underline)
+ "\n"))))
+
+(defvar org-table-colgroup-info nil)
+(defun org-format-table-generic (lines)
+ "Format a table for ascii export."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (not (string-match "^[ \t]*|" (car lines)))
+ ;; Table made by table.el - test for spanning
+ lines
+
+ ;; A normal org table
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; column and the special lines
+ (setq lines (org-table-clean-before-export lines)))
+ ;; Get rid of the vertical lines except for grouping
+ (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
+ (rtn (list bodytablestart)) line vl1 start)
+ (while (setq line (pop lines))
+ (setq line (concat bodytablerowstart line))
+ (if (string-match org-table-hline-regexp line)
+ (and (string-match "|\\(.*\\)|" line)
+ (setq line (replace-match (concat bodytablehlinestart bodytablehlineend) t nil line)))
+ (setq start 0 vl1 vl)
+ (if (string-match "|\\(.*\\)|" line)
+ (setq line (replace-match (concat bodytablefirstcellstart bodytablecellstart " \\1 " bodytablecellend bodytablelastcellend) t nil line)))
+ (while (string-match "|" line start)
+ (setq start (+ (match-end 0) (length (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart))))
+ (or (pop vl1) (setq line (replace-match (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart) t t line)))))
+ (setq line (concat line bodytablerowend))
+ (push line rtn))
+ (setq rtn (cons bodytableend rtn))
+ (nreverse rtn))))
+
+(defun org-colgroup-info-to-vline-list (info)
+ (let (vl new last)
+ (while info
+ (setq last new new (pop info))
+ (if (or (memq last '(:end :startend))
+ (memq new '(:start :startend)))
+ (push t vl)
+ (push nil vl)))
+ (setq vl (nreverse vl))
+ (and vl (setcar vl nil))
+ vl))
+
+
+;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg]
+(defvar org-export-generic-emphasis-alist
+ '(("*" format-boldify nil)
+ ("/" format-italicize nil)
+ ("_" format-underline nil)
+ ("+" format-strikethrough nil)
+ ("=" format-code t)
+ ("~" format-verbatim t))
+ "Alist of org format -> formatting variables for fontification.
+Each element of the list is a list of three elements.
+The first element is the character used as a marker for fontification.
+The second element is a variable name, set in org-export-generic. That
+variable will be dereferenced to obtain a formatting string to wrap
+fontified text with.
+The third element decides whether to protect converted text from other
+conversions.")
+
+;;; Cargo-culted from the latex translation. I couldn't figure out how
+;;; to keep the structure since the generic export operates on lines, rather
+;;; than on a buffer as in the latex export, meaning that none of the
+;;; search forward code could be kept. This led me to rewrite the
+;;; whole thing recursively. A huge lose for efficiency (potentially),
+;;; but I couldn't figure out how to make the looping work.
+;;; Worse, it's /doubly/ recursive, because this function calls
+;;; org-export-generic-emph-format, which can call it recursively...
+;;; [2010/05/20:rpg]
+(defun org-export-generic-fontify (string)
+ "Convert fontification according to generic rules."
+ (if (string-match org-emph-re string)
+ ;; The match goes one char after the *string*, except at the end of a line
+ (let ((emph (assoc (match-string 3 string)
+ org-export-generic-emphasis-alist))
+ (beg (match-beginning 0))
+ (end (match-end 0)))
+ (unless emph
+ (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\""
+ (match-string 3 string)))
+ ;; now we need to determine whether we have strikethrough or
+ ;; a list, which is a bit nasty
+ (if (and (equal (match-string 3 string) "+")
+ (save-match-data
+ (string-match "\\`-+\\'" (match-string 4 string))))
+ ;; a list --- skip this match and recurse on the point after the
+ ;; first emph char...
+ (concat (substring string 0 (1+ (match-beginning 3)))
+ (org-export-generic-fontify (substring string (match-beginning 3))))
+ (concat (substring string 0 beg) ;; part before the match
+ (match-string 1 string)
+ (org-export-generic-emph-format (second emph)
+ (match-string 4 string)
+ (third emph))
+ (or (match-string 5 string) "")
+ (org-export-generic-fontify (substring string end)))))
+ string))
+
+(defun org-export-generic-emph-format (format-varname string protect)
+ "Return a string that results from applying the markup indicated by
+FORMAT-VARNAME to STRING."
+ (let ((format (symbol-value format-varname)))
+ (let ((string-to-emphasize
+ (if protect
+ string
+ (org-export-generic-fontify string))))
+ (if format
+ (format format string-to-emphasize)
+ string-to-emphasize))))
+
+(provide 'org-generic)
+(provide 'org-export-generic)
+
+;;; org-export-generic.el ends here
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
new file mode 100644
index 0000000..4f01b7e
--- /dev/null
+++ b/contrib/lisp/org-export.el
@@ -0,0 +1,4518 @@
+;;; org-export.el --- Generic Export Engine For Org
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a generic export engine for Org, built on
+;; its syntactical parser: Org Elements.
+;;
+;; Besides that parser, the generic exporter is made of three distinct
+;; parts:
+;;
+;; - The communication channel consists in a property list, which is
+;; created and updated during the process. Its use is to offer
+;; every piece of information, would it be about initial environment
+;; or contextual data, all in a single place. The exhaustive list
+;; of properties is given in "The Communication Channel" section of
+;; this file.
+;;
+;; - The transcoder walks the parse tree, ignores or treat as plain
+;; text elements and objects according to export options, and
+;; eventually calls back-end specific functions to do the real
+;; transcoding, concatenating their return value along the way.
+;;
+;; - The filter system is activated at the very beginning and the very
+;; end of the export process, and each time an element or an object
+;; has been converted. It is the entry point to fine-tune standard
+;; output from back-end transcoders. See "The Filter System"
+;; section for more information.
+;;
+;; The core function is `org-export-as'. It returns the transcoded
+;; buffer as a string.
+;;
+;; An export back-end is defined with `org-export-define-backend',
+;; which sets one mandatory variable: his translation table. Its name
+;; is always `org-BACKEND-translate-alist' where BACKEND stands for
+;; the name chosen for the back-end. Its value is an alist whose keys
+;; are elements and objects types and values translator functions.
+;; See function's docstring for more information about translators.
+;;
+;; Optionally, `org-export-define-backend' can also support specific
+;; buffer keywords, OPTION keyword's items and filters. Also refer to
+;; function documentation for more information.
+;;
+;; If the new back-end shares most properties with another one,
+;; `org-export-define-derived-backend' can be used to simplify the
+;; process.
+;;
+;; Any back-end can define its own variables. Among them, those
+;; customizable should belong to the `org-export-BACKEND' group.
+;;
+;; Tools for common tasks across back-ends are implemented in the
+;; penultimate part of this file. A dispatcher for standard back-ends
+;; is provided in the last one.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-element)
+
+
+(declare-function org-e-ascii-export-as-ascii "org-e-ascii"
+ (&optional subtreep visible-only body-only ext-plist))
+(declare-function org-e-ascii-export-to-ascii "org-e-ascii"
+ (&optional subtreep visible-only body-only ext-plist pub-dir))
+(declare-function org-e-html-export-as-html "org-e-html"
+ (&optional subtreep visible-only body-only ext-plist))
+(declare-function org-e-html-export-to-html "org-e-html"
+ (&optional subtreep visible-only body-only ext-plist pub-dir))
+(declare-function org-e-latex-export-as-latex "org-e-latex"
+ (&optional subtreep visible-only body-only ext-plist))
+(declare-function org-e-latex-export-to-latex "org-e-latex"
+ (&optional subtreep visible-only body-only ext-plist pub-dir))
+(declare-function org-e-latex-export-to-pdf "org-e-latex"
+ (&optional subtreep visible-only body-only ext-plist pub-dir))
+(declare-function org-e-odt-export-to-odt "org-e-odt"
+ (&optional subtreep visible-only body-only ext-plist pub-dir))
+(declare-function org-e-publish "org-e-publish" (project &optional force))
+(declare-function org-e-publish-all "org-e-publish" (&optional force))
+(declare-function org-e-publish-current-file "org-e-publish" (&optional force))
+(declare-function org-e-publish-current-project "org-e-publish"
+ (&optional force))
+(declare-function org-export-blocks-preprocess "org-exp-blocks")
+
+(defvar org-e-publish-project-alist)
+(defvar org-table-number-fraction)
+(defvar org-table-number-regexp)
+
+
+
+;;; Internal Variables
+;;
+;; Among internal variables, the most important is
+;; `org-export-options-alist'. This variable define the global export
+;; options, shared between every exporter, and how they are acquired.
+
+(defconst org-export-max-depth 19
+ "Maximum nesting depth for headlines, counting from 0.")
+
+(defconst org-export-options-alist
+ '((:author "AUTHOR" nil user-full-name t)
+ (:creator "CREATOR" nil org-export-creator-string)
+ (:date "DATE" nil nil t)
+ (:description "DESCRIPTION" nil nil newline)
+ (:email "EMAIL" nil user-mail-address t)
+ (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split)
+ (:headline-levels nil "H" org-export-headline-levels)
+ (:keywords "KEYWORDS" nil nil space)
+ (:language "LANGUAGE" nil org-export-default-language t)
+ (:preserve-breaks nil "\\n" org-export-preserve-breaks)
+ (:section-numbers nil "num" org-export-with-section-numbers)
+ (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
+ (:time-stamp-file nil "timestamp" org-export-time-stamp-file)
+ (:title "TITLE" nil nil space)
+ (:with-archived-trees nil "arch" org-export-with-archived-trees)
+ (:with-author nil "author" org-export-with-author)
+ (:with-clocks nil "c" org-export-with-clocks)
+ (:with-creator nil "creator" org-export-with-creator)
+ (:with-drawers nil "d" org-export-with-drawers)
+ (:with-email nil "email" org-export-with-email)
+ (:with-emphasize nil "*" org-export-with-emphasize)
+ (:with-entities nil "e" org-export-with-entities)
+ (:with-fixed-width nil ":" org-export-with-fixed-width)
+ (:with-footnotes nil "f" org-export-with-footnotes)
+ (:with-inlinetasks nil "inline" org-export-with-inlinetasks)
+ (:with-plannings nil "p" org-export-with-planning)
+ (:with-priority nil "pri" org-export-with-priority)
+ (:with-special-strings nil "-" org-export-with-special-strings)
+ (:with-sub-superscript nil "^" org-export-with-sub-superscripts)
+ (:with-toc nil "toc" org-export-with-toc)
+ (:with-tables nil "|" org-export-with-tables)
+ (:with-tags nil "tags" org-export-with-tags)
+ (:with-tasks nil "tasks" org-export-with-tasks)
+ (:with-timestamps nil "<" org-export-with-timestamps)
+ (:with-todo-keywords nil "todo" org-export-with-todo-keywords))
+ "Alist between export properties and ways to set them.
+
+The CAR of the alist is the property name, and the CDR is a list
+like (KEYWORD OPTION DEFAULT BEHAVIOUR) where:
+
+KEYWORD is a string representing a buffer keyword, or nil. Each
+ property defined this way can also be set, during subtree
+ export, through an headline property named after the keyword
+ with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE
+ property).
+OPTION is a string that could be found in an #+OPTIONS: line.
+DEFAULT is the default value for the property.
+BEHAVIOUR determine how Org should handle multiple keywords for
+ the same property. It is a symbol among:
+ nil Keep old value and discard the new one.
+ t Replace old value with the new one.
+ `space' Concatenate the values, separating them with a space.
+ `newline' Concatenate the values, separating them with
+ a newline.
+ `split' Split values at white spaces, and cons them to the
+ previous list.
+
+KEYWORD and OPTION have precedence over DEFAULT.
+
+All these properties should be back-end agnostic. Back-end
+specific properties are set through `org-export-define-backend'.
+Properties redefined there have precedence over these.")
+
+(defconst org-export-special-keywords
+ '("SETUP_FILE" "OPTIONS" "MACRO")
+ "List of in-buffer keywords that require special treatment.
+These keywords are not directly associated to a property. The
+way they are handled must be hard-coded into
+`org-export--get-inbuffer-options' function.")
+
+(defconst org-export-filters-alist
+ '((:filter-bold . org-export-filter-bold-functions)
+ (:filter-babel-call . org-export-filter-babel-call-functions)
+ (:filter-center-block . org-export-filter-center-block-functions)
+ (:filter-clock . org-export-filter-clock-functions)
+ (:filter-code . org-export-filter-code-functions)
+ (:filter-comment . org-export-filter-comment-functions)
+ (:filter-comment-block . org-export-filter-comment-block-functions)
+ (:filter-drawer . org-export-filter-drawer-functions)
+ (:filter-dynamic-block . org-export-filter-dynamic-block-functions)
+ (:filter-entity . org-export-filter-entity-functions)
+ (:filter-example-block . org-export-filter-example-block-functions)
+ (:filter-export-block . org-export-filter-export-block-functions)
+ (:filter-export-snippet . org-export-filter-export-snippet-functions)
+ (:filter-final-output . org-export-filter-final-output-functions)
+ (:filter-fixed-width . org-export-filter-fixed-width-functions)
+ (:filter-footnote-definition . org-export-filter-footnote-definition-functions)
+ (:filter-footnote-reference . org-export-filter-footnote-reference-functions)
+ (:filter-headline . org-export-filter-headline-functions)
+ (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions)
+ (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions)
+ (:filter-inline-src-block . org-export-filter-inline-src-block-functions)
+ (:filter-inlinetask . org-export-filter-inlinetask-functions)
+ (:filter-italic . org-export-filter-italic-functions)
+ (:filter-item . org-export-filter-item-functions)
+ (:filter-keyword . org-export-filter-keyword-functions)
+ (:filter-latex-environment . org-export-filter-latex-environment-functions)
+ (:filter-latex-fragment . org-export-filter-latex-fragment-functions)
+ (:filter-line-break . org-export-filter-line-break-functions)
+ (:filter-link . org-export-filter-link-functions)
+ (:filter-macro . org-export-filter-macro-functions)
+ (:filter-paragraph . org-export-filter-paragraph-functions)
+ (:filter-parse-tree . org-export-filter-parse-tree-functions)
+ (:filter-plain-list . org-export-filter-plain-list-functions)
+ (:filter-plain-text . org-export-filter-plain-text-functions)
+ (:filter-planning . org-export-filter-planning-functions)
+ (:filter-property-drawer . org-export-filter-property-drawer-functions)
+ (:filter-quote-block . org-export-filter-quote-block-functions)
+ (:filter-quote-section . org-export-filter-quote-section-functions)
+ (:filter-radio-target . org-export-filter-radio-target-functions)
+ (:filter-section . org-export-filter-section-functions)
+ (:filter-special-block . org-export-filter-special-block-functions)
+ (:filter-src-block . org-export-filter-src-block-functions)
+ (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions)
+ (:filter-strike-through . org-export-filter-strike-through-functions)
+ (:filter-subscript . org-export-filter-subscript-functions)
+ (:filter-superscript . org-export-filter-superscript-functions)
+ (:filter-table . org-export-filter-table-functions)
+ (:filter-table-cell . org-export-filter-table-cell-functions)
+ (:filter-table-row . org-export-filter-table-row-functions)
+ (:filter-target . org-export-filter-target-functions)
+ (:filter-timestamp . org-export-filter-timestamp-functions)
+ (:filter-underline . org-export-filter-underline-functions)
+ (:filter-verbatim . org-export-filter-verbatim-functions)
+ (:filter-verse-block . org-export-filter-verse-block-functions))
+ "Alist between filters properties and initial values.
+
+The key of each association is a property name accessible through
+the communication channel. Its value is a configurable global
+variable defining initial filters.
+
+This list is meant to install user specified filters. Back-end
+developers may install their own filters using
+`org-export-define-backend'. Filters defined there will always
+be prepended to the current list, so they always get applied
+first.")
+
+(defconst org-export-default-inline-image-rule
+ `(("file" .
+ ,(format "\\.%s\\'"
+ (regexp-opt
+ '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm"
+ "xpm" "pbm" "pgm" "ppm") t))))
+ "Default rule for link matching an inline image.
+This rule applies to links with no description. By default, it
+will be considered as an inline image if it targets a local file
+whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\",
+\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\".
+See `org-export-inline-image-p' for more information about
+rules.")
+
+
+
+;;; User-configurable Variables
+;;
+;; Configuration for the masses.
+;;
+;; They should never be accessed directly, as their value is to be
+;; stored in a property list (cf. `org-export-options-alist').
+;; Back-ends will read their value from there instead.
+
+(defgroup org-export nil
+ "Options for exporting Org mode files."
+ :tag "Org Export"
+ :group 'org)
+
+(defgroup org-export-general nil
+ "General options for export engine."
+ :tag "Org Export General"
+ :group 'org-export)
+
+(defcustom org-export-with-archived-trees 'headline
+ "Whether sub-trees with the ARCHIVE tag should be exported.
+
+This can have three different values:
+nil Do not export, pretend this tree is not present.
+t Do export the entire tree.
+`headline' Only export the headline, but skip the tree below it.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"arch:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Not at all" nil)
+ (const :tag "Headline only" 'headline)
+ (const :tag "Entirely" t)))
+
+(defcustom org-export-with-author t
+ "Non-nil means insert author name into the exported file.
+This option can also be set with the #+OPTIONS line,
+e.g. \"author:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-clocks nil
+ "Non-nil means export CLOCK keywords.
+This option can also be set with the #+OPTIONS line,
+e.g. \"c:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-creator 'comment
+ "Non-nil means the postamble should contain a creator sentence.
+
+The sentence can be set in `org-export-creator-string' and
+defaults to \"Generated by Org mode XX in Emacs XXX.\".
+
+If the value is `comment' insert it as a comment."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "No creator sentence" nil)
+ (const :tag "Sentence as a comment" 'comment)
+ (const :tag "Insert the sentence" t)))
+
+(defcustom org-export-creator-string
+ (format "Generated by Org mode %s in Emacs %s."
+ (if (fboundp 'org-version) (org-version) "(Unknown)")
+ emacs-version)
+ "String to insert at the end of the generated document."
+ :group 'org-export-general
+ :type '(string :tag "Creator string"))
+
+(defcustom org-export-with-drawers t
+ "Non-nil means export contents of standard drawers.
+
+When t, all drawers are exported. This may also be a list of
+drawer names to export. This variable doesn't apply to
+properties drawers.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"d:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))))
+
+(defcustom org-export-with-email nil
+ "Non-nil means insert author email into the exported file.
+This option can also be set with the #+OPTIONS line,
+e.g. \"email:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-emphasize t
+ "Non-nil means interpret *word*, /word/, and _word_ as emphasized text.
+
+If the export target supports emphasizing text, the word will be
+typeset in bold, italic, or underlined, respectively. Not all
+export backends support this.
+
+This option can also be set with the #+OPTIONS line, e.g. \"*:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-exclude-tags '("noexport")
+ "Tags that exclude a tree from export.
+
+All trees carrying any of these tags will be excluded from
+export. This is without condition, so even subtrees inside that
+carry one of the `org-export-select-tags' will be removed.
+
+This option can also be set with the #+EXCLUDE_TAGS: keyword."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-export-with-fixed-width t
+ "Non-nil means lines starting with \":\" will be in fixed width font.
+
+This can be used to have pre-formatted text, fragments of code
+etc. For example:
+ : ;; Some Lisp examples
+ : (while (defc cnt)
+ : (ding))
+will be looking just like this in also HTML. See also the QUOTE
+keyword. Not all export backends support this.
+
+This option can also be set with the #+OPTIONS line, e.g. \"::nil\"."
+ :group 'org-export-translation
+ :type 'boolean)
+
+(defcustom org-export-with-footnotes t
+ "Non-nil means Org footnotes should be exported.
+This option can also be set with the #+OPTIONS line,
+e.g. \"f:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-headline-levels 3
+ "The last level which is still exported as a headline.
+
+Inferior levels will produce itemize lists when exported.
+
+This option can also be set with the #+OPTIONS line, e.g. \"H:2\"."
+ :group 'org-export-general
+ :type 'integer)
+
+(defcustom org-export-default-language "en"
+ "The default language for export and clocktable translations, as a string.
+This may have an association in
+`org-clock-clocktable-language-setup'."
+ :group 'org-export-general
+ :type '(string :tag "Language"))
+
+(defcustom org-export-preserve-breaks nil
+ "Non-nil means preserve all line breaks when exporting.
+
+Normally, in HTML output paragraphs will be reformatted.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"\\n:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-entities t
+ "Non-nil means interpret entities when exporting.
+
+For example, HTML export converts \\alpha to &alpha; and \\AA to
+&Aring;.
+
+For a list of supported names, see the constant `org-entities'
+and the user option `org-entities-user'.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"e:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-inlinetasks t
+ "Non-nil means inlinetasks should be exported.
+This option can also be set with the #+OPTIONS line,
+e.g. \"inline:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-planning nil
+ "Non-nil means include planning info in export.
+This option can also be set with the #+OPTIONS: line,
+e.g. \"p:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-priority nil
+ "Non-nil means include priority cookies in export.
+This option can also be set with the #+OPTIONS line,
+e.g. \"pri:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-section-numbers t
+ "Non-nil means add section numbers to headlines when exporting.
+
+When set to an integer n, numbering will only happen for
+headlines whose relative level is higher or equal to n.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"num:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-select-tags '("export")
+ "Tags that select a tree for export.
+
+If any such tag is found in a buffer, all trees that do not carry
+one of these tags will be ignored during export. Inside trees
+that are selected like this, you can still deselect a subtree by
+tagging it with one of the `org-export-exclude-tags'.
+
+This option can also be set with the #+SELECT_TAGS: keyword."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-export-with-special-strings t
+ "Non-nil means interpret \"\-\", \"--\" and \"---\" for export.
+
+When this option is turned on, these strings will be exported as:
+
+ Org HTML LaTeX
+ -----+----------+--------
+ \\- &shy; \\-
+ -- &ndash; --
+ --- &mdash; ---
+ ... &hellip; \ldots
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"-:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-sub-superscripts t
+ "Non-nil means interpret \"_\" and \"^\" for export.
+
+When this option is turned on, you can use TeX-like syntax for
+sub- and superscripts. Several characters after \"_\" or \"^\"
+will be considered as a single item - so grouping with {} is
+normally not needed. For example, the following things will be
+parsed as single sub- or superscripts.
+
+ 10^24 or 10^tau several digits will be considered 1 item.
+ 10^-12 or 10^-tau a leading sign with digits or a word
+ x^2-y^3 will be read as x^2 - y^3, because items are
+ terminated by almost any nonword/nondigit char.
+ x_{i^2} or x^(2-i) braces or parenthesis do grouping.
+
+Still, ambiguity is possible - so when in doubt use {} to enclose
+the sub/superscript. If you set this variable to the symbol
+`{}', the braces are *required* in order to trigger
+interpretations as sub/superscript. This can be helpful in
+documents that need \"_\" frequently in plain text.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"^:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Interpret them" t)
+ (const :tag "Curly brackets only" {})
+ (const :tag "Do not interpret them" nil)))
+
+(defcustom org-export-with-toc t
+ "Non-nil means create a table of contents in exported files.
+
+The TOC contains headlines with levels up
+to`org-export-headline-levels'. When an integer, include levels
+up to N in the toc, this may then be different from
+`org-export-headline-levels', but it will not be allowed to be
+larger than the number of headline levels. When nil, no table of
+contents is made.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"toc:nil\" or \"toc:3\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "No Table of Contents" nil)
+ (const :tag "Full Table of Contents" t)
+ (integer :tag "TOC to level")))
+
+(defcustom org-export-with-tables t
+ "If non-nil, lines starting with \"|\" define a table.
+For example:
+
+ | Name | Address | Birthday |
+ |-------------+----------+-----------|
+ | Arthur Dent | England | 29.2.2100 |
+
+This option can also be set with the #+OPTIONS line, e.g. \"|:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-tags t
+ "If nil, do not export tags, just remove them from headlines.
+
+If this is the symbol `not-in-toc', tags will be removed from
+table of contents entries, but still be shown in the headlines of
+the document.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"tags:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Off" nil)
+ (const :tag "Not in TOC" not-in-toc)
+ (const :tag "On" t)))
+
+(defcustom org-export-with-tasks t
+ "Non-nil means include TODO items for export.
+This may have the following values:
+t include tasks independent of state.
+todo include only tasks that are not yet done.
+done include only tasks that are already done.
+nil remove all tasks before export
+list of keywords keep only tasks with these keywords"
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All tasks" t)
+ (const :tag "No tasks" nil)
+ (const :tag "Not-done tasks" todo)
+ (const :tag "Only done tasks" done)
+ (repeat :tag "Specific TODO keywords"
+ (string :tag "Keyword"))))
+
+(defcustom org-export-time-stamp-file t
+ "Non-nil means insert a time stamp into the exported file.
+The time stamp shows when the file was created.
+
+This option can also be set with the #+OPTIONS line,
+e.g. \"timestamp:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-timestamps t
+ "Non nil means allow timestamps in export.
+
+It can be set to `active', `inactive', t or nil, in order to
+export, respectively, only active timestamps, only inactive ones,
+all of them or none.
+
+This option can also be set with the #+OPTIONS line, e.g.
+\"<:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All timestamps" t)
+ (const :tag "Only active timestamps" active)
+ (const :tag "Only inactive timestamps" inactive)
+ (const :tag "No timestamp" nil)))
+
+(defcustom org-export-with-todo-keywords t
+ "Non-nil means include TODO keywords in export.
+When nil, remove all these keywords from the export."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-allow-BIND 'confirm
+ "Non-nil means allow #+BIND to define local variable values for export.
+This is a potential security risk, which is why the user must
+confirm the use of these lines."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Ask a confirmation for each file" confirm)))
+
+(defcustom org-export-snippet-translation-alist nil
+ "Alist between export snippets back-ends and exporter back-ends.
+
+This variable allows to provide shortcuts for export snippets.
+
+For example, with a value of '\(\(\"h\" . \"e-html\"\)\), the
+HTML back-end will recognize the contents of \"@@h:<b>@@\" as
+HTML code while every other back-end will ignore it."
+ :group 'org-export-general
+ :type '(repeat
+ (cons
+ (string :tag "Shortcut")
+ (string :tag "Back-end"))))
+
+(defcustom org-export-coding-system nil
+ "Coding system for the exported file."
+ :group 'org-export-general
+ :type 'coding-system)
+
+(defcustom org-export-copy-to-kill-ring t
+ "Non-nil means exported stuff will also be pushed onto the kill ring."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-initial-scope 'buffer
+ "The initial scope when exporting with `org-export-dispatch'.
+This variable can be either set to `buffer' or `subtree'."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Export current buffer" 'buffer)
+ (const :tag "Export current subtree" 'subtree)))
+
+(defcustom org-export-show-temporary-export-buffer t
+ "Non-nil means show buffer after exporting to temp buffer.
+When Org exports to a file, the buffer visiting that file is ever
+shown, but remains buried. However, when exporting to
+a temporary buffer, that buffer is popped up in a second window.
+When this variable is nil, the buffer remains buried also in
+these cases."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-dispatch-use-expert-ui nil
+ "Non-nil means using a non-intrusive `org-export-dispatch'.
+In that case, no help buffer is displayed. Though, an indicator
+for current export scope is added to the prompt \(i.e. \"b\" when
+output is restricted to body only, \"s\" when it is restricted to
+the current subtree and \"v\" when only visible elements are
+considered for export\). Also, \[?] allows to switch back to
+standard mode."
+ :group 'org-export-general
+ :type 'boolean)
+
+
+
+;;; Defining New Back-ends
+
+(defmacro org-export-define-backend (backend translators &rest body)
+ "Define a new back-end BACKEND.
+
+TRANSLATORS is an alist between object or element types and
+functions handling them.
+
+These functions should return a string without any trailing
+space, or nil. They must accept three arguments: the object or
+element itself, its contents or nil when it isn't recursive and
+the property list used as a communication channel.
+
+Contents, when not nil, are stripped from any global indentation
+\(although the relative one is preserved). They also always end
+with a single newline character.
+
+If, for a given type, no function is found, that element or
+object type will simply be ignored, along with any blank line or
+white space at its end. The same will happen if the function
+returns the nil value. If that function returns the empty
+string, the type will be ignored, but the blank lines or white
+spaces will be kept.
+
+In addition to element and object types, one function can be
+associated to the `template' symbol and another one to the
+`plain-text' symbol.
+
+The former returns the final transcoded string, and can be used
+to add a preamble and a postamble to document's body. It must
+accept two arguments: the transcoded string and the property list
+containing export options.
+
+The latter, when defined, is to be called on every text not
+recognized as an element or an object. It must accept two
+arguments: the text string and the information channel. It is an
+appropriate place to protect special chars relative to the
+back-end.
+
+BODY can start with pre-defined keyword arguments. The following
+keywords are understood:
+
+ :export-block
+
+ String, or list of strings, representing block names that
+ will not be parsed. This is used to specify blocks that will
+ contain raw code specific to the back-end. These blocks
+ still have to be handled by the relative `export-block' type
+ translator.
+
+ :filters-alist
+
+ Alist between filters and function, or list of functions,
+ specific to the back-end. See `org-export-filters-alist' for
+ a list of all allowed filters. Filters defined here
+ shouldn't make a back-end test, as it may prevent back-ends
+ derived from this one to behave properly.
+
+ :options-alist
+
+ Alist between back-end specific properties introduced in
+ communication channel and how their value are acquired. See
+ `org-export-options-alist' for more information about
+ structure of the values.
+
+As an example, here is how the `e-ascii' back-end is defined:
+
+\(org-export-define-backend e-ascii
+ \((bold . org-e-ascii-bold)
+ \(center-block . org-e-ascii-center-block)
+ \(clock . org-e-ascii-clock)
+ \(code . org-e-ascii-code)
+ \(drawer . org-e-ascii-drawer)
+ \(dynamic-block . org-e-ascii-dynamic-block)
+ \(entity . org-e-ascii-entity)
+ \(example-block . org-e-ascii-example-block)
+ \(export-block . org-e-ascii-export-block)
+ \(export-snippet . org-e-ascii-export-snippet)
+ \(fixed-width . org-e-ascii-fixed-width)
+ \(footnote-definition . org-e-ascii-footnote-definition)
+ \(footnote-reference . org-e-ascii-footnote-reference)
+ \(headline . org-e-ascii-headline)
+ \(horizontal-rule . org-e-ascii-horizontal-rule)
+ \(inline-src-block . org-e-ascii-inline-src-block)
+ \(inlinetask . org-e-ascii-inlinetask)
+ \(italic . org-e-ascii-italic)
+ \(item . org-e-ascii-item)
+ \(keyword . org-e-ascii-keyword)
+ \(latex-environment . org-e-ascii-latex-environment)
+ \(latex-fragment . org-e-ascii-latex-fragment)
+ \(line-break . org-e-ascii-line-break)
+ \(link . org-e-ascii-link)
+ \(macro . org-e-ascii-macro)
+ \(paragraph . org-e-ascii-paragraph)
+ \(plain-list . org-e-ascii-plain-list)
+ \(plain-text . org-e-ascii-plain-text)
+ \(planning . org-e-ascii-planning)
+ \(property-drawer . org-e-ascii-property-drawer)
+ \(quote-block . org-e-ascii-quote-block)
+ \(quote-section . org-e-ascii-quote-section)
+ \(radio-target . org-e-ascii-radio-target)
+ \(section . org-e-ascii-section)
+ \(special-block . org-e-ascii-special-block)
+ \(src-block . org-e-ascii-src-block)
+ \(statistics-cookie . org-e-ascii-statistics-cookie)
+ \(strike-through . org-e-ascii-strike-through)
+ \(subscript . org-e-ascii-subscript)
+ \(superscript . org-e-ascii-superscript)
+ \(table . org-e-ascii-table)
+ \(table-cell . org-e-ascii-table-cell)
+ \(table-row . org-e-ascii-table-row)
+ \(target . org-e-ascii-target)
+ \(template . org-e-ascii-template)
+ \(timestamp . org-e-ascii-timestamp)
+ \(underline . org-e-ascii-underline)
+ \(verbatim . org-e-ascii-verbatim)
+ \(verse-block . org-e-ascii-verse-block))
+ :export-block \"ASCII\"
+ :filters-alist ((:filter-headline . org-e-ascii-filter-headline-blank-lines)
+ \(:filter-section . org-e-ascii-filter-headline-blank-lines))
+ :options-alist ((:ascii-charset nil nil org-e-ascii-charset)))"
+ (declare (debug (&define name sexp [&rest [keywordp sexp]] defbody))
+ (indent 1))
+ (let (filters options export-block)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq export-block
+ (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:options-alist (setq options (pop body)))
+ (t (pop body))))
+ `(progn
+ ;; Define translators.
+ (defvar ,(intern (format "org-%s-translate-alist" backend)) ',translators
+ "Alist between element or object types and translators.")
+ ;; Define options.
+ ,(when options
+ `(defconst ,(intern (format "org-%s-options-alist" backend)) ',options
+ ,(format "Alist between %s export properties and ways to set them.
+See `org-export-options-alist' for more information on the
+structure of the values."
+ backend)))
+ ;; Define filters.
+ ,(when filters
+ `(defconst ,(intern (format "org-%s-filters-alist" backend)) ',filters
+ "Alist between filters keywords and back-end specific filters.
+See `org-export-filters-alist' for more information."))
+ ;; Tell parser to not parse EXPORT-BLOCK blocks.
+ ,(when export-block
+ `(mapc
+ (lambda (name)
+ (add-to-list 'org-element-block-name-alist
+ `(,name . org-element-export-block-parser)))
+ ',export-block))
+ ;; Splice in the body, if any.
+ ,@body)))
+
+(defmacro org-export-define-derived-backend (child parent &rest body)
+ "Create a new back-end as a variant of an existing one.
+
+CHILD is the name of the derived back-end. PARENT is the name of
+the parent back-end.
+
+BODY can start with pre-defined keyword arguments. The following
+keywords are understood:
+
+ :export-block
+
+ String, or list of strings, representing block names that
+ will not be parsed. This is used to specify blocks that will
+ contain raw code specific to the back-end. These blocks
+ still have to be handled by the relative `export-block' type
+ translator.
+
+ :filters-alist
+
+ Alist of filters that will overwrite or complete filters
+ defined in PARENT back-end. See `org-export-filters-alist'
+ for more a list of allowed filters.
+
+ :options-alist
+
+ Alist of back-end specific properties that will overwrite or
+ complete those defined in PARENT back-end. Refer to
+ `org-export-options-alist' for more information about
+ structure of the values.
+
+ :translate-alist
+
+ Alist of element and object types and transcoders that will
+ overwrite or complete transcode table from PARENT back-end.
+ Refer to `org-export-define-backend' for detailed information
+ about transcoders.
+
+As an example, here is how one could define \"my-latex\" back-end
+as a variant of `e-latex' back-end with a custom template
+function:
+
+ \(org-export-define-derived-backend my-latex e-latex
+ :translate-alist ((template . my-latex-template-fun)))
+
+The back-end could then be called with, for example:
+
+ \(org-export-to-buffer 'my-latex \"*Test my-latex*\")"
+ (declare (debug (&define name sexp [&rest [keywordp sexp]] def-body))
+ (indent 2))
+ (let (filters options translate export-block)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq export-block
+ (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:options-alist (setq options (pop body)))
+ (:translate-alist (setq translate (pop body)))
+ (t (pop body))))
+ `(progn
+ ;; Tell parser to not parse EXPORT-BLOCK blocks.
+ ,(when export-block
+ `(mapc
+ (lambda (name)
+ (add-to-list 'org-element-block-name-alist
+ `(,name . org-element-export-block-parser)))
+ ',export-block))
+ ;; Define filters.
+ ,(let ((parent-filters (intern (format "org-%s-filters-alist" parent))))
+ (when (or (boundp parent-filters) filters)
+ `(defconst ,(intern (format "org-%s-filters-alist" child))
+ ',(append filters
+ (and (boundp parent-filters)
+ (copy-sequence (symbol-value parent-filters))))
+ "Alist between filters keywords and back-end specific filters.
+See `org-export-filters-alist' for more information.")))
+ ;; Define options.
+ ,(let ((parent-options (intern (format "org-%s-options-alist" parent))))
+ (when (or (boundp parent-options) options)
+ `(defconst ,(intern (format "org-%s-options-alist" child))
+ ',(append options
+ (and (boundp parent-options)
+ (copy-sequence (symbol-value parent-options))))
+ ,(format "Alist between %s export properties and ways to set them.
+See `org-export-options-alist' for more information on the
+structure of the values."
+ child))))
+ ;; Define translators.
+ (defvar ,(intern (format "org-%s-translate-alist" child))
+ ',(append translate
+ (copy-sequence
+ (symbol-value
+ (intern (format "org-%s-translate-alist" parent)))))
+ "Alist between element or object types and translators.")
+ ;; Splice in the body, if any.
+ ,@body)))
+
+
+
+;;; The Communication Channel
+;;
+;; During export process, every function has access to a number of
+;; properties. They are of two types:
+;;
+;; 1. Environment options are collected once at the very beginning of
+;; the process, out of the original buffer and configuration.
+;; Collecting them is handled by `org-export-get-environment'
+;; function.
+;;
+;; Most environment options are defined through the
+;; `org-export-options-alist' variable.
+;;
+;; 2. Tree properties are extracted directly from the parsed tree,
+;; just before export, by `org-export-collect-tree-properties'.
+;;
+;; Here is the full list of properties available during transcode
+;; process, with their category (option, tree or local) and their
+;; value type.
+;;
+;; + `:author' :: Author's name.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:back-end' :: Current back-end used for transcoding.
+;; - category :: tree
+;; - type :: symbol
+;;
+;; + `:creator' :: String to write as creation information.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:date' :: String to use as date.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:description' :: Description text for the current data.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:email' :: Author's email.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:exclude-tags' :: Tags for exclusion of subtrees from export
+;; process.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `:exported-data' :: Hash table used for memoizing
+;; `org-export-data'.
+;; - category :: tree
+;; - type :: hash table
+;;
+;; + `:footnote-definition-alist' :: Alist between footnote labels and
+;; their definition, as parsed data. Only non-inlined footnotes
+;; are represented in this alist. Also, every definition isn't
+;; guaranteed to be referenced in the parse tree. The purpose of
+;; this property is to preserve definitions from oblivion
+;; (i.e. when the parse tree comes from a part of the original
+;; buffer), it isn't meant for direct use in a back-end. To
+;; retrieve a definition relative to a reference, use
+;; `org-export-get-footnote-definition' instead.
+;; - category :: option
+;; - type :: alist (STRING . LIST)
+;;
+;; + `:headline-levels' :: Maximum level being exported as an
+;; headline. Comparison is done with the relative level of
+;; headlines in the parse tree, not necessarily with their
+;; actual level.
+;; - category :: option
+;; - type :: integer
+;;
+;; + `:headline-offset' :: Difference between relative and real level
+;; of headlines in the parse tree. For example, a value of -1
+;; means a level 2 headline should be considered as level
+;; 1 (cf. `org-export-get-relative-level').
+;; - category :: tree
+;; - type :: integer
+;;
+;; + `:headline-numbering' :: Alist between headlines and their
+;; numbering, as a list of numbers
+;; (cf. `org-export-get-headline-number').
+;; - category :: tree
+;; - type :: alist (INTEGER . LIST)
+;;
+;; + `:id-alist' :: Alist between ID strings and destination file's
+;; path, relative to current directory. It is used by
+;; `org-export-resolve-id-link' to resolve ID links targeting an
+;; external file.
+;; - category :: option
+;; - type :: alist (STRING . STRING)
+;;
+;; + `:ignore-list' :: List of elements and objects that should be
+;; ignored during export.
+;; - category :: tree
+;; - type :: list of elements and objects
+;;
+;; + `:input-file' :: Full path to input file, if any.
+;; - category :: option
+;; - type :: string or nil
+;;
+;; + `:keywords' :: List of keywords attached to data.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:language' :: Default language used for translations.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:parse-tree' :: Whole parse tree, available at any time during
+;; transcoding.
+;; - category :: option
+;; - type :: list (as returned by `org-element-parse-buffer')
+;;
+;; + `:preserve-breaks' :: Non-nil means transcoding should preserve
+;; all line breaks.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:section-numbers' :: Non-nil means transcoding should add
+;; section numbers to headlines.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees
+;; in transcoding. When such a tag is present, subtrees without
+;; it are de facto excluded from the process. See
+;; `use-select-tags'.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `:target-list' :: List of targets encountered in the parse tree.
+;; This is used to partly resolve "fuzzy" links
+;; (cf. `org-export-resolve-fuzzy-link').
+;; - category :: tree
+;; - type :: list of strings
+;;
+;; + `:time-stamp-file' :: Non-nil means transcoding should insert
+;; a time stamp in the output.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:translate-alist' :: Alist between element and object types and
+;; transcoding functions relative to the current back-end.
+;; Special keys `template' and `plain-text' are also possible.
+;; - category :: option
+;; - type :: alist (SYMBOL . FUNCTION)
+;;
+;; + `:with-archived-trees' :: Non-nil when archived subtrees should
+;; also be transcoded. If it is set to the `headline' symbol,
+;; only the archived headline's name is retained.
+;; - category :: option
+;; - type :: symbol (nil, t, `headline')
+;;
+;; + `:with-author' :: Non-nil means author's name should be included
+;; in the output.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-clocks' :: Non-nild means clock keywords should be exported.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-creator' :: Non-nild means a creation sentence should be
+;; inserted at the end of the transcoded string. If the value
+;; is `comment', it should be commented.
+;; - category :: option
+;; - type :: symbol (`comment', nil, t)
+;;
+;; + `:with-drawers' :: Non-nil means drawers should be exported. If
+;; its value is a list of names, only drawers with such names
+;; will be transcoded.
+;; - category :: option
+;; - type :: symbol (nil, t) or list of strings
+;;
+;; + `:with-email' :: Non-nil means output should contain author's
+;; email.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-emphasize' :: Non-nil means emphasized text should be
+;; interpreted.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-fixed-width' :: Non-nil if transcoder should interpret
+;; strings starting with a colon as a fixed-with (verbatim) area.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-footnotes' :: Non-nil if transcoder should interpret
+;; footnotes.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-plannings' :: Non-nil means transcoding should include
+;; planning info.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-priority' :: Non-nil means transcoding should include
+;; priority cookies.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-special-strings' :: Non-nil means transcoding should
+;; interpret special strings in plain text.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-sub-superscript' :: Non-nil means transcoding should
+;; interpret subscript and superscript. With a value of "{}",
+;; only interpret those using curly brackets.
+;; - category :: option
+;; - type :: symbol (nil, {}, t)
+;;
+;; + `:with-tables' :: Non-nil means transcoding should interpret
+;; tables.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-tags' :: Non-nil means transcoding should keep tags in
+;; headlines. A `not-in-toc' value will remove them from the
+;; table of contents, if any, nonetheless.
+;; - category :: option
+;; - type :: symbol (nil, t, `not-in-toc')
+;;
+;; + `:with-tasks' :: Non-nil means transcoding should include
+;; headlines with a TODO keyword. A `todo' value will only
+;; include headlines with a todo type keyword while a `done'
+;; value will do the contrary. If a list of strings is provided,
+;; only tasks with keywords belonging to that list will be kept.
+;; - category :: option
+;; - type :: symbol (t, todo, done, nil) or list of strings
+;;
+;; + `:with-timestamps' :: Non-nil means transcoding should include
+;; time stamps. Special value `active' (resp. `inactive') ask to
+;; export only active (resp. inactive) timestamps. Otherwise,
+;; completely remove them.
+;; - category :: option
+;; - type :: symbol: (`active', `inactive', t, nil)
+;;
+;; + `:with-toc' :: Non-nil means that a table of contents has to be
+;; added to the output. An integer value limits its depth.
+;; - category :: option
+;; - type :: symbol (nil, t or integer)
+;;
+;; + `:with-todo-keywords' :: Non-nil means transcoding should
+;; include TODO keywords.
+;; - category :: option
+;; - type :: symbol (nil, t)
+
+
+;;;; Environment Options
+;;
+;; Environment options encompass all parameters defined outside the
+;; scope of the parsed data. They come from five sources, in
+;; increasing precedence order:
+;;
+;; - Global variables,
+;; - Buffer's attributes,
+;; - Options keyword symbols,
+;; - Buffer keywords,
+;; - Subtree properties.
+;;
+;; The central internal function with regards to environment options
+;; is `org-export-get-environment'. It updates global variables with
+;; "#+BIND:" keywords, then retrieve and prioritize properties from
+;; the different sources.
+;;
+;; The internal functions doing the retrieval are:
+;; `org-export--get-global-options',
+;; `org-export--get-buffer-attributes',
+;; `org-export--parse-option-keyword',
+;; `org-export--get-subtree-options' and
+;; `org-export--get-inbuffer-options'
+;;
+;; Also, `org-export--confirm-letbind' and `org-export--install-letbind'
+;; take care of the part relative to "#+BIND:" keywords.
+
+(defun org-export-get-environment (&optional backend subtreep ext-plist)
+ "Collect export options from the current buffer.
+
+Optional argument BACKEND is a symbol specifying which back-end
+specific options to read, if any.
+
+When optional argument SUBTREEP is non-nil, assume the export is
+done against the current sub-tree.
+
+Third optional argument EXT-PLIST is a property list with
+external parameters overriding Org default settings, but still
+inferior to file-local settings."
+ ;; First install #+BIND variables.
+ (org-export--install-letbind-maybe)
+ ;; Get and prioritize export options...
+ (org-combine-plists
+ ;; ... from global variables...
+ (org-export--get-global-options backend)
+ ;; ... from buffer's attributes...
+ (org-export--get-buffer-attributes)
+ ;; ... from an external property list...
+ ext-plist
+ ;; ... from in-buffer settings...
+ (org-export--get-inbuffer-options
+ backend
+ (and buffer-file-name (org-remove-double-quotes buffer-file-name)))
+ ;; ... and from subtree, when appropriate.
+ (and subtreep (org-export--get-subtree-options backend))
+ ;; Eventually install back-end symbol and its translation table.
+ `(:back-end
+ ,backend
+ :translate-alist
+ ,(let ((trans-alist (intern (format "org-%s-translate-alist" backend))))
+ (when (boundp trans-alist) (symbol-value trans-alist))))))
+
+(defun org-export--parse-option-keyword (options &optional backend)
+ "Parse an OPTIONS line and return values as a plist.
+Optional argument BACKEND is a symbol specifying which back-end
+specific items to read, if any."
+ (let* ((all
+ (append org-export-options-alist
+ (and backend
+ (let ((var (intern
+ (format "org-%s-options-alist" backend))))
+ (and (boundp var) (eval var))))))
+ ;; Build an alist between #+OPTION: item and property-name.
+ (alist (delq nil
+ (mapcar (lambda (e)
+ (when (nth 2 e) (cons (regexp-quote (nth 2 e))
+ (car e))))
+ all)))
+ plist)
+ (mapc (lambda (e)
+ (when (string-match (concat "\\(\\`\\|[ \t]\\)"
+ (car e)
+ ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
+ options)
+ (setq plist (plist-put plist
+ (cdr e)
+ (car (read-from-string
+ (match-string 2 options)))))))
+ alist)
+ plist))
+
+(defun org-export--get-subtree-options (&optional backend)
+ "Get export options in subtree at point.
+Optional argument BACKEND is a symbol specifying back-end used
+for export. Return options as a plist."
+ ;; For each buffer keyword, create an headline property setting the
+ ;; same property in communication channel. The name for the property
+ ;; is the keyword with "EXPORT_" appended to it.
+ (org-with-wide-buffer
+ (let (prop plist)
+ ;; Make sure point is at an heading.
+ (unless (org-at-heading-p) (org-back-to-heading t))
+ ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's
+ ;; title as its fallback value.
+ (when (setq prop (progn (looking-at org-todo-line-regexp)
+ (or (save-match-data
+ (org-entry-get (point) "EXPORT_TITLE"))
+ (org-match-string-no-properties 3))))
+ (setq plist
+ (plist-put
+ plist :title
+ (org-element-parse-secondary-string
+ prop (org-element-restriction 'keyword)))))
+ ;; EXPORT_OPTIONS are parsed in a non-standard way.
+ (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
+ (setq plist
+ (nconc plist (org-export--parse-option-keyword prop backend))))
+ ;; Handle other keywords.
+ (let ((seen '("TITLE")))
+ (mapc
+ (lambda (option)
+ (let ((property (nth 1 option)))
+ (when (and property (not (member property seen)))
+ (let* ((subtree-prop (concat "EXPORT_" property))
+ ;; Export properties are not case-sensitive.
+ (value (let ((case-fold-search t))
+ (org-entry-get (point) subtree-prop))))
+ (push property seen)
+ (when value
+ (setq plist
+ (plist-put
+ plist
+ (car option)
+ ;; Parse VALUE if required.
+ (if (member property org-element-parsed-keywords)
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ value))))))))
+ ;; Also look for both general keywords and back-end specific
+ ;; options if BACKEND is provided.
+ (append (and backend
+ (let ((var (intern
+ (format "org-%s-options-alist" backend))))
+ (and (boundp var) (symbol-value var))))
+ org-export-options-alist)))
+ ;; Return value.
+ plist)))
+
+(defun org-export--get-inbuffer-options (&optional backend files)
+ "Return current buffer export options, as a plist.
+
+Optional argument BACKEND, when non-nil, is a symbol specifying
+which back-end specific options should also be read in the
+process.
+
+Optional argument FILES is a list of setup files names read so
+far, used to avoid circular dependencies.
+
+Assume buffer is in Org mode. Narrowing, if any, is ignored."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t) plist)
+ ;; 1. Special keywords, as in `org-export-special-keywords'.
+ (let ((special-re (org-make-options-regexp org-export-special-keywords)))
+ (while (re-search-forward special-re nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let* ((key (org-element-property :key element))
+ (val (org-element-property :value element))
+ (prop
+ (cond
+ ((string= key "SETUP_FILE")
+ (let ((file
+ (expand-file-name
+ (org-remove-double-quotes (org-trim val)))))
+ ;; Avoid circular dependencies.
+ (unless (member file files)
+ (with-temp-buffer
+ (insert (org-file-contents file 'noerror))
+ (org-mode)
+ (org-export--get-inbuffer-options
+ backend (cons file files))))))
+ ((string= key "OPTIONS")
+ (org-export--parse-option-keyword val backend))
+ ((string= key "MACRO")
+ (when (string-match
+ "^\\([-a-zA-Z0-9_]+\\)\\(?:[ \t]+\\(.*?\\)[ \t]*$\\)?"
+ val)
+ (let ((key
+ (intern
+ (concat ":macro-"
+ (downcase (match-string 1 val)))))
+ (value (org-match-string-no-properties 2 val)))
+ (cond
+ ((not value) nil)
+ ;; Value will be evaled: do not parse it.
+ ((string-match "\\`(eval\\>" value)
+ (list key (list value)))
+ ;; Value has to be parsed for nested
+ ;; macros.
+ (t
+ (list
+ key
+ (let ((restr (org-element-restriction 'macro)))
+ (org-element-parse-secondary-string
+ ;; If user explicitly asks for
+ ;; a newline, be sure to preserve it
+ ;; from further filling with
+ ;; `hard-newline'. Also replace
+ ;; "\\n" with "\n", "\\\n" with "\\n"
+ ;; and so on...
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)n" "\\\\"
+ (replace-regexp-in-string
+ "\\(?:^\\|[^\\\\]\\)\\(\\\\n\\)"
+ hard-newline value nil nil 1)
+ nil nil 1)
+ restr)))))))))))
+ (setq plist (org-combine-plists plist prop)))))))
+ ;; 2. Standard options, as in `org-export-options-alist'.
+ (let* ((all (append org-export-options-alist
+ ;; Also look for back-end specific options
+ ;; if BACKEND is defined.
+ (and backend
+ (let ((var
+ (intern
+ (format "org-%s-options-alist" backend))))
+ (and (boundp var) (eval var))))))
+ ;; Build alist between keyword name and property name.
+ (alist
+ (delq nil (mapcar
+ (lambda (e) (when (nth 1 e) (cons (nth 1 e) (car e))))
+ all)))
+ ;; Build regexp matching all keywords associated to export
+ ;; options. Note: the search is case insensitive.
+ (opt-re (org-make-options-regexp
+ (delq nil (mapcar (lambda (e) (nth 1 e)) all)))))
+ (goto-char (point-min))
+ (while (re-search-forward opt-re nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let* ((key (org-element-property :key element))
+ (val (org-element-property :value element))
+ (prop (cdr (assoc key alist)))
+ (behaviour (nth 4 (assq prop all))))
+ (setq plist
+ (plist-put
+ plist prop
+ ;; Handle value depending on specified BEHAVIOUR.
+ (case behaviour
+ (space
+ (if (not (plist-get plist prop)) (org-trim val)
+ (concat (plist-get plist prop) " " (org-trim val))))
+ (newline
+ (org-trim
+ (concat (plist-get plist prop) "\n" (org-trim val))))
+ (split
+ `(,@(plist-get plist prop) ,@(org-split-string val)))
+ ('t val)
+ (otherwise (if (not (plist-member plist prop)) val
+ (plist-get plist prop))))))))))
+ ;; Parse keywords specified in `org-element-parsed-keywords'.
+ (mapc
+ (lambda (key)
+ (let* ((prop (cdr (assoc key alist)))
+ (value (and prop (plist-get plist prop))))
+ (when (stringp value)
+ (setq plist
+ (plist-put
+ plist prop
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))))))
+ org-element-parsed-keywords))
+ ;; 3. Return final value.
+ plist)))
+
+(defun org-export--get-buffer-attributes ()
+ "Return properties related to buffer attributes, as a plist."
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list
+ ;; Store full path of input file name, or nil. For internal use.
+ :input-file visited-file
+ :title (or (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file)))
+ (buffer-name (buffer-base-buffer)))
+ :footnote-definition-alist
+ ;; Footnotes definitions must be collected in the original
+ ;; buffer, as there's no insurance that they will still be in the
+ ;; parse tree, due to possible narrowing.
+ (let (alist)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-footnote-definition-re nil t)
+ (let ((def (org-footnote-at-definition-p)))
+ (when def
+ (org-skip-whitespace)
+ (push (cons (car def)
+ (save-restriction
+ (narrow-to-region (point) (nth 2 def))
+ ;; Like `org-element-parse-buffer', but
+ ;; makes sure the definition doesn't start
+ ;; with a section element.
+ (org-element--parse-elements
+ (point-min) (point-max) nil nil nil nil
+ (list 'org-data nil))))
+ alist))))
+ alist))
+ :id-alist
+ ;; Collect id references.
+ (let (alist)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\[\\[id:\\(\\S-+?\\)\\]\\(?:\\[.*?\\]\\)?\\]" nil t)
+ (let* ((id (org-match-string-no-properties 1))
+ (file (org-id-find-id-file id)))
+ (when file (push (cons id (file-relative-name file)) alist)))))
+ alist)
+ :macro-modification-time
+ (and visited-file
+ (file-exists-p visited-file)
+ (concat "(eval (format-time-string \"$1\" '"
+ (prin1-to-string (nth 5 (file-attributes visited-file)))
+ "))"))
+ ;; Store input file name as a macro.
+ :macro-input-file (and visited-file (file-name-nondirectory visited-file))
+ ;; `:macro-date', `:macro-time' and `:macro-property' could as
+ ;; well be initialized as tree properties, since they don't
+ ;; depend on buffer properties. Though, it may be more logical
+ ;; to keep them close to other ":macro-" properties.
+ :macro-date "(eval (format-time-string \"$1\"))"
+ :macro-time "(eval (format-time-string \"$1\"))"
+ :macro-property "(eval (org-entry-get nil \"$1\" 'selective))")))
+
+(defun org-export--get-global-options (&optional backend)
+ "Return global export options as a plist.
+
+Optional argument BACKEND, if non-nil, is a symbol specifying
+which back-end specific export options should also be read in the
+process."
+ (let ((all (append org-export-options-alist
+ (and backend
+ (let ((var (intern
+ (format "org-%s-options-alist" backend))))
+ (and (boundp var) (symbol-value var))))))
+ ;; Output value.
+ plist)
+ (mapc
+ (lambda (cell)
+ (setq plist
+ (plist-put
+ plist
+ (car cell)
+ ;; Eval default value provided. If keyword is a member
+ ;; of `org-element-parsed-keywords', parse it as
+ ;; a secondary string before storing it.
+ (let ((value (eval (nth 3 cell))))
+ (if (not (stringp value)) value
+ (let ((keyword (nth 1 cell)))
+ (if (not (member keyword org-element-parsed-keywords)) value
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))))))))
+ all)
+ ;; Return value.
+ plist))
+
+(defvar org-export--allow-BIND-local nil)
+(defun org-export--confirm-letbind ()
+ "Can we use #+BIND values during export?
+By default this will ask for confirmation by the user, to divert
+possible security risks."
+ (cond
+ ((not org-export-allow-BIND) nil)
+ ((eq org-export-allow-BIND t) t)
+ ((local-variable-p 'org-export--allow-BIND-local)
+ org-export--allow-BIND-local)
+ (t (org-set-local 'org-export--allow-BIND-local
+ (yes-or-no-p "Allow BIND values in this buffer? ")))))
+
+(defun org-export--install-letbind-maybe ()
+ "Install the values from #+BIND lines as local variables.
+Variables must be installed before in-buffer options are
+retrieved."
+ (let (letbind pair)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward (org-make-options-regexp '("BIND")) nil t)
+ (when (org-export-confirm-letbind)
+ (push (read (concat "(" (org-match-string-no-properties 2) ")"))
+ letbind))))
+ (while (setq pair (pop letbind))
+ (org-set-local (car pair) (nth 1 pair)))))
+
+
+;;;; Tree Properties
+;;
+;; Tree properties are infromation extracted from parse tree. They
+;; are initialized at the beginning of the transcoding process by
+;; `org-export-collect-tree-properties'.
+;;
+;; Dedicated functions focus on computing the value of specific tree
+;; properties during initialization. Thus,
+;; `org-export--populate-ignore-list' lists elements and objects that
+;; should be skipped during export, `org-export--get-min-level' gets
+;; the minimal exportable level, used as a basis to compute relative
+;; level for headlines. Eventually
+;; `org-export--collect-headline-numbering' builds an alist between
+;; headlines and their numbering.
+
+(defun org-export-collect-tree-properties (data info)
+ "Extract tree properties from parse tree.
+
+DATA is the parse tree from which information is retrieved. INFO
+is a list holding export options.
+
+Following tree properties are set or updated:
+
+`:exported-data' Hash table used to memoize results from
+ `org-export-data'.
+
+`:footnote-definition-alist' List of footnotes definitions in
+ original buffer and current parse tree.
+
+`:headline-offset' Offset between true level of headlines and
+ local level. An offset of -1 means an headline
+ of level 2 should be considered as a level
+ 1 headline in the context.
+
+`:headline-numbering' Alist of all headlines as key an the
+ associated numbering as value.
+
+`:ignore-list' List of elements that should be ignored during
+ export.
+
+`:target-list' List of all targets in the parse tree.
+
+Return updated plist."
+ ;; Install the parse tree in the communication channel, in order to
+ ;; use `org-export-get-genealogy' and al.
+ (setq info (plist-put info :parse-tree data))
+ ;; Get the list of elements and objects to ignore, and put it into
+ ;; `:ignore-list'. Do not overwrite any user ignore that might have
+ ;; been done during parse tree filtering.
+ (setq info
+ (plist-put info
+ :ignore-list
+ (append (org-export--populate-ignore-list data info)
+ (plist-get info :ignore-list))))
+ ;; Compute `:headline-offset' in order to be able to use
+ ;; `org-export-get-relative-level'.
+ (setq info
+ (plist-put info
+ :headline-offset
+ (- 1 (org-export--get-min-level data info))))
+ ;; Update footnotes definitions list with definitions in parse tree.
+ ;; This is required since buffer expansion might have modified
+ ;; boundaries of footnote definitions contained in the parse tree.
+ ;; This way, definitions in `footnote-definition-alist' are bound to
+ ;; match those in the parse tree.
+ (let ((defs (plist-get info :footnote-definition-alist)))
+ (org-element-map
+ data 'footnote-definition
+ (lambda (fn)
+ (push (cons (org-element-property :label fn)
+ `(org-data nil ,@(org-element-contents fn)))
+ defs)))
+ (setq info (plist-put info :footnote-definition-alist defs)))
+ ;; Properties order doesn't matter: get the rest of the tree
+ ;; properties.
+ (nconc
+ `(:target-list
+ ,(org-element-map
+ data '(keyword target)
+ (lambda (blob)
+ (when (or (eq (org-element-type blob) 'target)
+ (string= (org-element-property :key blob) "TARGET"))
+ blob)) info)
+ :headline-numbering ,(org-export--collect-headline-numbering data info)
+ :exported-data ,(make-hash-table :test 'eq :size 4001))
+ info))
+
+(defun org-export--get-min-level (data options)
+ "Return minimum exportable headline's level in DATA.
+DATA is parsed tree as returned by `org-element-parse-buffer'.
+OPTIONS is a plist holding export options."
+ (catch 'exit
+ (let ((min-level 10000))
+ (mapc
+ (lambda (blob)
+ (when (and (eq (org-element-type blob) 'headline)
+ (not (memq blob (plist-get options :ignore-list))))
+ (setq min-level
+ (min (org-element-property :level blob) min-level)))
+ (when (= min-level 1) (throw 'exit 1)))
+ (org-element-contents data))
+ ;; If no headline was found, for the sake of consistency, set
+ ;; minimum level to 1 nonetheless.
+ (if (= min-level 10000) 1 min-level))))
+
+(defun org-export--collect-headline-numbering (data options)
+ "Return numbering of all exportable headlines in a parse tree.
+
+DATA is the parse tree. OPTIONS is the plist holding export
+options.
+
+Return an alist whose key is an headline and value is its
+associated numbering \(in the shape of a list of numbers\)."
+ (let ((numbering (make-vector org-export-max-depth 0)))
+ (org-element-map
+ data
+ 'headline
+ (lambda (headline)
+ (let ((relative-level
+ (1- (org-export-get-relative-level headline options))))
+ (cons
+ headline
+ (loop for n across numbering
+ for idx from 0 to org-export-max-depth
+ when (< idx relative-level) collect n
+ when (= idx relative-level) collect (aset numbering idx (1+ n))
+ when (> idx relative-level) do (aset numbering idx 0)))))
+ options)))
+
+(defun org-export--populate-ignore-list (data options)
+ "Return list of elements and objects to ignore during export.
+DATA is the parse tree to traverse. OPTIONS is the plist holding
+export options."
+ (let* (ignore
+ walk-data ; for byte-compiler.
+ (walk-data
+ (function
+ (lambda (data options selected)
+ ;; Collect ignored elements or objects into IGNORE-LIST.
+ (mapc
+ (lambda (el)
+ (if (org-export--skip-p el options selected) (push el ignore)
+ (let ((type (org-element-type el)))
+ (if (and (eq (plist-get options :with-archived-trees)
+ 'headline)
+ (eq (org-element-type el) 'headline)
+ (org-element-property :archivedp el))
+ ;; If headline is archived but tree below has
+ ;; to be skipped, add it to ignore list.
+ (mapc (lambda (e) (push e ignore))
+ (org-element-contents el))
+ ;; Move into recursive objects/elements.
+ (when (org-element-contents el)
+ (funcall walk-data el options selected))))))
+ (org-element-contents data))))))
+ ;; Main call. First find trees containing a select tag, if any.
+ (funcall walk-data data options (org-export--selected-trees data options))
+ ;; Return value.
+ ignore))
+
+(defun org-export--selected-trees (data info)
+ "Return list of headlines containing a select tag in their tree.
+DATA is parsed data as returned by `org-element-parse-buffer'.
+INFO is a plist holding export options."
+ (let* (selected-trees
+ walk-data ; for byte-compiler.
+ (walk-data
+ (function
+ (lambda (data genealogy)
+ (case (org-element-type data)
+ (org-data (mapc (lambda (el) (funcall walk-data el genealogy))
+ (org-element-contents data)))
+ (headline
+ (let ((tags (org-element-property :tags data)))
+ (if (loop for tag in (plist-get info :select-tags)
+ thereis (member tag tags))
+ ;; When a select tag is found, mark full
+ ;; genealogy and every headline within the tree
+ ;; as acceptable.
+ (setq selected-trees
+ (append
+ genealogy
+ (org-element-map data 'headline 'identity)
+ selected-trees))
+ ;; Else, continue searching in tree, recursively.
+ (mapc
+ (lambda (el) (funcall walk-data el (cons data genealogy)))
+ (org-element-contents data))))))))))
+ (funcall walk-data data nil) selected-trees))
+
+(defun org-export--skip-p (blob options selected)
+ "Non-nil when element or object BLOB should be skipped during export.
+OPTIONS is the plist holding export options. SELECTED, when
+non-nil, is a list of headlines belonging to a tree with a select
+tag."
+ (case (org-element-type blob)
+ ;; Check headline.
+ (headline
+ (let ((with-tasks (plist-get options :with-tasks))
+ (todo (org-element-property :todo-keyword blob))
+ (todo-type (org-element-property :todo-type blob))
+ (archived (plist-get options :with-archived-trees))
+ (tags (org-element-property :tags blob)))
+ (or
+ ;; Ignore subtrees with an exclude tag.
+ (loop for k in (plist-get options :exclude-tags)
+ thereis (member k tags))
+ ;; When a select tag is present in the buffer, ignore any tree
+ ;; without it.
+ (and selected (not (memq blob selected)))
+ ;; Ignore commented sub-trees.
+ (org-element-property :commentedp blob)
+ ;; Ignore archived subtrees if `:with-archived-trees' is nil.
+ (and (not archived) (org-element-property :archivedp blob))
+ ;; Ignore tasks, if specified by `:with-tasks' property.
+ (and todo
+ (or (not with-tasks)
+ (and (memq with-tasks '(todo done))
+ (not (eq todo-type with-tasks)))
+ (and (consp with-tasks) (not (member todo with-tasks))))))))
+ ;; Check inlinetask.
+ (inlinetask (not (plist-get options :with-inlinetasks)))
+ ;; Check timestamp.
+ (timestamp
+ (case (plist-get options :with-timestamps)
+ ;; No timestamp allowed.
+ ('nil t)
+ ;; Only active timestamps allowed and the current one isn't
+ ;; active.
+ (active
+ (not (memq (org-element-property :type blob)
+ '(active active-range))))
+ ;; Only inactive timestamps allowed and the current one isn't
+ ;; inactive.
+ (inactive
+ (not (memq (org-element-property :type blob)
+ '(inactive inactive-range))))))
+ ;; Check drawer.
+ (drawer
+ (or (not (plist-get options :with-drawers))
+ (and (consp (plist-get options :with-drawers))
+ (not (member (org-element-property :drawer-name blob)
+ (plist-get options :with-drawers))))))
+ ;; Check table-row.
+ (table-row (org-export-table-row-is-special-p blob options))
+ ;; Check table-cell.
+ (table-cell
+ (and (org-export-table-has-special-column-p
+ (org-export-get-parent-table blob))
+ (not (org-export-get-previous-element blob options))))
+ ;; Check clock.
+ (clock (not (plist-get options :with-clocks)))
+ ;; Check planning.
+ (planning (not (plist-get options :with-plannings)))))
+
+
+
+;;; The Transcoder
+;;
+;; `org-export-data' reads a parse tree (obtained with, i.e.
+;; `org-element-parse-buffer') and transcodes it into a specified
+;; back-end output. It takes care of filtering out elements or
+;; objects according to export options and organizing the output blank
+;; lines and white space are preserved. The function memoizes its
+;; results, so it is cheap to call it within translators.
+;;
+;; Internally, three functions handle the filtering of objects and
+;; elements during the export. In particular,
+;; `org-export-ignore-element' marks an element or object so future
+;; parse tree traversals skip it, `org-export--interpret-p' tells which
+;; elements or objects should be seen as real Org syntax and
+;; `org-export-expand' transforms the others back into their original
+;; shape
+;;
+;; `org-export-transcoder' is an accessor returning appropriate
+;; translator function for a given element or object.
+
+(defun org-export-transcoder (blob info)
+ "Return appropriate transcoder for BLOB.
+INFO is a plist containing export directives."
+ (let ((type (org-element-type blob)))
+ ;; Return contents only for complete parse trees.
+ (if (eq type 'org-data) (lambda (blob contents info) contents)
+ (let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
+ (and (functionp transcoder) transcoder)))))
+
+(defun org-export-data (data info)
+ "Convert DATA into current back-end format.
+
+DATA is a parse tree, an element or an object or a secondary
+string. INFO is a plist holding export options.
+
+Return transcoded string."
+ (let ((memo (gethash data (plist-get info :exported-data) 'no-memo)))
+ (if (not (eq memo 'no-memo)) memo
+ (let* ((type (org-element-type data))
+ (results
+ (cond
+ ;; Ignored element/object.
+ ((memq data (plist-get info :ignore-list)) nil)
+ ;; Plain text.
+ ((eq type 'plain-text)
+ (org-export-filter-apply-functions
+ (plist-get info :filter-plain-text)
+ (let ((transcoder (org-export-transcoder data info)))
+ (if transcoder (funcall transcoder data info) data))
+ info))
+ ;; Uninterpreted element/object: change it back to Org
+ ;; syntax and export again resulting raw string.
+ ((not (org-export--interpret-p data info))
+ (org-export-data
+ (org-export-expand
+ data
+ (mapconcat (lambda (blob) (org-export-data blob info))
+ (org-element-contents data)
+ ""))
+ info))
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
+ ;; Element/Object without contents or, as a special case,
+ ;; headline with archive tag and archived trees restricted
+ ;; to title only.
+ ((or (not (org-element-contents data))
+ (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees) 'headline)
+ (org-element-property :archivedp data)))
+ (let ((transcoder (org-export-transcoder data info)))
+ (and (functionp transcoder)
+ (funcall transcoder data nil info))))
+ ;; Element/Object with contents.
+ (t
+ (let ((transcoder (org-export-transcoder data info)))
+ (when transcoder
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp
+ (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (element) (org-export-data element info))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing objects
+ ;; must have their indentation normalized
+ ;; first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing contents of the first
+ ;; paragraph in an item or a footnote
+ ;; definition, ignore first line's
+ ;; indentation: there is none and it
+ ;; might be misleading.
+ (when (eq type 'paragraph)
+ (let ((parent (org-export-get-parent data)))
+ (and
+ (eq (car (org-element-contents parent))
+ data)
+ (memq (org-element-type parent)
+ '(footnote-definition item))))))))
+ "")))
+ (funcall transcoder data
+ (if (not greaterp) contents
+ (org-element-normalize-string contents))
+ info))))))))
+ ;; Final result will be memoized before being returned.
+ (puthash
+ data
+ (cond
+ ((not results) nil)
+ ((memq type '(org-data plain-text nil)) results)
+ ;; Append the same white space between elements or objects as in
+ ;; the original buffer, and call appropriate filters.
+ (t
+ (let ((results
+ (org-export-filter-apply-functions
+ (plist-get info (intern (format ":filter-%s" type)))
+ (let ((post-blank (or (org-element-property :post-blank data)
+ 0)))
+ (if (memq type org-element-all-elements)
+ (concat (org-element-normalize-string results)
+ (make-string post-blank ?\n))
+ (concat results (make-string post-blank ? ))))
+ info)))
+ results)))
+ (plist-get info :exported-data))))))
+
+(defun org-export--interpret-p (blob info)
+ "Non-nil if element or object BLOB should be interpreted as Org syntax.
+Check is done according to export options INFO, stored as
+a plist."
+ (case (org-element-type blob)
+ ;; ... entities...
+ (entity (plist-get info :with-entities))
+ ;; ... emphasis...
+ (emphasis (plist-get info :with-emphasize))
+ ;; ... fixed-width areas.
+ (fixed-width (plist-get info :with-fixed-width))
+ ;; ... footnotes...
+ ((footnote-definition footnote-reference)
+ (plist-get info :with-footnotes))
+ ;; ... sub/superscripts...
+ ((subscript superscript)
+ (let ((sub/super-p (plist-get info :with-sub-superscript)))
+ (if (eq sub/super-p '{})
+ (org-element-property :use-brackets-p blob)
+ sub/super-p)))
+ ;; ... tables...
+ (table (plist-get info :with-tables))
+ (otherwise t)))
+
+(defun org-export-expand (blob contents)
+ "Expand a parsed element or object to its original state.
+BLOB is either an element or an object. CONTENTS is its
+contents, as a string or nil."
+ (funcall
+ (intern (format "org-element-%s-interpreter" (org-element-type blob)))
+ blob contents))
+
+(defun org-export-ignore-element (element info)
+ "Add ELEMENT to `:ignore-list' in INFO.
+
+Any element in `:ignore-list' will be skipped when using
+`org-element-map'. INFO is modified by side effects."
+ (plist-put info :ignore-list (cons element (plist-get info :ignore-list))))
+
+
+
+;;; The Filter System
+;;
+;; Filters allow end-users to tweak easily the transcoded output.
+;; They are the functional counterpart of hooks, as every filter in
+;; a set is applied to the return value of the previous one.
+;;
+;; Every set is back-end agnostic. Although, a filter is always
+;; called, in addition to the string it applies to, with the back-end
+;; used as argument, so it's easy for the end-user to add back-end
+;; specific filters in the set. The communication channel, as
+;; a plist, is required as the third argument.
+;;
+;; From the developer side, filters sets can be installed in the
+;; process with the help of `org-export-define-backend', which
+;; internally sets `org-BACKEND-filters-alist' variable. Each
+;; association has a key among the following symbols and a function or
+;; a list of functions as value.
+;;
+;; - `:filter-parse-tree' applies directly on the complete parsed
+;; tree. It's the only filters set that doesn't apply to a string.
+;; Users can set it through `org-export-filter-parse-tree-functions'
+;; variable.
+;;
+;; - `:filter-final-output' applies to the final transcoded string.
+;; Users can set it with `org-export-filter-final-output-functions'
+;; variable
+;;
+;; - `:filter-plain-text' applies to any string not recognized as Org
+;; syntax. `org-export-filter-plain-text-functions' allows users to
+;; configure it.
+;;
+;; - `:filter-TYPE' applies on the string returned after an element or
+;; object of type TYPE has been transcoded. An user can modify
+;; `org-export-filter-TYPE-functions'
+;;
+;; All filters sets are applied with
+;; `org-export-filter-apply-functions' function. Filters in a set are
+;; applied in a LIFO fashion. It allows developers to be sure that
+;; their filters will be applied first.
+;;
+;; Filters properties are installed in communication channel with
+;; `org-export-install-filters' function.
+;;
+;; Eventually, a hook (`org-export-before-parsing-hook') is run just
+;; before parsing to allow for heavy structure modifications.
+
+
+;;;; Before Parsing Hook
+
+(defvar org-export-before-parsing-hook nil
+ "Hook run before parsing an export buffer.
+
+This is run after include keywords have been expanded and Babel
+code executed, on a copy of original buffer's area being
+exported. Visibility is the same as in the original one. Point
+is left at the beginning of the new one.
+
+Every function in this hook will be called with one argument: the
+back-end currently used, as a symbol.")
+
+
+;;;; Special Filters
+
+(defvar org-export-filter-parse-tree-functions nil
+ "List of functions applied to the parsed tree.
+Each filter is called with three arguments: the parse tree, as
+returned by `org-element-parse-buffer', the back-end, as
+a symbol, and the communication channel, as a plist. It must
+return the modified parse tree to transcode.")
+
+(defvar org-export-filter-final-output-functions nil
+ "List of functions applied to the transcoded string.
+Each filter is called with three arguments: the full transcoded
+string, the back-end, as a symbol, and the communication channel,
+as a plist. It must return a string that will be used as the
+final export output.")
+
+(defvar org-export-filter-plain-text-functions nil
+ "List of functions applied to plain text.
+Each filter is called with three arguments: a string which
+contains no Org syntax, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
+
+;;;; Elements Filters
+
+(defvar org-export-filter-center-block-functions nil
+ "List of functions applied to a transcoded center block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-clock-functions nil
+ "List of functions applied to a transcoded clock.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-drawer-functions nil
+ "List of functions applied to a transcoded drawer.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-dynamic-block-functions nil
+ "List of functions applied to a transcoded dynamic-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-headline-functions nil
+ "List of functions applied to a transcoded headline.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inlinetask-functions nil
+ "List of functions applied to a transcoded inlinetask.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-plain-list-functions nil
+ "List of functions applied to a transcoded plain-list.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-item-functions nil
+ "List of functions applied to a transcoded item.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-comment-functions nil
+ "List of functions applied to a transcoded comment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-comment-block-functions nil
+ "List of functions applied to a transcoded comment-comment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-example-block-functions nil
+ "List of functions applied to a transcoded example-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-export-block-functions nil
+ "List of functions applied to a transcoded export-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-fixed-width-functions nil
+ "List of functions applied to a transcoded fixed-width.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-footnote-definition-functions nil
+ "List of functions applied to a transcoded footnote-definition.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-horizontal-rule-functions nil
+ "List of functions applied to a transcoded horizontal-rule.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-keyword-functions nil
+ "List of functions applied to a transcoded keyword.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-latex-environment-functions nil
+ "List of functions applied to a transcoded latex-environment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-babel-call-functions nil
+ "List of functions applied to a transcoded babel-call.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-paragraph-functions nil
+ "List of functions applied to a transcoded paragraph.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-planning-functions nil
+ "List of functions applied to a transcoded planning.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-property-drawer-functions nil
+ "List of functions applied to a transcoded property-drawer.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-quote-block-functions nil
+ "List of functions applied to a transcoded quote block.
+Each filter is called with three arguments: the transcoded quote
+data, as a string, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
+(defvar org-export-filter-quote-section-functions nil
+ "List of functions applied to a transcoded quote-section.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-section-functions nil
+ "List of functions applied to a transcoded section.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-special-block-functions nil
+ "List of functions applied to a transcoded special block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-src-block-functions nil
+ "List of functions applied to a transcoded src-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-functions nil
+ "List of functions applied to a transcoded table.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-cell-functions nil
+ "List of functions applied to a transcoded table-cell.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-row-functions nil
+ "List of functions applied to a transcoded table-row.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-verse-block-functions nil
+ "List of functions applied to a transcoded verse block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+
+;;;; Objects Filters
+
+(defvar org-export-filter-bold-functions nil
+ "List of functions applied to transcoded bold text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-code-functions nil
+ "List of functions applied to transcoded code text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-entity-functions nil
+ "List of functions applied to a transcoded entity.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-export-snippet-functions nil
+ "List of functions applied to a transcoded export-snippet.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-footnote-reference-functions nil
+ "List of functions applied to a transcoded footnote-reference.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inline-babel-call-functions nil
+ "List of functions applied to a transcoded inline-babel-call.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inline-src-block-functions nil
+ "List of functions applied to a transcoded inline-src-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-italic-functions nil
+ "List of functions applied to transcoded italic text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-latex-fragment-functions nil
+ "List of functions applied to a transcoded latex-fragment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-line-break-functions nil
+ "List of functions applied to a transcoded line-break.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-link-functions nil
+ "List of functions applied to a transcoded link.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-macro-functions nil
+ "List of functions applied to a transcoded macro.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-radio-target-functions nil
+ "List of functions applied to a transcoded radio-target.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-statistics-cookie-functions nil
+ "List of functions applied to a transcoded statistics-cookie.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-strike-through-functions nil
+ "List of functions applied to transcoded strike-through text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-subscript-functions nil
+ "List of functions applied to a transcoded subscript.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-superscript-functions nil
+ "List of functions applied to a transcoded superscript.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-target-functions nil
+ "List of functions applied to a transcoded target.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-timestamp-functions nil
+ "List of functions applied to a transcoded timestamp.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-underline-functions nil
+ "List of functions applied to transcoded underline text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-verbatim-functions nil
+ "List of functions applied to transcoded verbatim text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+
+;;;; Filters Tools
+;;
+;; Internal function `org-export-install-filters' installs filters
+;; hard-coded in back-ends (developer filters) and filters from global
+;; variables (user filters) in the communication channel.
+;;
+;; Internal function `org-export-filter-apply-functions' takes care
+;; about applying each filter in order to a given data. It ignores
+;; filters returning a nil value but stops whenever a filter returns
+;; an empty string.
+
+(defun org-export-filter-apply-functions (filters value info)
+ "Call every function in FILTERS.
+
+Functions are called with arguments VALUE, current export
+back-end and INFO. A function returning a nil value will be
+skipped. If it returns the empty string, the process ends and
+VALUE is ignored.
+
+Call is done in a LIFO fashion, to be sure that developer
+specified filters, if any, are called first."
+ (catch 'exit
+ (dolist (filter filters value)
+ (let ((result (funcall filter value (plist-get info :back-end) info)))
+ (cond ((not value))
+ ((equal value "") (throw 'exit nil))
+ (t (setq value result)))))))
+
+(defun org-export-install-filters (info)
+ "Install filters properties in communication channel.
+
+INFO is a plist containing the current communication channel.
+
+Return the updated communication channel."
+ (let (plist)
+ ;; Install user defined filters with `org-export-filters-alist'.
+ (mapc (lambda (p)
+ (setq plist (plist-put plist (car p) (eval (cdr p)))))
+ org-export-filters-alist)
+ ;; Prepend back-end specific filters to that list.
+ (let ((back-end-filters (intern (format "org-%s-filters-alist"
+ (plist-get info :back-end)))))
+ (when (boundp back-end-filters)
+ (mapc (lambda (p)
+ ;; Single values get consed, lists are prepended.
+ (let ((key (car p)) (value (cdr p)))
+ (when value
+ (setq plist
+ (plist-put
+ plist key
+ (if (atom value) (cons value (plist-get plist key))
+ (append value (plist-get plist key))))))))
+ (eval back-end-filters))))
+ ;; Return new communication channel.
+ (org-combine-plists info plist)))
+
+
+
+;;; Core functions
+;;
+;; This is the room for the main function, `org-export-as', along with
+;; its derivatives, `org-export-to-buffer' and `org-export-to-file'.
+;; They differ only by the way they output the resulting code.
+;;
+;; `org-export-output-file-name' is an auxiliary function meant to be
+;; used with `org-export-to-file'. With a given extension, it tries
+;; to provide a canonical file name to write export output to.
+;;
+;; Note that `org-export-as' doesn't really parse the current buffer,
+;; but a copy of it (with the same buffer-local variables and
+;; visibility), where include keywords are expanded and Babel blocks
+;; are executed, if appropriate.
+;; `org-export-with-current-buffer-copy' macro prepares that copy.
+;;
+;; File inclusion is taken care of by
+;; `org-export-expand-include-keyword' and
+;; `org-export--prepare-file-contents'. Structure wise, including
+;; a whole Org file in a buffer often makes little sense. For
+;; example, if the file contains an headline and the include keyword
+;; was within an item, the item should contain the headline. That's
+;; why file inclusion should be done before any structure can be
+;; associated to the file, that is before parsing.
+
+(defun org-export-as
+ (backend &optional subtreep visible-only body-only ext-plist noexpand)
+ "Transcode current Org buffer into BACKEND code.
+
+If narrowing is active in the current buffer, only transcode its
+narrowed part.
+
+If a region is active, transcode that region.
+
+When optional argument SUBTREEP is non-nil, transcode the
+sub-tree at point, extracting information from the headline
+properties first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only return body
+code, without preamble nor postamble.
+
+Optional argument EXT-PLIST, when provided, is a property list
+with external parameters overriding Org default settings, but
+still inferior to file-local settings.
+
+Optional argument NOEXPAND, when non-nil, prevents included files
+to be expanded and Babel code to be executed.
+
+Return code as a string."
+ (save-excursion
+ (save-restriction
+ ;; Narrow buffer to an appropriate region or subtree for
+ ;; parsing. If parsing subtree, be sure to remove main headline
+ ;; too.
+ (cond ((org-region-active-p)
+ (narrow-to-region (region-beginning) (region-end)))
+ (subtreep
+ (org-narrow-to-subtree)
+ (goto-char (point-min))
+ (forward-line)
+ (narrow-to-region (point) (point-max))))
+ ;; 1. Get export environment from original buffer. Also install
+ ;; user's and developer's filters.
+ (let ((info (org-export-install-filters
+ (org-export-get-environment backend subtreep ext-plist)))
+ ;; 2. Get parse tree. Buffer isn't parsed directly.
+ ;; Instead, a temporary copy is created, where include
+ ;; keywords are expanded and code blocks are evaluated.
+ (tree (let ((buf (or (buffer-file-name (buffer-base-buffer))
+ (current-buffer))))
+ (org-export-with-current-buffer-copy
+ (unless noexpand
+ (org-export-expand-include-keyword)
+ ;; TODO: Setting `org-current-export-file' is
+ ;; required by Org Babel to properly resolve
+ ;; noweb references. Once "org-exp.el" is
+ ;; removed, modify
+ ;; `org-export-blocks-preprocess' so it accepts
+ ;; the value as an argument instead.
+ (let ((org-current-export-file buf))
+ (org-export-blocks-preprocess)))
+ (goto-char (point-min))
+ ;; Run hook
+ ;; `org-export-before-parsing-hook'. with current
+ ;; back-end as argument.
+ (run-hook-with-args
+ 'org-export-before-parsing-hook backend)
+ ;; Eventually parse buffer.
+ (org-element-parse-buffer nil visible-only)))))
+ ;; 3. Call parse-tree filters to get the final tree.
+ (setq tree
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree) tree info))
+ ;; 4. Now tree is complete, compute its properties and add
+ ;; them to communication channel.
+ (setq info
+ (org-combine-plists
+ info (org-export-collect-tree-properties tree info)))
+ ;; 5. Eventually transcode TREE. Wrap the resulting string
+ ;; into a template, if required. Eventually call
+ ;; final-output filter.
+ (let* ((body (org-element-normalize-string (org-export-data tree info)))
+ (template (cdr (assq 'template
+ (plist-get info :translate-alist))))
+ (output (org-export-filter-apply-functions
+ (plist-get info :filter-final-output)
+ (if (or (not (functionp template)) body-only) body
+ (funcall template body info))
+ info)))
+ ;; Maybe add final OUTPUT to kill ring, then return it.
+ (when org-export-copy-to-kill-ring (org-kill-new output))
+ output)))))
+
+(defun org-export-to-buffer
+ (backend buffer &optional subtreep visible-only body-only ext-plist noexpand)
+ "Call `org-export-as' with output to a specified buffer.
+
+BACKEND is the back-end used for transcoding, as a symbol.
+
+BUFFER is the output buffer. If it already exists, it will be
+erased first, otherwise, it will be created.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST
+and NOEXPAND are similar to those used in `org-export-as', which
+see.
+
+Return buffer."
+ (let ((out (org-export-as
+ backend subtreep visible-only body-only ext-plist noexpand))
+ (buffer (get-buffer-create buffer)))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (insert out)
+ (goto-char (point-min)))
+ buffer))
+
+(defun org-export-to-file
+ (backend file &optional subtreep visible-only body-only ext-plist noexpand)
+ "Call `org-export-as' with output to a specified file.
+
+BACKEND is the back-end used for transcoding, as a symbol. FILE
+is the name of the output file, as a string.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST
+and NOEXPAND are similar to those used in `org-export-as', which
+see.
+
+Return output file's name."
+ ;; Checks for FILE permissions. `write-file' would do the same, but
+ ;; we'd rather avoid needless transcoding of parse tree.
+ (unless (file-writable-p file) (error "Output file not writable"))
+ ;; Insert contents to a temporary buffer and write it to FILE.
+ (let ((out (org-export-as
+ backend subtreep visible-only body-only ext-plist noexpand)))
+ (with-temp-buffer
+ (insert out)
+ (let ((coding-system-for-write org-export-coding-system))
+ (write-file file))))
+ ;; Return full path.
+ file)
+
+(defun org-export-output-file-name (extension &optional subtreep pub-dir)
+ "Return output file's name according to buffer specifications.
+
+EXTENSION is a string representing the output file extension,
+with the leading dot.
+
+With a non-nil optional argument SUBTREEP, try to determine
+output file's name by looking for \"EXPORT_FILE_NAME\" property
+of subtree at point.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return file name as a string, or nil if it couldn't be
+determined."
+ (let ((base-name
+ ;; File name may come from EXPORT_FILE_NAME subtree property,
+ ;; assuming point is at beginning of said sub-tree.
+ (file-name-sans-extension
+ (or (and subtreep
+ (org-entry-get
+ (save-excursion
+ (ignore-errors (org-back-to-heading) (point)))
+ "EXPORT_FILE_NAME" t))
+ ;; File name may be extracted from buffer's associated
+ ;; file, if any.
+ (buffer-file-name (buffer-base-buffer))
+ ;; Can't determine file name on our own: Ask user.
+ (let ((read-file-name-function
+ (and org-completion-use-ido 'ido-read-file-name)))
+ (read-file-name
+ "Output file: " pub-dir nil nil nil
+ (lambda (name)
+ (string= (file-name-extension name t) extension))))))))
+ ;; Build file name. Enforce EXTENSION over whatever user may have
+ ;; come up with. PUB-DIR, if defined, always has precedence over
+ ;; any provided path.
+ (cond
+ (pub-dir
+ (concat (file-name-as-directory pub-dir)
+ (file-name-nondirectory base-name)
+ extension))
+ ((string= (file-name-nondirectory base-name) base-name)
+ (concat (file-name-as-directory ".") base-name extension))
+ (t (concat base-name extension)))))
+
+(defmacro org-export-with-current-buffer-copy (&rest body)
+ "Apply BODY in a copy of the current buffer.
+
+The copy preserves local variables and visibility of the original
+buffer.
+
+Point is at buffer's beginning when BODY is applied."
+ (org-with-gensyms (original-buffer offset buffer-string overlays)
+ `(let ((,original-buffer (current-buffer))
+ (,offset (1- (point-min)))
+ (,buffer-string (buffer-string))
+ (,overlays (mapcar
+ 'copy-overlay (overlays-in (point-min) (point-max)))))
+ (with-temp-buffer
+ (let ((buffer-invisibility-spec nil))
+ (org-clone-local-variables
+ ,original-buffer
+ "^\\(org-\\|orgtbl-\\|major-mode$\\|outline-\\(regexp\\|level\\)$\\)")
+ (insert ,buffer-string)
+ (mapc (lambda (ov)
+ (move-overlay
+ ov
+ (- (overlay-start ov) ,offset)
+ (- (overlay-end ov) ,offset)
+ (current-buffer)))
+ ,overlays)
+ (goto-char (point-min))
+ (progn ,@body))))))
+(def-edebug-spec org-export-with-current-buffer-copy (body))
+
+(defun org-export-expand-include-keyword (&optional included dir)
+ "Expand every include keyword in buffer.
+Optional argument INCLUDED is a list of included file names along
+with their line restriction, when appropriate. It is used to
+avoid infinite recursion. Optional argument DIR is the current
+working directory. It is used to properly resolve relative
+paths."
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+INCLUDE: \\(.*\\)" nil t)
+ (when (eq (org-element-type (save-match-data (org-element-at-point)))
+ 'keyword)
+ (beginning-of-line)
+ ;; Extract arguments from keyword's value.
+ (let* ((value (match-string 1))
+ (ind (org-get-indentation))
+ (file (and (string-match "^\"\\(\\S-+\\)\"" value)
+ (prog1 (expand-file-name (match-string 1 value) dir)
+ (setq value (replace-match "" nil nil value)))))
+ (lines
+ (and (string-match
+ ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" value)
+ (prog1 (match-string 1 value)
+ (setq value (replace-match "" nil nil value)))))
+ (env (cond ((string-match "\\<example\\>" value) 'example)
+ ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
+ (match-string 1 value))))
+ ;; Minimal level of included file defaults to the child
+ ;; level of the current headline, if any, or one. It
+ ;; only applies is the file is meant to be included as
+ ;; an Org one.
+ (minlevel
+ (and (not env)
+ (if (string-match ":minlevel +\\([0-9]+\\)" value)
+ (prog1 (string-to-number (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))
+ (let ((cur (org-current-level)))
+ (if cur (1+ (org-reduced-level cur)) 1))))))
+ ;; Remove keyword.
+ (delete-region (point) (progn (forward-line) (point)))
+ (cond
+ ((not (file-readable-p file)) (error "Cannot include file %s" file))
+ ;; Check if files has already been parsed. Look after
+ ;; inclusion lines too, as different parts of the same file
+ ;; can be included too.
+ ((member (list file lines) included)
+ (error "Recursive file inclusion: %s" file))
+ (t
+ (cond
+ ((eq env 'example)
+ (insert
+ (let ((ind-str (make-string ind ? ))
+ (contents
+ ;; Protect sensitive contents with commas.
+ (replace-regexp-in-string
+ "\\(^\\)\\([*]\\|[ \t]*#\\+\\)" ","
+ (org-export--prepare-file-contents file lines)
+ nil nil 1)))
+ (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n"
+ ind-str contents ind-str))))
+ ((stringp env)
+ (insert
+ (let ((ind-str (make-string ind ? ))
+ (contents
+ ;; Protect sensitive contents with commas.
+ (replace-regexp-in-string
+ (if (string= env "org") "\\(^\\)\\(.\\)"
+ "\\(^\\)\\([*]\\|[ \t]*#\\+\\)") ","
+ (org-export--prepare-file-contents file lines)
+ nil nil 1)))
+ (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n"
+ ind-str env contents ind-str))))
+ (t
+ (insert
+ (with-temp-buffer
+ (org-mode)
+ (insert
+ (org-export--prepare-file-contents file lines ind minlevel))
+ (org-export-expand-include-keyword
+ (cons (list file lines) included)
+ (file-name-directory file))
+ (buffer-string))))))))))))
+
+(defun org-export--prepare-file-contents (file &optional lines ind minlevel)
+ "Prepare the contents of FILE for inclusion and return them as a string.
+
+When optional argument LINES is a string specifying a range of
+lines, include only those lines.
+
+Optional argument IND, when non-nil, is an integer specifying the
+global indentation of returned contents. Since its purpose is to
+allow an included file to stay in the same environment it was
+created \(i.e. a list item), it doesn't apply past the first
+headline encountered.
+
+Optional argument MINLEVEL, when non-nil, is an integer
+specifying the level that any top-level headline in the included
+file should have."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when lines
+ (let* ((lines (split-string lines "-"))
+ (lbeg (string-to-number (car lines)))
+ (lend (string-to-number (cadr lines)))
+ (beg (if (zerop lbeg) (point-min)
+ (goto-char (point-min))
+ (forward-line (1- lbeg))
+ (point)))
+ (end (if (zerop lend) (point-max)
+ (goto-char (point-min))
+ (forward-line (1- lend))
+ (point))))
+ (narrow-to-region beg end)))
+ ;; Remove blank lines at beginning and end of contents. The logic
+ ;; behind that removal is that blank lines around include keyword
+ ;; override blank lines in included file.
+ (goto-char (point-min))
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (delete-region (point) (point-max))
+ ;; If IND is set, preserve indentation of include keyword until
+ ;; the first headline encountered.
+ (when ind
+ (unless (eq major-mode 'org-mode) (org-mode))
+ (goto-char (point-min))
+ (let ((ind-str (make-string ind ? )))
+ (while (not (or (eobp) (looking-at org-outline-regexp-bol)))
+ ;; Do not move footnote definitions out of column 0.
+ (unless (and (looking-at org-footnote-definition-re)
+ (eq (org-element-type (org-element-at-point))
+ 'footnote-definition))
+ (insert ind-str))
+ (forward-line))))
+ ;; When MINLEVEL is specified, compute minimal level for headlines
+ ;; in the file (CUR-MIN), and remove stars to each headline so
+ ;; that headlines with minimal level have a level of MINLEVEL.
+ (when minlevel
+ (unless (eq major-mode 'org-mode) (org-mode))
+ (let ((levels (org-map-entries
+ (lambda () (org-reduced-level (org-current-level))))))
+ (when levels
+ (let ((offset (- minlevel (apply 'min levels))))
+ (unless (zerop offset)
+ (when org-odd-levels-only (setq offset (* offset 2)))
+ ;; Only change stars, don't bother moving whole
+ ;; sections.
+ (org-map-entries
+ (lambda () (if (< offset 0) (delete-char (abs offset))
+ (insert (make-string offset ?*))))))))))
+ (buffer-string)))
+
+
+;;; Tools For Back-Ends
+;;
+;; A whole set of tools is available to help build new exporters. Any
+;; function general enough to have its use across many back-ends
+;; should be added here.
+;;
+;; As of now, functions operating on footnotes, headlines, links,
+;; macros, references, src-blocks, tables and tables of contents are
+;; implemented.
+
+;;;; For Affiliated Keywords
+;;
+;; `org-export-read-attribute' reads a property from a given element
+;; as a plist. It can be used to normalize affiliated keywords'
+;; syntax.
+
+(defun org-export-read-attribute (attribute element &optional property)
+ "Turn ATTRIBUTE property from ELEMENT into a plist.
+
+When optional argument PROPERTY is non-nil, return the value of
+that property within attributes.
+
+This function assumes attributes are defined as \":keyword
+value\" pairs. It is appropriate for `:attr_html' like
+properties."
+ (let ((attributes
+ (let ((value (org-element-property attribute element)))
+ (and value
+ (read (format "(%s)" (mapconcat 'identity value " ")))))))
+ (if property (plist-get attributes property) attributes)))
+
+
+;;;; For Export Snippets
+;;
+;; Every export snippet is transmitted to the back-end. Though, the
+;; latter will only retain one type of export-snippet, ignoring
+;; others, based on the former's target back-end. The function
+;; `org-export-snippet-backend' returns that back-end for a given
+;; export-snippet.
+
+(defun org-export-snippet-backend (export-snippet)
+ "Return EXPORT-SNIPPET targeted back-end as a symbol.
+Translation, with `org-export-snippet-translation-alist', is
+applied."
+ (let ((back-end (org-element-property :back-end export-snippet)))
+ (intern
+ (or (cdr (assoc back-end org-export-snippet-translation-alist))
+ back-end))))
+
+
+;;;; For Footnotes
+;;
+;; `org-export-collect-footnote-definitions' is a tool to list
+;; actually used footnotes definitions in the whole parse tree, or in
+;; an headline, in order to add footnote listings throughout the
+;; transcoded data.
+;;
+;; `org-export-footnote-first-reference-p' is a predicate used by some
+;; back-ends, when they need to attach the footnote definition only to
+;; the first occurrence of the corresponding label.
+;;
+;; `org-export-get-footnote-definition' and
+;; `org-export-get-footnote-number' provide easier access to
+;; additional information relative to a footnote reference.
+
+(defun org-export-collect-footnote-definitions (data info)
+ "Return an alist between footnote numbers, labels and definitions.
+
+DATA is the parse tree from which definitions are collected.
+INFO is the plist used as a communication channel.
+
+Definitions are sorted by order of references. They either
+appear as Org data or as a secondary string for inlined
+footnotes. Unreferenced definitions are ignored."
+ (let* (num-alist
+ collect-fn ; for byte-compiler.
+ (collect-fn
+ (function
+ (lambda (data)
+ ;; Collect footnote number, label and definition in DATA.
+ (org-element-map
+ data 'footnote-reference
+ (lambda (fn)
+ (when (org-export-footnote-first-reference-p fn info)
+ (let ((def (org-export-get-footnote-definition fn info)))
+ (push
+ (list (org-export-get-footnote-number fn info)
+ (org-element-property :label fn)
+ def)
+ num-alist)
+ ;; Also search in definition for nested footnotes.
+ (when (eq (org-element-property :type fn) 'standard)
+ (funcall collect-fn def)))))
+ ;; Don't enter footnote definitions since it will happen
+ ;; when their first reference is found.
+ info nil 'footnote-definition)))))
+ (funcall collect-fn (plist-get info :parse-tree))
+ (reverse num-alist)))
+
+(defun org-export-footnote-first-reference-p (footnote-reference info)
+ "Non-nil when a footnote reference is the first one for its label.
+
+FOOTNOTE-REFERENCE is the footnote reference being considered.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-property :label footnote-reference)))
+ ;; Anonymous footnotes are always a first reference.
+ (if (not label) t
+ ;; Otherwise, return the first footnote with the same LABEL and
+ ;; test if it is equal to FOOTNOTE-REFERENCE.
+ (let* (search-refs ; for byte-compiler.
+ (search-refs
+ (function
+ (lambda (data)
+ (org-element-map
+ data 'footnote-reference
+ (lambda (fn)
+ (cond
+ ((string= (org-element-property :label fn) label)
+ (throw 'exit fn))
+ ;; If FN isn't inlined, be sure to traverse its
+ ;; definition before resuming search. See
+ ;; comments in `org-export-get-footnote-number'
+ ;; for more information.
+ ((eq (org-element-property :type fn) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition fn info)))))
+ ;; Don't enter footnote definitions since it will
+ ;; happen when their first reference is found.
+ info 'first-match 'footnote-definition)))))
+ (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree)))
+ footnote-reference)))))
+
+(defun org-export-get-footnote-definition (footnote-reference info)
+ "Return definition of FOOTNOTE-REFERENCE as parsed data.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-property :label footnote-reference)))
+ (or (org-element-property :inline-definition footnote-reference)
+ (cdr (assoc label (plist-get info :footnote-definition-alist))))))
+
+(defun org-export-get-footnote-number (footnote info)
+ "Return number associated to a footnote.
+
+FOOTNOTE is either a footnote reference or a footnote definition.
+INFO is the plist used as a communication channel."
+ (let* ((label (org-element-property :label footnote))
+ seen-refs
+ search-ref ; For byte-compiler.
+ (search-ref
+ (function
+ (lambda (data)
+ ;; Search footnote references through DATA, filling
+ ;; SEEN-REFS along the way.
+ (org-element-map
+ data 'footnote-reference
+ (lambda (fn)
+ (let ((fn-lbl (org-element-property :label fn)))
+ (cond
+ ;; Anonymous footnote match: return number.
+ ((and (not fn-lbl) (eq fn footnote))
+ (throw 'exit (1+ (length seen-refs))))
+ ;; Labels match: return number.
+ ((and label (string= label fn-lbl))
+ (throw 'exit (1+ (length seen-refs))))
+ ;; Anonymous footnote: it's always a new one. Also,
+ ;; be sure to return nil from the `cond' so
+ ;; `first-match' doesn't get us out of the loop.
+ ((not fn-lbl) (push 'inline seen-refs) nil)
+ ;; Label not seen so far: add it so SEEN-REFS.
+ ;;
+ ;; Also search for subsequent references in
+ ;; footnote definition so numbering follows reading
+ ;; logic. Note that we don't have to care about
+ ;; inline definitions, since `org-element-map'
+ ;; already traverses them at the right time.
+ ;;
+ ;; Once again, return nil to stay in the loop.
+ ((not (member fn-lbl seen-refs))
+ (push fn-lbl seen-refs)
+ (funcall search-ref
+ (org-export-get-footnote-definition fn info))
+ nil))))
+ ;; Don't enter footnote definitions since it will happen
+ ;; when their first reference is found.
+ info 'first-match 'footnote-definition)))))
+ (catch 'exit (funcall search-ref (plist-get info :parse-tree)))))
+
+
+;;;; For Headlines
+;;
+;; `org-export-get-relative-level' is a shortcut to get headline
+;; level, relatively to the lower headline level in the parsed tree.
+;;
+;; `org-export-get-headline-number' returns the section number of an
+;; headline, while `org-export-number-to-roman' allows to convert it
+;; to roman numbers.
+;;
+;; `org-export-low-level-p', `org-export-first-sibling-p' and
+;; `org-export-last-sibling-p' are three useful predicates when it
+;; comes to fulfill the `:headline-levels' property.
+
+(defun org-export-get-relative-level (headline info)
+ "Return HEADLINE relative level within current parsed tree.
+INFO is a plist holding contextual information."
+ (+ (org-element-property :level headline)
+ (or (plist-get info :headline-offset) 0)))
+
+(defun org-export-low-level-p (headline info)
+ "Non-nil when HEADLINE is considered as low level.
+
+INFO is a plist used as a communication channel.
+
+A low level headlines has a relative level greater than
+`:headline-levels' property value.
+
+Return value is the difference between HEADLINE relative level
+and the last level being considered as high enough, or nil."
+ (let ((limit (plist-get info :headline-levels)))
+ (when (wholenump limit)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (> level limit) (- level limit))))))
+
+(defun org-export-get-headline-number (headline info)
+ "Return HEADLINE numbering as a list of numbers.
+INFO is a plist holding contextual information."
+ (cdr (assoc headline (plist-get info :headline-numbering))))
+
+(defun org-export-numbered-headline-p (headline info)
+ "Return a non-nil value if HEADLINE element should be numbered.
+INFO is a plist used as a communication channel."
+ (let ((sec-num (plist-get info :section-numbers))
+ (level (org-export-get-relative-level headline info)))
+ (if (wholenump sec-num) (<= level sec-num) sec-num)))
+
+(defun org-export-number-to-roman (n)
+ "Convert integer N into a roman numeral."
+ (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
+ ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
+ ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV")
+ ( 1 . "I")))
+ (res ""))
+ (if (<= n 0)
+ (number-to-string n)
+ (while roman
+ (if (>= n (caar roman))
+ (setq n (- n (caar roman))
+ res (concat res (cdar roman)))
+ (pop roman)))
+ res)))
+
+(defun org-export-get-tags (element info &optional tags)
+ "Return list of tags associated to ELEMENT.
+
+ELEMENT has either an `headline' or an `inlinetask' type. INFO
+is a plist used as a communication channel.
+
+Select tags (see `org-export-select-tags') and exclude tags (see
+`org-export-exclude-tags') are removed from the list.
+
+When non-nil, optional argument TAGS should be a list of strings.
+Any tag belonging to this list will also be removed."
+ (org-remove-if (lambda (tag) (or (member tag (plist-get info :select-tags))
+ (member tag (plist-get info :exclude-tags))
+ (member tag tags)))
+ (org-element-property :tags element)))
+
+(defun org-export-first-sibling-p (headline info)
+ "Non-nil when HEADLINE is the first sibling in its sub-tree.
+INFO is a plist used as a communication channel."
+ (not (eq (org-element-type (org-export-get-previous-element headline info))
+ 'headline)))
+
+(defun org-export-last-sibling-p (headline info)
+ "Non-nil when HEADLINE is the last sibling in its sub-tree.
+INFO is a plist used as a communication channel."
+ (not (org-export-get-next-element headline info)))
+
+
+;;;; For Links
+;;
+;; `org-export-solidify-link-text' turns a string into a safer version
+;; for links, replacing most non-standard characters with hyphens.
+;;
+;; `org-export-get-coderef-format' returns an appropriate format
+;; string for coderefs.
+;;
+;; `org-export-inline-image-p' returns a non-nil value when the link
+;; provided should be considered as an inline image.
+;;
+;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links
+;; (i.e. links with "fuzzy" as type) within the parsed tree, and
+;; returns an appropriate unique identifier when found, or nil.
+;;
+;; `org-export-resolve-id-link' returns the first headline with
+;; specified id or custom-id in parse tree, the path to the external
+;; file with the id or nil when neither was found.
+;;
+;; `org-export-resolve-coderef' associates a reference to a line
+;; number in the element it belongs, or returns the reference itself
+;; when the element isn't numbered.
+
+(defun org-export-solidify-link-text (s)
+ "Take link text S and make a safe target out of it."
+ (save-match-data
+ (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-]+") "-")))
+
+(defun org-export-get-coderef-format (path desc)
+ "Return format string for code reference link.
+PATH is the link path. DESC is its description."
+ (save-match-data
+ (cond ((not desc) "%s")
+ ((string-match (regexp-quote (concat "(" path ")")) desc)
+ (replace-match "%s" t t desc))
+ (t desc))))
+
+(defun org-export-inline-image-p (link &optional rules)
+ "Non-nil if LINK object points to an inline image.
+
+Optional argument is a set of RULES defining inline images. It
+is an alist where associations have the following shape:
+
+ \(TYPE . REGEXP)
+
+Applying a rule means apply REGEXP against LINK's path when its
+type is TYPE. The function will return a non-nil value if any of
+the provided rules is non-nil. The default rule is
+`org-export-default-inline-image-rule'.
+
+This only applies to links without a description."
+ (and (not (org-element-contents link))
+ (let ((case-fold-search t)
+ (rules (or rules org-export-default-inline-image-rule)))
+ (catch 'exit
+ (mapc
+ (lambda (rule)
+ (and (string= (org-element-property :type link) (car rule))
+ (string-match (cdr rule)
+ (org-element-property :path link))
+ (throw 'exit t)))
+ rules)
+ ;; Return nil if no rule matched.
+ nil))))
+
+(defun org-export-resolve-coderef (ref info)
+ "Resolve a code reference REF.
+
+INFO is a plist used as a communication channel.
+
+Return associated line number in source code, or REF itself,
+depending on src-block or example element's switches."
+ (org-element-map
+ (plist-get info :parse-tree) '(example-block src-block)
+ (lambda (el)
+ (with-temp-buffer
+ (insert (org-trim (org-element-property :value el)))
+ (let* ((label-fmt (regexp-quote
+ (or (org-element-property :label-fmt el)
+ org-coderef-label-format)))
+ (ref-re
+ (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
+ (replace-regexp-in-string "%s" ref label-fmt nil t))))
+ ;; Element containing REF is found. Resolve it to either
+ ;; a label or a line number, as needed.
+ (when (re-search-backward ref-re nil t)
+ (cond
+ ((org-element-property :use-labels el) ref)
+ ((eq (org-element-property :number-lines el) 'continued)
+ (+ (org-export-get-loc el info) (line-number-at-pos)))
+ (t (line-number-at-pos)))))))
+ info 'first-match))
+
+(defun org-export-resolve-fuzzy-link (link info)
+ "Return LINK destination.
+
+INFO is a plist holding contextual information.
+
+Return value can be an object, an element, or nil:
+
+- If LINK path matches a target object (i.e. <<path>>) or
+ element (i.e. \"#+TARGET: path\"), return it.
+
+- If LINK path exactly matches the name affiliated keyword
+ \(i.e. #+NAME: path) of an element, return that element.
+
+- If LINK path exactly matches any headline name, return that
+ element. If more than one headline share that name, priority
+ will be given to the one with the closest common ancestor, if
+ any, or the first one in the parse tree otherwise.
+
+- Otherwise, return nil.
+
+Assume LINK type is \"fuzzy\"."
+ (let* ((path (org-element-property :path link))
+ (match-title-p (eq (aref path 0) ?*)))
+ (cond
+ ;; First try to find a matching "<<path>>" unless user specified
+ ;; he was looking for an headline (path starts with a *
+ ;; character).
+ ((and (not match-title-p)
+ (loop for target in (plist-get info :target-list)
+ when (string= (org-element-property :value target) path)
+ return target)))
+ ;; Then try to find an element with a matching "#+NAME: path"
+ ;; affiliated keyword.
+ ((and (not match-title-p)
+ (org-element-map
+ (plist-get info :parse-tree) org-element-all-elements
+ (lambda (el)
+ (when (string= (org-element-property :name el) path) el))
+ info 'first-match)))
+ ;; Last case: link either points to an headline or to
+ ;; nothingness. Try to find the source, with priority given to
+ ;; headlines with the closest common ancestor. If such candidate
+ ;; is found, return it, otherwise return nil.
+ (t
+ (let ((find-headline
+ (function
+ ;; Return first headline whose `:raw-value' property
+ ;; is NAME in parse tree DATA, or nil.
+ (lambda (name data)
+ (org-element-map
+ data 'headline
+ (lambda (headline)
+ (when (string=
+ (org-element-property :raw-value headline)
+ name)
+ headline))
+ info 'first-match)))))
+ ;; Search among headlines sharing an ancestor with link,
+ ;; from closest to farthest.
+ (or (catch 'exit
+ (mapc
+ (lambda (parent)
+ (when (eq (org-element-type parent) 'headline)
+ (let ((foundp (funcall find-headline path parent)))
+ (when foundp (throw 'exit foundp)))))
+ (org-export-get-genealogy link)) nil)
+ ;; No match with a common ancestor: try the full parse-tree.
+ (funcall find-headline
+ (if match-title-p (substring path 1) path)
+ (plist-get info :parse-tree))))))))
+
+(defun org-export-resolve-id-link (link info)
+ "Return headline referenced as LINK destination.
+
+INFO is a plist used as a communication channel.
+
+Return value can be the headline element matched in current parse
+tree, a file name or nil. Assume LINK type is either \"id\" or
+\"custom-id\"."
+ (let ((id (org-element-property :path link)))
+ ;; First check if id is within the current parse tree.
+ (or (org-element-map
+ (plist-get info :parse-tree) 'headline
+ (lambda (headline)
+ (when (or (string= (org-element-property :id headline) id)
+ (string= (org-element-property :custom-id headline) id))
+ headline))
+ info 'first-match)
+ ;; Otherwise, look for external files.
+ (cdr (assoc id (plist-get info :id-alist))))))
+
+(defun org-export-resolve-radio-link (link info)
+ "Return radio-target object referenced as LINK destination.
+
+INFO is a plist used as a communication channel.
+
+Return value can be a radio-target object or nil. Assume LINK
+has type \"radio\"."
+ (let ((path (org-element-property :path link)))
+ (org-element-map
+ (plist-get info :parse-tree) 'radio-target
+ (lambda (radio)
+ (when (equal (org-element-property :value radio) path) radio))
+ info 'first-match)))
+
+
+;;;; For Macros
+;;
+;; `org-export-expand-macro' simply takes care of expanding macros.
+
+(defun org-export-expand-macro (macro info)
+ "Expand MACRO and return it as a string.
+INFO is a plist holding export options."
+ (let* ((key (org-element-property :key macro))
+ (args (org-element-property :args macro))
+ ;; User's macros are stored in the communication channel with
+ ;; a ":macro-" prefix. Replace arguments in VALUE. Also
+ ;; expand recursively macros within.
+ (value (org-export-data
+ (mapcar
+ (lambda (obj)
+ (if (not (stringp obj)) (org-export-data obj info)
+ (replace-regexp-in-string
+ "\\$[0-9]+"
+ (lambda (arg)
+ (nth (1- (string-to-number (substring arg 1))) args))
+ obj)))
+ (plist-get info (intern (format ":macro-%s" key))))
+ info)))
+ ;; VALUE starts with "(eval": it is a s-exp, `eval' it.
+ (when (string-match "\\`(eval\\>" value) (setq value (eval (read value))))
+ ;; Return string.
+ (format "%s" (or value ""))))
+
+
+;;;; For References
+;;
+;; `org-export-get-ordinal' associates a sequence number to any object
+;; or element.
+
+(defun org-export-get-ordinal (element info &optional types predicate)
+ "Return ordinal number of an element or object.
+
+ELEMENT is the element or object considered. INFO is the plist
+used as a communication channel.
+
+Optional argument TYPES, when non-nil, is a list of element or
+object types, as symbols, that should also be counted in.
+Otherwise, only provided element's type is considered.
+
+Optional argument PREDICATE is a function returning a non-nil
+value if the current element or object should be counted in. It
+accepts two arguments: the element or object being considered and
+the plist used as a communication channel. This allows to count
+only a certain type of objects (i.e. inline images).
+
+Return value is a list of numbers if ELEMENT is an headline or an
+item. It is nil for keywords. It represents the footnote number
+for footnote definitions and footnote references. If ELEMENT is
+a target, return the same value as if ELEMENT was the closest
+table, item or headline containing the target. In any other
+case, return the sequence number of ELEMENT among elements or
+objects of the same type."
+ ;; A target keyword, representing an invisible target, never has
+ ;; a sequence number.
+ (unless (eq (org-element-type element) 'keyword)
+ ;; Ordinal of a target object refer to the ordinal of the closest
+ ;; table, item, or headline containing the object.
+ (when (eq (org-element-type element) 'target)
+ (setq element
+ (loop for parent in (org-export-get-genealogy element)
+ when
+ (memq
+ (org-element-type parent)
+ '(footnote-definition footnote-reference headline item
+ table))
+ return parent)))
+ (case (org-element-type element)
+ ;; Special case 1: An headline returns its number as a list.
+ (headline (org-export-get-headline-number element info))
+ ;; Special case 2: An item returns its number as a list.
+ (item (let ((struct (org-element-property :structure element)))
+ (org-list-get-item-number
+ (org-element-property :begin element)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct))))
+ ((footnote-definition footnote-reference)
+ (org-export-get-footnote-number element info))
+ (otherwise
+ (let ((counter 0))
+ ;; Increment counter until ELEMENT is found again.
+ (org-element-map
+ (plist-get info :parse-tree) (or types (org-element-type element))
+ (lambda (el)
+ (cond
+ ((eq element el) (1+ counter))
+ ((not predicate) (incf counter) nil)
+ ((funcall predicate el info) (incf counter) nil)))
+ info 'first-match))))))
+
+
+;;;; For Src-Blocks
+;;
+;; `org-export-get-loc' counts number of code lines accumulated in
+;; src-block or example-block elements with a "+n" switch until
+;; a given element, excluded. Note: "-n" switches reset that count.
+;;
+;; `org-export-unravel-code' extracts source code (along with a code
+;; references alist) from an `element-block' or `src-block' type
+;; element.
+;;
+;; `org-export-format-code' applies a formatting function to each line
+;; of code, providing relative line number and code reference when
+;; appropriate. Since it doesn't access the original element from
+;; which the source code is coming, it expects from the code calling
+;; it to know if lines should be numbered and if code references
+;; should appear.
+;;
+;; Eventually, `org-export-format-code-default' is a higher-level
+;; function (it makes use of the two previous functions) which handles
+;; line numbering and code references inclusion, and returns source
+;; code in a format suitable for plain text or verbatim output.
+
+(defun org-export-get-loc (element info)
+ "Return accumulated lines of code up to ELEMENT.
+
+INFO is the plist used as a communication channel.
+
+ELEMENT is excluded from count."
+ (let ((loc 0))
+ (org-element-map
+ (plist-get info :parse-tree)
+ `(src-block example-block ,(org-element-type element))
+ (lambda (el)
+ (cond
+ ;; ELEMENT is reached: Quit the loop.
+ ((eq el element))
+ ;; Only count lines from src-block and example-block elements
+ ;; with a "+n" or "-n" switch. A "-n" switch resets counter.
+ ((not (memq (org-element-type el) '(src-block example-block))) nil)
+ ((let ((linums (org-element-property :number-lines el)))
+ (when linums
+ ;; Accumulate locs or reset them.
+ (let ((lines (org-count-lines
+ (org-trim (org-element-property :value el)))))
+ (setq loc (if (eq linums 'new) lines (+ loc lines))))))
+ ;; Return nil to stay in the loop.
+ nil)))
+ info 'first-match)
+ ;; Return value.
+ loc))
+
+(defun org-export-unravel-code (element)
+ "Clean source code and extract references out of it.
+
+ELEMENT has either a `src-block' an `example-block' type.
+
+Return a cons cell whose CAR is the source code, cleaned from any
+reference and protective comma and CDR is an alist between
+relative line number (integer) and name of code reference on that
+line (string)."
+ (let* ((line 0) refs
+ ;; Get code and clean it. Remove blank lines at its
+ ;; beginning and end. Also remove protective commas.
+ (code (let ((c (replace-regexp-in-string
+ "\\`\\([ \t]*\n\\)+" ""
+ (replace-regexp-in-string
+ "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n"
+ (org-element-property :value element)))))
+ ;; If appropriate, remove global indentation.
+ (unless (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element))
+ (setq c (org-remove-indentation c)))
+ ;; Free up the protected lines. Note: Org blocks
+ ;; have commas at the beginning or every line.
+ (if (string= (org-element-property :language element) "org")
+ (replace-regexp-in-string "^," "" c)
+ (replace-regexp-in-string
+ "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1))))
+ ;; Get format used for references.
+ (label-fmt (regexp-quote
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format)))
+ ;; Build a regexp matching a loc with a reference.
+ (with-ref-re
+ (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$"
+ (replace-regexp-in-string
+ "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))))
+ ;; Return value.
+ (cons
+ ;; Code with references removed.
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (loc)
+ (incf line)
+ (if (not (string-match with-ref-re loc)) loc
+ ;; Ref line: remove ref, and signal its position in REFS.
+ (push (cons line (match-string 3 loc)) refs)
+ (replace-match "" nil nil loc 1)))
+ (org-split-string code "\n") "\n"))
+ ;; Reference alist.
+ refs)))
+
+(defun org-export-format-code (code fun &optional num-lines ref-alist)
+ "Format CODE by applying FUN line-wise and return it.
+
+CODE is a string representing the code to format. FUN is
+a function. It must accept three arguments: a line of
+code (string), the current line number (integer) or nil and the
+reference associated to the current line (string) or nil.
+
+Optional argument NUM-LINES can be an integer representing the
+number of code lines accumulated until the current code. Line
+numbers passed to FUN will take it into account. If it is nil,
+FUN's second argument will always be nil. This number can be
+obtained with `org-export-get-loc' function.
+
+Optional argument REF-ALIST can be an alist between relative line
+number (i.e. ignoring NUM-LINES) and the name of the code
+reference on it. If it is nil, FUN's third argument will always
+be nil. It can be obtained through the use of
+`org-export-unravel-code' function."
+ (let ((--locs (org-split-string code "\n"))
+ (--line 0))
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (--loc)
+ (incf --line)
+ (let ((--ref (cdr (assq --line ref-alist))))
+ (funcall fun --loc (and num-lines (+ num-lines --line)) --ref)))
+ --locs "\n"))))
+
+(defun org-export-format-code-default (element info)
+ "Return source code from ELEMENT, formatted in a standard way.
+
+ELEMENT is either a `src-block' or `example-block' element. INFO
+is a plist used as a communication channel.
+
+This function takes care of line numbering and code references
+inclusion. Line numbers, when applicable, appear at the
+beginning of the line, separated from the code by two white
+spaces. Code references, on the other hand, appear flushed to
+the right, separated by six white spaces from the widest line of
+code."
+ ;; Extract code and references.
+ (let* ((code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (code-lines (org-split-string code "\n"))
+ (refs (and (org-element-property :retain-labels element)
+ (cdr code-info)))
+ ;; Handle line numbering.
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0)))
+ (num-fmt
+ (and num-start
+ (format "%%%ds "
+ (length (number-to-string
+ (+ (length code-lines) num-start))))))
+ ;; Prepare references display, if required. Any reference
+ ;; should start six columns after the widest line of code,
+ ;; wrapped with parenthesis.
+ (max-width
+ (+ (apply 'max (mapcar 'length code-lines))
+ (if (not num-start) 0 (length (format num-fmt num-start))))))
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (let ((number-str (and num-fmt (format num-fmt line-num))))
+ (concat
+ number-str
+ loc
+ (and ref
+ (concat (make-string
+ (- (+ 6 max-width)
+ (+ (length loc) (length number-str))) ? )
+ (format "(%s)" ref))))))
+ num-start refs)))
+
+
+;;;; For Tables
+;;
+;; `org-export-table-has-special-column-p' and and
+;; `org-export-table-row-is-special-p' are predicates used to look for
+;; meta-information about the table structure.
+;;
+;; `org-table-has-header-p' tells when the rows before the first rule
+;; should be considered as table's header.
+;;
+;; `org-export-table-cell-width', `org-export-table-cell-alignment'
+;; and `org-export-table-cell-borders' extract information from
+;; a table-cell element.
+;;
+;; `org-export-table-dimensions' gives the number on rows and columns
+;; in the table, ignoring horizontal rules and special columns.
+;; `org-export-table-cell-address', given a table-cell object, returns
+;; the absolute address of a cell. On the other hand,
+;; `org-export-get-table-cell-at' does the contrary.
+;;
+;; `org-export-table-cell-starts-colgroup-p',
+;; `org-export-table-cell-ends-colgroup-p',
+;; `org-export-table-row-starts-rowgroup-p',
+;; `org-export-table-row-ends-rowgroup-p',
+;; `org-export-table-row-starts-header-p' and
+;; `org-export-table-row-ends-header-p' indicate position of current
+;; row or cell within the table.
+
+(defun org-export-table-has-special-column-p (table)
+ "Non-nil when TABLE has a special column.
+All special columns will be ignored during export."
+ ;; The table has a special column when every first cell of every row
+ ;; has an empty value or contains a symbol among "/", "#", "!", "$",
+ ;; "*" "_" and "^". Though, do not consider a first row containing
+ ;; only empty cells as special.
+ (let ((special-column-p 'empty))
+ (catch 'exit
+ (mapc
+ (lambda (row)
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((value (org-element-contents
+ (car (org-element-contents row)))))
+ (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+ (setq special-column-p 'special))
+ ((not value))
+ (t (throw 'exit nil))))))
+ (org-element-contents table))
+ (eq special-column-p 'special))))
+
+(defun org-export-table-has-header-p (table info)
+ "Non-nil when TABLE has an header.
+
+INFO is a plist used as a communication channel.
+
+A table has an header when it contains at least two row groups."
+ (let ((rowgroup 1) row-flag)
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (cond
+ ((> rowgroup 1) t)
+ ((and row-flag (eq (org-element-property :type row) 'rule))
+ (incf rowgroup) (setq row-flag nil))
+ ((and (not row-flag) (eq (org-element-property :type row) 'standard))
+ (setq row-flag t) nil)))
+ info)))
+
+(defun org-export-table-row-is-special-p (table-row info)
+ "Non-nil if TABLE-ROW is considered special.
+
+INFO is a plist used as the communication channel.
+
+All special rows will be ignored during export."
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let ((first-cell (org-element-contents
+ (car (org-element-contents table-row)))))
+ ;; A row is special either when...
+ (or
+ ;; ... it starts with a field only containing "/",
+ (equal first-cell '("/"))
+ ;; ... the table contains a special column and the row start
+ ;; with a marking character among, "^", "_", "$" or "!",
+ (and (org-export-table-has-special-column-p
+ (org-export-get-parent table-row))
+ (member first-cell '(("^") ("_") ("$") ("!"))))
+ ;; ... it contains only alignment cookies and empty cells.
+ (let ((special-row-p 'empty))
+ (catch 'exit
+ (mapc
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ ;; Since VALUE is a secondary string, the following
+ ;; checks avoid expanding it with `org-export-data'.
+ (cond ((not value))
+ ((and (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
+ (car value)))
+ (setq special-row-p 'cookie))
+ (t (throw 'exit nil)))))
+ (org-element-contents table-row))
+ (eq special-row-p 'cookie)))))))
+
+(defun org-export-table-row-group (table-row info)
+ "Return TABLE-ROW's group.
+
+INFO is a plist used as the communication channel.
+
+Return value is the group number, as an integer, or nil special
+rows and table rules. Group 1 is also table's header."
+ (unless (or (eq (org-element-property :type table-row) 'rule)
+ (org-export-table-row-is-special-p table-row info))
+ (let ((group 0) row-flag)
+ (catch 'found
+ (mapc
+ (lambda (row)
+ (cond
+ ((and (eq (org-element-property :type row) 'standard)
+ (not (org-export-table-row-is-special-p row info)))
+ (unless row-flag (incf group) (setq row-flag t)))
+ ((eq (org-element-property :type row) 'rule)
+ (setq row-flag nil)))
+ (when (eq table-row row) (throw 'found group)))
+ (org-element-contents (org-export-get-parent table-row)))))))
+
+(defun org-export-table-cell-width (table-cell info)
+ "Return TABLE-CELL contents width.
+
+INFO is a plist used as the communication channel.
+
+Return value is the width given by the last width cookie in the
+same column as TABLE-CELL, or nil."
+ (let* ((row (org-export-get-parent table-cell))
+ (column (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells)))))
+ (table (org-export-get-parent-table table-cell))
+ cookie-width)
+ (mapc
+ (lambda (row)
+ (cond
+ ;; In a special row, try to find a width cookie at COLUMN.
+ ((org-export-table-row-is-special-p row info)
+ (let ((value (org-element-contents
+ (elt (org-element-contents row) column))))
+ ;; The following checks avoid expanding unnecessarily the
+ ;; cell with `org-export-data'
+ (when (and value
+ (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" (car value))
+ (match-string 1 (car value)))
+ (setq cookie-width
+ (string-to-number (match-string 1 (car value)))))))
+ ;; Ignore table rules.
+ ((eq (org-element-property :type row) 'rule))))
+ (org-element-contents table))
+ ;; Return value.
+ cookie-width))
+
+(defun org-export-table-cell-alignment (table-cell info)
+ "Return TABLE-CELL contents alignment.
+
+INFO is a plist used as the communication channel.
+
+Return alignment as specified by the last alignment cookie in the
+same column as TABLE-CELL. If no such cookie is found, a default
+alignment value will be deduced from fraction of numbers in the
+column (see `org-table-number-fraction' for more information).
+Possible values are `left', `right' and `center'."
+ (let* ((row (org-export-get-parent table-cell))
+ (column (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells)))))
+ (table (org-export-get-parent-table table-cell))
+ (number-cells 0)
+ (total-cells 0)
+ cookie-align)
+ (mapc
+ (lambda (row)
+ (cond
+ ;; In a special row, try to find an alignment cookie at
+ ;; COLUMN.
+ ((org-export-table-row-is-special-p row info)
+ (let ((value (org-element-contents
+ (elt (org-element-contents row) column))))
+ ;; Since VALUE is a secondary string, the following checks
+ ;; avoid useless expansion through `org-export-data'.
+ (when (and value
+ (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'"
+ (car value))
+ (match-string 1 (car value)))
+ (setq cookie-align (match-string 1 (car value))))))
+ ;; Ignore table rules.
+ ((eq (org-element-property :type row) 'rule))
+ ;; In a standard row, check if cell's contents are expressing
+ ;; some kind of number. Increase NUMBER-CELLS accordingly.
+ ;; Though, don't bother if an alignment cookie has already
+ ;; defined cell's alignment.
+ ((not cookie-align)
+ (let ((value (org-export-data
+ (org-element-contents
+ (elt (org-element-contents row) column))
+ info)))
+ (incf total-cells)
+ (when (string-match org-table-number-regexp value)
+ (incf number-cells))))))
+ (org-element-contents table))
+ ;; Return value. Alignment specified by cookies has precedence
+ ;; over alignment deduced from cells contents.
+ (cond ((equal cookie-align "l") 'left)
+ ((equal cookie-align "r") 'right)
+ ((equal cookie-align "c") 'center)
+ ((>= (/ (float number-cells) total-cells) org-table-number-fraction)
+ 'right)
+ (t 'left))))
+
+(defun org-export-table-cell-borders (table-cell info)
+ "Return TABLE-CELL borders.
+
+INFO is a plist used as a communication channel.
+
+Return value is a list of symbols, or nil. Possible values are:
+`top', `bottom', `above', `below', `left' and `right'. Note:
+`top' (resp. `bottom') only happen for a cell in the first
+row (resp. last row) of the table, ignoring table rules, if any.
+
+Returned borders ignore special rows."
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent-table table-cell))
+ borders)
+ ;; Top/above border? TABLE-CELL has a border above when a rule
+ ;; used to demarcate row groups can be found above. Hence,
+ ;; finding a rule isn't sufficient to push `above' in BORDERS:
+ ;; another regular row has to be found above that rule.
+ (let (rule-flag)
+ (catch 'exit
+ (mapc (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'above borders))
+ (throw 'exit nil)))))
+ ;; Look at every row before the current one.
+ (cdr (memq row (reverse (org-element-contents table)))))
+ ;; No rule above, or rule found starts the table (ignoring any
+ ;; special row): TABLE-CELL is at the top of the table.
+ (when rule-flag (push 'above borders))
+ (push 'top borders)))
+ ;; Bottom/below border? TABLE-CELL has a border below when next
+ ;; non-regular row below is a rule.
+ (let (rule-flag)
+ (catch 'exit
+ (mapc (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'below borders))
+ (throw 'exit nil)))))
+ ;; Look at every row after the current one.
+ (cdr (memq row (org-element-contents table))))
+ ;; No rule below, or rule found ends the table (modulo some
+ ;; special row): TABLE-CELL is at the bottom of the table.
+ (when rule-flag (push 'below borders))
+ (push 'bottom borders)))
+ ;; Right/left borders? They can only be specified by column
+ ;; groups. Column groups are defined in a row starting with "/".
+ ;; Also a column groups row only contains "<", "<>", ">" or blank
+ ;; cells.
+ (catch 'exit
+ (let ((column (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells))))))
+ (mapc
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule)
+ (when (equal (org-element-contents
+ (car (org-element-contents row)))
+ '("/"))
+ (let ((column-groups
+ (mapcar
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ (when (member value '(("<") ("<>") (">") nil))
+ (car value))))
+ (org-element-contents row))))
+ ;; There's a left border when previous cell, if
+ ;; any, ends a group, or current one starts one.
+ (when (or (and (not (zerop column))
+ (member (elt column-groups (1- column))
+ '(">" "<>")))
+ (member (elt column-groups column) '("<" "<>")))
+ (push 'left borders))
+ ;; There's a right border when next cell, if any,
+ ;; starts a group, or current one ends one.
+ (when (or (and (/= (1+ column) (length column-groups))
+ (member (elt column-groups (1+ column))
+ '("<" "<>")))
+ (member (elt column-groups column) '(">" "<>")))
+ (push 'right borders))
+ (throw 'exit nil)))))
+ ;; Table rows are read in reverse order so last column groups
+ ;; row has precedence over any previous one.
+ (reverse (org-element-contents table)))))
+ ;; Return value.
+ borders))
+
+(defun org-export-table-cell-starts-colgroup-p (table-cell info)
+ "Non-nil when TABLE-CELL is at the beginning of a row group.
+INFO is a plist used as a communication channel."
+ ;; A cell starts a column group either when it is at the beginning
+ ;; of a row (or after the special column, if any) or when it has
+ ;; a left border.
+ (or (eq (org-element-map
+ (org-export-get-parent table-cell)
+ 'table-cell 'identity info 'first-match)
+ table-cell)
+ (memq 'left (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-cell-ends-colgroup-p (table-cell info)
+ "Non-nil when TABLE-CELL is at the end of a row group.
+INFO is a plist used as a communication channel."
+ ;; A cell ends a column group either when it is at the end of a row
+ ;; or when it has a right border.
+ (or (eq (car (last (org-element-contents
+ (org-export-get-parent table-cell))))
+ table-cell)
+ (memq 'right (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-row-starts-rowgroup-p (table-row info)
+ "Non-nil when TABLE-ROW is at the beginning of a column group.
+INFO is a plist used as a communication channel."
+ (unless (or (eq (org-element-property :type table-row) 'rule)
+ (org-export-table-row-is-special-p table-row info))
+ (let ((borders (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (or (memq 'top borders) (memq 'above borders)))))
+
+(defun org-export-table-row-ends-rowgroup-p (table-row info)
+ "Non-nil when TABLE-ROW is at the end of a column group.
+INFO is a plist used as a communication channel."
+ (unless (or (eq (org-element-property :type table-row) 'rule)
+ (org-export-table-row-is-special-p table-row info))
+ (let ((borders (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (or (memq 'bottom borders) (memq 'below borders)))))
+
+(defun org-export-table-row-starts-header-p (table-row info)
+ "Non-nil when TABLE-ROW is the first table header's row.
+INFO is a plist used as a communication channel."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (org-export-table-row-starts-rowgroup-p table-row info)
+ (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-row-ends-header-p (table-row info)
+ "Non-nil when TABLE-ROW is the last table header's row.
+INFO is a plist used as a communication channel."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (org-export-table-row-ends-rowgroup-p table-row info)
+ (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-dimensions (table info)
+ "Return TABLE dimensions.
+
+INFO is a plist used as a communication channel.
+
+Return value is a CONS like (ROWS . COLUMNS) where
+ROWS (resp. COLUMNS) is the number of exportable
+rows (resp. columns)."
+ (let (first-row (columns 0) (rows 0))
+ ;; Set number of rows, and extract first one.
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (when (eq (org-element-property :type row) 'standard)
+ (incf rows)
+ (unless first-row (setq first-row row)))) info)
+ ;; Set number of columns.
+ (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info)
+ ;; Return value.
+ (cons rows columns)))
+
+(defun org-export-table-cell-address (table-cell info)
+ "Return address of a regular TABLE-CELL object.
+
+TABLE-CELL is the cell considered. INFO is a plist used as
+a communication channel.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index. Only exportable cells are considered. The
+function returns nil for other cells."
+ (let* ((table-row (org-export-get-parent table-cell))
+ (table (org-export-get-parent-table table-cell)))
+ ;; Ignore cells in special rows or in special column.
+ (unless (or (org-export-table-row-is-special-p table-row info)
+ (and (org-export-table-has-special-column-p table)
+ (eq (car (org-element-contents table-row)) table-cell)))
+ (cons
+ ;; Row number.
+ (let ((row-count 0))
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule) nil)
+ ((eq row table-row) row-count)
+ (t (incf row-count) nil)))
+ info 'first-match))
+ ;; Column number.
+ (let ((col-count 0))
+ (org-element-map
+ table-row 'table-cell
+ (lambda (cell)
+ (if (eq cell table-cell) col-count (incf col-count) nil))
+ info 'first-match))))))
+
+(defun org-export-get-table-cell-at (address table info)
+ "Return regular table-cell object at ADDRESS in TABLE.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index. TABLE is a table type element. INFO is
+a plist used as a communication channel.
+
+If no table-cell, among exportable cells, is found at ADDRESS,
+return nil."
+ (let ((column-pos (cdr address)) (column-count 0))
+ (org-element-map
+ ;; Row at (car address) or nil.
+ (let ((row-pos (car address)) (row-count 0))
+ (org-element-map
+ table 'table-row
+ (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule) nil)
+ ((= row-count row-pos) row)
+ (t (incf row-count) nil)))
+ info 'first-match))
+ 'table-cell
+ (lambda (cell)
+ (if (= column-count column-pos) cell
+ (incf column-count) nil))
+ info 'first-match)))
+
+
+;;;; For Tables Of Contents
+;;
+;; `org-export-collect-headlines' builds a list of all exportable
+;; headline elements, maybe limited to a certain depth. One can then
+;; easily parse it and transcode it.
+;;
+;; Building lists of tables, figures or listings is quite similar.
+;; Once the generic function `org-export-collect-elements' is defined,
+;; `org-export-collect-tables', `org-export-collect-figures' and
+;; `org-export-collect-listings' can be derived from it.
+
+(defun org-export-collect-headlines (info &optional n)
+ "Collect headlines in order to build a table of contents.
+
+INFO is a plist used as a communication channel.
+
+When optional argument N is an integer, it specifies the depth of
+the table of contents. Otherwise, it is set to the value of the
+last headline level. See `org-export-headline-levels' for more
+information.
+
+Return a list of all exportable headlines as parsed elements."
+ (unless (wholenump n) (setq n (plist-get info :headline-levels)))
+ (org-element-map
+ (plist-get info :parse-tree)
+ 'headline
+ (lambda (headline)
+ ;; Strip contents from HEADLINE.
+ (let ((relative-level (org-export-get-relative-level headline info)))
+ (unless (> relative-level n) headline)))
+ info))
+
+(defun org-export-collect-elements (type info &optional predicate)
+ "Collect referenceable elements of a determined type.
+
+TYPE can be a symbol or a list of symbols specifying element
+types to search. Only elements with a caption are collected.
+
+INFO is a plist used as a communication channel.
+
+When non-nil, optional argument PREDICATE is a function accepting
+one argument, an element of type TYPE. It returns a non-nil
+value when that element should be collected.
+
+Return a list of all elements found, in order of appearance."
+ (org-element-map
+ (plist-get info :parse-tree) type
+ (lambda (element)
+ (and (org-element-property :caption element)
+ (or (not predicate) (funcall predicate element))
+ element))
+ info))
+
+(defun org-export-collect-tables (info)
+ "Build a list of tables.
+INFO is a plist used as a communication channel.
+
+Return a list of table elements with a caption."
+ (org-export-collect-elements 'table info))
+
+(defun org-export-collect-figures (info predicate)
+ "Build a list of figures.
+
+INFO is a plist used as a communication channel. PREDICATE is
+a function which accepts one argument: a paragraph element and
+whose return value is non-nil when that element should be
+collected.
+
+A figure is a paragraph type element, with a caption, verifying
+PREDICATE. The latter has to be provided since a \"figure\" is
+a vague concept that may depend on back-end.
+
+Return a list of elements recognized as figures."
+ (org-export-collect-elements 'paragraph info predicate))
+
+(defun org-export-collect-listings (info)
+ "Build a list of src blocks.
+
+INFO is a plist used as a communication channel.
+
+Return a list of src-block elements with a caption."
+ (org-export-collect-elements 'src-block info))
+
+
+;;;; Topology
+;;
+;; Here are various functions to retrieve information about the
+;; neighbourhood of a given element or object. Neighbours of interest
+;; are direct parent (`org-export-get-parent'), parent headline
+;; (`org-export-get-parent-headline'), first element containing an
+;; object, (`org-export-get-parent-element'), parent table
+;; (`org-export-get-parent-table'), previous element or object
+;; (`org-export-get-previous-element') and next element or object
+;; (`org-export-get-next-element').
+;;
+;; `org-export-get-genealogy' returns the full genealogy of a given
+;; element or object, from closest parent to full parse tree.
+
+(defun org-export-get-parent (blob)
+ "Return BLOB parent or nil.
+BLOB is the element or object considered."
+ (org-element-property :parent blob))
+
+(defun org-export-get-genealogy (blob)
+ "Return full genealogy relative to a given element or object.
+
+BLOB is the element or object being considered.
+
+Ancestors are returned from closest to farthest, the last one
+being the full parse tree."
+ (let (genealogy (parent blob))
+ (while (setq parent (org-element-property :parent parent))
+ (push parent genealogy))
+ (nreverse genealogy)))
+
+(defun org-export-get-parent-headline (blob)
+ "Return BLOB parent headline or nil.
+BLOB is the element or object being considered."
+ (let ((parent blob))
+ (while (and (setq parent (org-element-property :parent parent))
+ (not (eq (org-element-type parent) 'headline))))
+ parent))
+
+(defun org-export-get-parent-element (object)
+ "Return first element containing OBJECT or nil.
+OBJECT is the object to consider."
+ (let ((parent object))
+ (while (and (setq parent (org-element-property :parent parent))
+ (memq (org-element-type parent) org-element-all-objects)))
+ parent))
+
+(defun org-export-get-parent-table (object)
+ "Return OBJECT parent table or nil.
+OBJECT is either a `table-cell' or `table-element' type object."
+ (let ((parent object))
+ (while (and (setq parent (org-element-property :parent parent))
+ (not (eq (org-element-type parent) 'table))))
+ parent))
+
+(defun org-export-get-previous-element (blob info)
+ "Return previous element or object.
+BLOB is an element or object. INFO is a plist used as
+a communication channel. Return previous exportable element or
+object, a string, or nil."
+ (let (prev)
+ (catch 'exit
+ (mapc (lambda (obj)
+ (cond ((eq obj blob) (throw 'exit prev))
+ ((memq obj (plist-get info :ignore-list)))
+ (t (setq prev obj))))
+ (org-element-contents (org-export-get-parent blob))))))
+
+(defun org-export-get-next-element (blob info)
+ "Return next element or object.
+BLOB is an element or object. INFO is a plist used as
+a communication channel. Return next exportable element or
+object, a string, or nil."
+ (catch 'found
+ (mapc (lambda (obj)
+ (unless (memq obj (plist-get info :ignore-list))
+ (throw 'found obj)))
+ (cdr (memq blob (org-element-contents (org-export-get-parent blob)))))
+ nil))
+
+
+;;;; Translation
+;;
+;; `org-export-translate' translates a string according to language
+;; specified by LANGUAGE keyword or `org-export-language-setup'
+;; variable and a specified charset. `org-export-dictionary' contains
+;; the dictionary used for the translation.
+
+(defconst org-export-dictionary
+ '(("Author"
+ ("fr"
+ :ascii "Auteur"
+ :latin1 "Auteur"
+ :utf-8 "Auteur"))
+ ("Date"
+ ("fr"
+ :ascii "Date"
+ :latin1 "Date"
+ :utf-8 "Date"))
+ ("Equation")
+ ("Figure")
+ ("Footnotes"
+ ("fr"
+ :ascii "Notes de bas de page"
+ :latin1 "Notes de bas de page"
+ :utf-8 "Notes de bas de page"))
+ ("List of Listings"
+ ("fr"
+ :ascii "Liste des programmes"
+ :latin1 "Liste des programmes"
+ :utf-8 "Liste des programmes"))
+ ("List of Tables"
+ ("fr"
+ :ascii "Liste des tableaux"
+ :latin1 "Liste des tableaux"
+ :utf-8 "Liste des tableaux"))
+ ("Listing %d:"
+ ("fr"
+ :ascii "Programme %d :"
+ :latin1 "Programme %d :"
+ :utf-8 "Programme nº %d :"))
+ ("Listing %d: %s"
+ ("fr"
+ :ascii "Programme %d : %s"
+ :latin1 "Programme %d : %s"
+ :utf-8 "Programme nº %d : %s"))
+ ("See section %s"
+ ("fr"
+ :ascii "cf. section %s"
+ :latin1 "cf. section %s"
+ :utf-8 "cf. section %s"))
+ ("Table %d:"
+ ("fr"
+ :ascii "Tableau %d :"
+ :latin1 "Tableau %d :"
+ :utf-8 "Tableau nº %d :"))
+ ("Table %d: %s"
+ ("fr"
+ :ascii "Tableau %d : %s"
+ :latin1 "Tableau %d : %s"
+ :utf-8 "Tableau nº %d : %s"))
+ ("Table of Contents"
+ ("fr"
+ :ascii "Sommaire"
+ :latin1 "Table des matières"
+ :utf-8 "Table des matières"))
+ ("Unknown reference"
+ ("fr"
+ :ascii "Destination inconnue"
+ :latin1 "Référence inconnue"
+ :utf-8 "Référence inconnue")))
+ "Dictionary for export engine.
+
+Alist whose CAR is the string to translate and CDR is an alist
+whose CAR is the language string and CDR is a plist whose
+properties are possible charsets and values translated terms.
+
+It is used as a database for `org-export-translate'. Since this
+function returns the string as-is if no translation was found,
+the variable only needs to record values different from the
+entry.")
+
+(defun org-export-translate (s encoding info)
+ "Translate string S according to language specification.
+
+ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1'
+and `:utf-8'. INFO is a plist used as a communication channel.
+
+Translation depends on `:language' property. Return the
+translated string. If no translation is found return S."
+ (let ((lang (plist-get info :language))
+ (translations (cdr (assoc s org-export-dictionary))))
+ (or (plist-get (cdr (assoc lang translations)) encoding) s)))
+
+
+
+;;; The Dispatcher
+;;
+;; `org-export-dispatch' is the standard interactive way to start an
+;; export process. It uses `org-export-dispatch-ui' as a subroutine
+;; for its interface. Most commons back-ends should have an entry in
+;; it.
+
+;;;###autoload
+(defun org-export-dispatch ()
+ "Export dispatcher for Org mode.
+
+It provides an access to common export related tasks in a buffer.
+Its interface comes in two flavours: standard and expert. While
+both share the same set of bindings, only the former displays the
+valid keys associations. Set `org-export-dispatch-use-expert-ui'
+to switch to one or the other.
+
+Return an error if key pressed has no associated command."
+ (interactive)
+ (let* ((input (org-export-dispatch-ui
+ (if (listp org-export-initial-scope) org-export-initial-scope
+ (list org-export-initial-scope))
+ org-export-dispatch-use-expert-ui))
+ (raw-key (car input))
+ (optns (cdr input)))
+ ;; Translate "C-a", "C-b"... into "a", "b"... Then take action
+ ;; depending on user's key pressed.
+ (case (if (< raw-key 27) (+ raw-key 96) raw-key)
+ ;; Allow to quit with "q" key.
+ (?q nil)
+ ;; Export with `e-ascii' back-end.
+ ((?A ?N ?U)
+ (org-e-ascii-export-as-ascii
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)
+ `(:ascii-charset ,(case raw-key (?A 'ascii) (?N 'latin1) (t 'utf-8)))))
+ ((?a ?n ?u)
+ (org-e-ascii-export-to-ascii
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)
+ `(:ascii-charset ,(case raw-key (?a 'ascii) (?n 'latin1) (t 'utf-8)))))
+ ;; Export with `e-latex' back-end.
+ (?L (org-e-latex-export-as-latex
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?l
+ (org-e-latex-export-to-latex
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?p
+ (org-e-latex-export-to-pdf
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?d
+ (org-open-file
+ (org-e-latex-export-to-pdf
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))))
+ ;; Export with `e-html' back-end.
+ (?H
+ (org-e-html-export-as-html
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?h
+ (org-e-html-export-to-html
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?b
+ (org-open-file
+ (org-e-html-export-to-html
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))))
+ ;; Export with `e-odt' back-end.
+ (?o
+ (org-e-odt-export-to-odt
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))
+ (?O
+ (org-open-file
+ (org-e-odt-export-to-odt
+ (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))))
+ ;; Publishing facilities
+ (?F
+ (org-e-publish-current-file (memq 'force optns)))
+ (?P
+ (org-e-publish-current-project (memq 'force optns)))
+ (?X
+ (let ((project
+ (assoc (org-icompleting-read
+ "Publish project: " org-e-publish-project-alist nil t)
+ org-e-publish-project-alist)))
+ (org-e-publish project (memq 'force optns))))
+ (?E
+ (org-e-publish-all (memq 'force optns)))
+ ;; Undefined command.
+ (t (error "No command associated with key %s"
+ (char-to-string raw-key))))))
+
+(defun org-export-dispatch-ui (options expertp)
+ "Handle interface for `org-export-dispatch'.
+
+OPTIONS is a list containing current interactive options set for
+export. It can contain any of the following symbols:
+`body' toggles a body-only export
+`subtree' restricts export to current subtree
+`visible' restricts export to visible part of buffer.
+`force' force publishing files.
+
+EXPERTP, when non-nil, triggers expert UI. In that case, no help
+buffer is provided, but indications about currently active
+options are given in the prompt. Moreover, \[?] allows to switch
+back to standard interface.
+
+Return value is a list with key pressed as CAR and a list of
+final interactive export options as CDR."
+ (let ((help
+ (format "---- (Options) -------------------------------------------
+
+\[1] Body only: %s [2] Export scope: %s
+\[3] Visible only: %s [4] Force publishing: %s
+
+
+--- (ASCII/Latin-1/UTF-8 Export) -------------------------
+
+\[a/n/u] to TXT file [A/N/U] to temporary buffer
+
+--- (HTML Export) ----------------------------------------
+
+\[h] to HTML file [b] ... and open it
+\[H] to temporary buffer
+
+--- (LaTeX Export) ---------------------------------------
+
+\[l] to TEX file [L] to temporary buffer
+\[p] to PDF file [d] ... and open it
+
+--- (ODF Export) -----------------------------------------
+
+\[o] to ODT file [O] ... and open it
+
+--- (Publish) --------------------------------------------
+
+\[F] current file [P] current project
+\[X] a project [E] every project"
+ (if (memq 'body options) "On " "Off")
+ (if (memq 'subtree options) "Subtree" "Buffer ")
+ (if (memq 'visible options) "On " "Off")
+ (if (memq 'force options) "On " "Off")))
+ (standard-prompt "Export command: ")
+ (expert-prompt (format "Export command (%s%s%s%s): "
+ (if (memq 'body options) "b" "-")
+ (if (memq 'subtree options) "s" "-")
+ (if (memq 'visible options) "v" "-")
+ (if (memq 'force options) "f" "-")))
+ (handle-keypress
+ (function
+ ;; Read a character from command input, toggling interactive
+ ;; options when applicable. PROMPT is the displayed prompt,
+ ;; as a string.
+ (lambda (prompt)
+ (let ((key (read-char-exclusive prompt)))
+ (cond
+ ;; Ignore non-standard characters (i.e. "M-a").
+ ((not (characterp key)) (org-export-dispatch-ui options expertp))
+ ;; Help key: Switch back to standard interface if
+ ;; expert UI was active.
+ ((eq key ??) (org-export-dispatch-ui options nil))
+ ;; Toggle export options.
+ ((memq key '(?1 ?2 ?3 ?4))
+ (org-export-dispatch-ui
+ (let ((option (case key (?1 'body) (?2 'subtree) (?3 'visible)
+ (?4 'force))))
+ (if (memq option options) (remq option options)
+ (cons option options)))
+ expertp))
+ ;; Action selected: Send key and options back to
+ ;; `org-export-dispatch'.
+ (t (cons key options))))))))
+ ;; With expert UI, just read key with a fancy prompt. In standard
+ ;; UI, display an intrusive help buffer.
+ (if expertp (funcall handle-keypress expert-prompt)
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Org Export/Publishing Help*" (princ help))
+ (org-fit-window-to-buffer
+ (get-buffer-window "*Org Export/Publishing Help*"))
+ (funcall handle-keypress standard-prompt)))))
+
+
+(provide 'org-export)
+;;; org-export.el ends here
diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el
new file mode 100644
index 0000000..8223712
--- /dev/null
+++ b/contrib/lisp/org-git-link.el
@@ -0,0 +1,220 @@
+;;; org-git-link.el --- Provide org links to specific file version
+
+;; Copyright (C) 2009-2012 Reimar Finken
+
+;; Author: Reimar Finken <reimar.finken@gmx.de>
+;; Keywords: files, calendar, 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 distaributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR 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:
+
+;; `org-git-link.el' defines two new link types. The `git' link
+;; type is meant to be used in the typical scenario and mimics the
+;; `file' link syntax as closely as possible. The `gitbare' link
+;; type exists mostly for debugging reasons, but also allows e.g.
+;; linking to files in a bare git repository for the experts.
+
+;; * User friendy form
+;; [[git:/path/to/file::searchstring]]
+
+;; This form is the familiar from normal org file links
+;; including search options. However, its use is
+;; restricted to files in a working directory and does not
+;; handle bare repositories on purpose (see the bare form for
+;; that).
+
+;; The search string references a commit (a tree-ish in Git
+;; terminology). The two most useful types of search strings are
+
+;; - A symbolic ref name, usually a branch or tag name (e.g.
+;; master or nobelprize).
+;; - A ref followed by the suffix @ with a date specification
+;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2
+;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00})
+;; to specify the value of the ref at a prior point in time
+;;
+;; * Bare git form
+;; [[gitbare:$GIT_DIR::$OBJECT]]
+;;
+;; This is the more bare metal version, which gives the user most
+;; control. It directly translates to the git command
+;; git --no-pager --git-dir=$GIT_DIR show $OBJECT
+;; Using this version one can also view files from a bare git
+;; repository. For detailed information on how to specify an
+;; object, see the man page of `git-rev-parse' (section
+;; SPECIFYING REVISIONS). A specific blob (file) can be
+;; specified by a suffix clolon (:) followed by a path.
+
+;;; Code:
+
+(require 'org)
+(defcustom org-git-program "git"
+ "Name of the git executable used to follow git links."
+ :type '(string)
+ :group 'org)
+
+;; org link functions
+;; bare git link
+(org-add-link-type "gitbare" 'org-gitbare-open)
+
+(defun org-gitbare-open (str)
+ (let* ((strlist (org-git-split-string str))
+ (gitdir (first strlist))
+ (object (second strlist)))
+ (org-git-open-file-internal gitdir object)))
+
+
+(defun org-git-open-file-internal (gitdir object)
+ (let* ((sha (org-git-blob-sha gitdir object))
+ (tmpdir (concat temporary-file-directory "org-git-" sha))
+ (filename (org-git-link-filename object))
+ (tmpfile (expand-file-name filename tmpdir)))
+ (unless (file-readable-p tmpfile)
+ (make-directory tmpdir)
+ (with-temp-file tmpfile
+ (org-git-show gitdir object (current-buffer))))
+ (org-open-file tmpfile)
+ (set-buffer (get-file-buffer tmpfile))
+ (setq buffer-read-only t)))
+
+;; user friendly link
+(org-add-link-type "git" 'org-git-open)
+
+(defun org-git-open (str)
+ (let* ((strlist (org-git-split-string str))
+ (filepath (first strlist))
+ (commit (second strlist))
+ (dirlist (org-git-find-gitdir (file-truename filepath)))
+ (gitdir (first dirlist))
+ (relpath (second dirlist)))
+ (org-git-open-file-internal gitdir (concat commit ":" relpath))))
+
+
+;; Utility functions (file names etc)
+
+(defun org-git-split-dirpath (dirpath)
+ "Given a directory name, return '(dirname basname)"
+ (let ((dirname (file-name-directory (directory-file-name dirpath)))
+ (basename (file-name-nondirectory (directory-file-name dirpath))))
+ (list dirname basename)))
+
+;; finding the git directory
+(defun org-git-find-gitdir (path)
+ "Given a file (not necessarily existing) file path, return the
+ a pair (gitdir relpath), where gitdir is the path to the first
+ .git subdirectory found updstream and relpath is the rest of
+ the path. Example: (org-git-find-gitdir
+ \"~/gitrepos/foo/bar.txt\") returns
+ '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil."
+ (let ((dir (file-name-directory path))
+ (relpath (file-name-nondirectory path)))
+ (catch 'toplevel
+ (while (not (file-exists-p (expand-file-name ".git" dir)))
+ (let ((dirlist (org-git-split-dirpath dir)))
+ (when (string= (second dirlist) "") ; at top level
+ (throw 'toplevel nil))
+ (setq dir (first dirlist)
+ relpath (concat (file-name-as-directory (second dirlist)) relpath))))
+ (list (expand-file-name ".git" dir) relpath))))
+
+
+(if (featurep 'xemacs)
+ (defalias 'org-git-gitrepos-p 'org-git-find-gitdir)
+ (defalias 'org-git-gitrepos-p 'org-git-find-gitdir
+ "Return non-nil if path is in git repository"))
+
+;; splitting the link string
+
+;; Both link open functions are called with a string of
+;; consisting of two parts separated by a double colon (::).
+(defun org-git-split-string (str)
+ "Given a string of the form \"str1::str2\", return a list of
+ two substrings \'(\"str1\" \"str2\"). If the double colon is mising, take str2 to be the empty string."
+ (let ((strlist (split-string str "::")))
+ (cond ((= 1 (length strlist))
+ (list (car strlist) ""))
+ ((= 2 (length strlist))
+ strlist)
+ (t (error "org-git-split-string: only one :: allowed: %s" str)))))
+
+;; finding the file name part of a commit
+(defun org-git-link-filename (str)
+ "Given an object description (see the man page of
+ git-rev-parse), return the nondirectory part of the referenced
+ filename, if it can be extracted. Otherwise, return a valid
+ filename."
+ (let* ((match (and (string-match "[^:]+$" str)
+ (match-string 0 str)))
+ (filename (and match (file-name-nondirectory match)))) ;extract the final part without slash
+ filename))
+
+;; creating a link
+(defun org-git-create-searchstring (branch timestring)
+ (concat branch "@{" timestring "}"))
+
+
+(defun org-git-create-git-link (file)
+ "Create git link part to file at specific time"
+ (interactive "FFile: ")
+ (let* ((gitdir (first (org-git-find-gitdir (file-truename file))))
+ (branchname (org-git-get-current-branch gitdir))
+ (timestring (format-time-string "%Y-%m-%d" (current-time))))
+ (contact "git:" file "::" (org-git-create-searchstring branchname timestring))))
+
+(defun org-git-store-link ()
+ "Store git link to current file."
+ (when (buffer-file-name)
+ (let ((file (abbreviate-file-name (buffer-file-name))))
+ (when (org-git-gitrepos-p file)
+ (org-store-link-props
+ :type "git"
+ :link (org-git-create-git-link file))))))
+
+(add-hook 'org-store-link-functions 'org-git-store-link)
+
+(defun org-git-insert-link-interactively (file searchstring &optional description)
+ (interactive "FFile: \nsSearch string: \nsDescription: ")
+ (insert (org-make-link-string (concat "git:" file "::" searchstring) description)))
+
+;; Calling git
+(defun org-git-show (gitdir object buffer)
+ "Show the output of git --git-dir=gitdir show object in buffer."
+ (unless
+ (zerop (call-process org-git-program nil buffer nil
+ "--no-pager" (concat "--git-dir=" gitdir) "show" object))
+ (error "git error: %s " (save-excursion (set-buffer buffer)
+ (buffer-string)))))
+
+(defun org-git-blob-sha (gitdir object)
+ "Return sha of the referenced object"
+ (with-temp-buffer
+ (if (zerop (call-process org-git-program nil t nil
+ "--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object))
+ (buffer-substring (point-min) (1- (point-max))) ; to strip off final newline
+ (error "git error: %s " (buffer-string)))))
+
+(defun org-git-get-current-branch (gitdir)
+ "Return the name of the current branch."
+ (with-temp-buffer
+ (if (not (zerop (call-process org-git-program nil t nil
+ "--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD")))
+ (error "git error: %s " (buffer-string))
+ (goto-char (point-min))
+ (if (looking-at "^refs/heads/") ; 11 characters
+ (buffer-substring 12 (1- (point-max))))))) ; to strip off final newline
+
+(provide 'org-git-link)
+
+;;; org-git-link.el ends here
diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el
new file mode 100644
index 0000000..ab6669b
--- /dev/null
+++ b/contrib/lisp/org-interactive-query.el
@@ -0,0 +1,312 @@
+;;; org-interactive-query.el --- Interactive modification of agenda query
+;;
+;; Copyright 2007-2012 Free Software Foundation, Inc.
+;;
+;; Author: Christopher League <league at contrapunctus dot net>
+;; Version: 1.0
+;; Keywords: org, wp
+;;
+;; 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, 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 library implements interactive modification of a tags/todo query
+;; in the org-agenda. It adds 4 keys to the agenda
+;;
+;; / add a keyword as a positive selection criterion
+;; \ add a keyword as a newgative selection criterion
+;; = clear a keyword from the selection string
+;; ;
+
+(require 'org)
+
+(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
+(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
+(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
+
+;;; Agenda interactive query manipulation
+
+(defcustom org-agenda-query-selection-single-key t
+ "Non-nil means query manipulation exits after first change.
+When nil, you have to press RET to exit it.
+During query selection, you can toggle this flag with `C-c'.
+This variable can also have the value `expert'. In this case, the window
+displaying the tags menu is not even shown, until you press C-c again."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Expert" expert)))
+
+(defun org-agenda-query-selection (current op table &optional todo-table)
+ "Fast query manipulation with single keys.
+CURRENT is the current query string, OP is the initial
+operator (one of \"+|-=\"), TABLE is an alist of tags and
+corresponding keys, possibly with grouping information.
+TODO-TABLE is a similar table with TODO keywords, should these
+have keys assigned to them. If the keys are nil, a-z are
+automatically assigned. Returns the new query string, or nil to
+not change the current one."
+ (let* ((fulltable (append table todo-table))
+ (maxlen (apply 'max (mapcar
+ (lambda (x)
+ (if (stringp (car x)) (string-width (car x)) 0))
+ fulltable)))
+ (fwidth (+ maxlen 3 1 3))
+ (ncol (/ (- (window-width) 4) fwidth))
+ (expert (eq org-agenda-query-selection-single-key 'expert))
+ (exit-after-next org-agenda-query-selection-single-key)
+ (done-keywords org-done-keywords)
+ tbl char cnt e groups ingroup
+ tg c2 c c1 ntable rtn)
+ (save-window-excursion
+ (if expert
+ (set-buffer (get-buffer-create " *Org tags*"))
+ (delete-other-windows)
+ (split-window-vertically)
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
+ (erase-buffer)
+ (org-set-local 'org-done-keywords done-keywords)
+ (insert "Query: " current "\n")
+ (org-agenda-query-op-line op)
+ (insert "\n\n")
+ (org-fast-tag-show-exit exit-after-next)
+ (setq tbl fulltable char ?a cnt 0)
+ (while (setq e (pop tbl))
+ (cond
+ ((equal e '(:startgroup))
+ (push '() groups) (setq ingroup t)
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "{ "))
+ ((equal e '(:endgroup))
+ (setq ingroup nil cnt 0)
+ (insert "}\n"))
+ (t
+ (setq tg (car e) c2 nil)
+ (if (cdr e)
+ (setq c (cdr e))
+ ;; automatically assign a character.
+ (setq c1 (string-to-char
+ (downcase (substring
+ tg (if (= (string-to-char tg) ?@) 1 0)))))
+ (if (or (rassoc c1 ntable) (rassoc c1 table))
+ (while (or (rassoc char ntable) (rassoc char table))
+ (setq char (1+ char)))
+ (setq c2 c1))
+ (setq c (or c2 char)))
+ (if ingroup (push tg (car groups)))
+ (setq tg (org-add-props tg nil 'face
+ (cond
+ ((not (assoc tg table))
+ (org-get-todo-face tg))
+ (t nil))))
+ (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (insert "[" c "] " tg (make-string
+ (- fwidth 4 (length tg)) ?\ ))
+ (push (cons tg c) ntable)
+ (when (= (setq cnt (1+ cnt)) ncol)
+ (insert "\n")
+ (if ingroup (insert " "))
+ (setq cnt 0)))))
+ (setq ntable (nreverse ntable))
+ (insert "\n")
+ (goto-char (point-min))
+ (if (and (not expert) (fboundp 'fit-window-to-buffer))
+ (fit-window-to-buffer))
+ (setq rtn
+ (catch 'exit
+ (while t
+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
+ (if groups " [!] no groups" " [!]groups")
+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
+ (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
+ (cond
+ ((= c ?\r) (throw 'exit t))
+ ((= c ?!)
+ (setq groups (not groups))
+ (goto-char (point-min))
+ (while (re-search-forward "[{}]" nil t) (replace-match " ")))
+ ((= c ?\C-c)
+ (if (not expert)
+ (org-fast-tag-show-exit
+ (setq exit-after-next (not exit-after-next)))
+ (setq expert nil)
+ (delete-other-windows)
+ (split-window-vertically)
+ (org-switch-to-buffer-other-window " *Org tags*")
+ (and (fboundp 'fit-window-to-buffer)
+ (fit-window-to-buffer))))
+ ((or (= c ?\C-g)
+ (and (= c ?q) (not (rassoc c ntable))))
+ (setq quit-flag t))
+ ((= c ?\ )
+ (setq current "")
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((= c ?\[) ; clear left
+ (org-agenda-query-decompose current)
+ (setq current (concat "/" (match-string 2 current)))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((= c ?\]) ; clear right
+ (org-agenda-query-decompose current)
+ (setq current (match-string 1 current))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((= c ?\t)
+ (condition-case nil
+ (setq current (read-string "Query: " current))
+ (quit))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ;; operators
+ ((or (= c ?/) (= c ?+)) (setq op "+"))
+ ((or (= c ?\;) (= c ?|)) (setq op "|"))
+ ((or (= c ?\\) (= c ?-)) (setq op "-"))
+ ((= c ?=) (setq op "="))
+ ;; todos
+ ((setq e (rassoc c todo-table) tg (car e))
+ (setq current (org-agenda-query-manip
+ current op groups 'todo tg))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ;; tags
+ ((setq e (rassoc c ntable) tg (car e))
+ (setq current (org-agenda-query-manip
+ current op groups 'tag tg))
+ (if exit-after-next (setq exit-after-next 'now))))
+ (if (eq exit-after-next 'now) (throw 'exit t))
+ (goto-char (point-min))
+ (beginning-of-line 1)
+ (delete-region (point) (point-at-eol))
+ (insert "Query: " current)
+ (beginning-of-line 2)
+ (delete-region (point) (point-at-eol))
+ (org-agenda-query-op-line op)
+ (goto-char (point-min)))))
+ (if rtn current nil))))
+
+(defun org-agenda-query-op-line (op)
+ (insert "Operator: "
+ (org-agenda-query-op-entry (equal op "+") "/+" "and")
+ (org-agenda-query-op-entry (equal op "|") ";|" "or")
+ (org-agenda-query-op-entry (equal op "-") "\\-" "not")
+ (org-agenda-query-op-entry (equal op "=") "=" "clear")))
+
+(defun org-agenda-query-op-entry (matchp chars str)
+ (if matchp
+ (org-add-props (format "[%s %s] " chars (upcase str))
+ nil 'face 'org-todo)
+ (format "[%s]%s " chars str)))
+
+(defun org-agenda-query-decompose (current)
+ (string-match "\\([^/]*\\)/?\\(.*\\)" current))
+
+(defun org-agenda-query-clear (current prefix tag)
+ (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
+ (replace-match "" t t current)
+ current))
+
+(defun org-agenda-query-manip (current op groups kind tag)
+ "Apply an operator to a query string and a tag.
+CURRENT is the current query string, OP is the operator, GROUPS is a
+list of lists of tags that are mutually exclusive. KIND is 'tag for a
+regular tag, or 'todo for a TODO keyword, and TAG is the tag or
+keyword string."
+ ;; If this tag is already in query string, remove it.
+ (setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
+ (if (equal op "=") current
+ ;; When using AND, also remove mutually exclusive tags.
+ (if (equal op "+")
+ (loop for g in groups do
+ (if (member tag g)
+ (mapc (lambda (x)
+ (setq current
+ (org-agenda-query-clear current "\\+" x)))
+ g))))
+ ;; Decompose current query into q1 (tags) and q2 (TODOs).
+ (org-agenda-query-decompose current)
+ (let* ((q1 (match-string 1 current))
+ (q2 (match-string 2 current)))
+ (cond
+ ((eq kind 'tag)
+ (concat q1 op tag "/" q2))
+ ;; It's a TODO; when using AND, drop all other TODOs.
+ ((equal op "+")
+ (concat q1 "/+" tag))
+ (t
+ (concat q1 "/" q2 op tag))))))
+
+(defun org-agenda-query-global-todo-keys (&optional files)
+ "Return alist of all TODO keywords and their fast keys, in all FILES."
+ (let (alist)
+ (unless (and files (car files))
+ (setq files (org-agenda-files)))
+ (save-excursion
+ (loop for f in files do
+ (set-buffer (find-file-noselect f))
+ (loop for k in org-todo-key-alist do
+ (setq alist (org-agenda-query-merge-todo-key
+ alist k)))))
+ alist))
+
+(defun org-agenda-query-merge-todo-key (alist entry)
+ (let (e)
+ (cond
+ ;; if this is not a keyword (:startgroup, etc), ignore it
+ ((not (stringp (car entry))))
+ ;; if keyword already exists, replace char if it's null
+ ((setq e (assoc (car entry) alist))
+ (when (null (cdr e)) (setcdr e (cdr entry))))
+ ;; if char already exists, prepend keyword but drop char
+ ((rassoc (cdr entry) alist)
+ (message "TRACE POSITION 2")
+ (setq alist (cons (cons (car entry) nil) alist)))
+ ;; else, prepend COPY of entry
+ (t
+ (setq alist (cons (cons (car entry) (cdr entry)) alist)))))
+ alist)
+
+(defun org-agenda-query-generic-cmd (op)
+ "Activate query manipulation with OP as initial operator."
+ (let ((q (org-agenda-query-selection org-agenda-query-string op
+ org-tag-alist
+ (org-agenda-query-global-todo-keys))))
+ (when q
+ (setq org-agenda-query-string q)
+ (org-agenda-redo))))
+
+(defun org-agenda-query-clear-cmd ()
+ "Activate query manipulation, to clear a tag from the string."
+ (interactive)
+ (org-agenda-query-generic-cmd "="))
+
+(defun org-agenda-query-and-cmd ()
+ "Activate query manipulation, initially using the AND (+) operator."
+ (interactive)
+ (org-agenda-query-generic-cmd "+"))
+
+(defun org-agenda-query-or-cmd ()
+ "Activate query manipulation, initially using the OR (|) operator."
+ (interactive)
+ (org-agenda-query-generic-cmd "|"))
+
+(defun org-agenda-query-not-cmd ()
+ "Activate query manipulation, initially using the NOT (-) operator."
+ (interactive)
+ (org-agenda-query-generic-cmd "-"))
+
+(provide 'org-interactive-query)
diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el
new file mode 100644
index 0000000..c951d4e
--- /dev/null
+++ b/contrib/lisp/org-invoice.el
@@ -0,0 +1,401 @@
+;;; org-invoice.el --- Help manage client invoices in OrgMode
+;;
+;; Copyright (C) 2008-2012 pmade inc. (Peter Jones pjones@pmade.com)
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be
+;; included in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;;
+;; Commentary:
+;;
+;; Building on top of the terrific OrgMode, org-invoice tries to
+;; provide functionality for managing invoices. Currently, it does
+;; this by implementing an OrgMode dynamic block where invoice
+;; information is aggregated so that it can be exported.
+;;
+;; It also provides a library of functions that can be used to collect
+;; this invoice information and use it in other ways, such as
+;; submitting it to on-line invoicing tools.
+;;
+;; I'm already working on an elisp package to submit this invoice data
+;; to the FreshBooks on-line accounting tool.
+;;
+;; Usage:
+;;
+;; In your ~/.emacs:
+;; (autoload 'org-invoice-report "org-invoice")
+;; (autoload 'org-dblock-write:invoice "org-invoice")
+;;
+;; See the documentation in the following functions:
+;;
+;; `org-invoice-report'
+;; `org-dblock-write:invoice'
+;;
+;; Latest version:
+;;
+;; git clone git://pmade.com/elisp
+(eval-when-compile
+ (require 'cl)
+ (require 'org))
+
+(defgroup org-invoice nil
+ "OrgMode Invoice Helper"
+ :tag "Org-Invoice" :group 'org)
+
+(defcustom org-invoice-long-date-format "%A, %B %d, %Y"
+ "The format string for long dates."
+ :type 'string :group 'org-invoice)
+
+(defcustom org-invoice-strip-ts t
+ "Remove org timestamps that appear in headings."
+ :type 'boolean :group 'org-invoice)
+
+(defcustom org-invoice-default-level 2
+ "The heading level at which a new invoice starts. This value
+is used if you don't specify a scope option to the invoice block,
+and when other invoice helpers are trying to find the heading
+that starts an invoice.
+
+The default is 2, assuming that you structure your invoices so
+that they fall under a single heading like below:
+
+* Invoices
+** This is invoice number 1...
+** This is invoice number 2...
+
+If you don't structure your invoices using those conventions,
+change this setting to the number that corresponds to the heading
+at which an invoice begins."
+ :type 'integer :group 'org-invoice)
+
+(defcustom org-invoice-start-hook nil
+ "Hook called when org-invoice is about to collect data from an
+invoice heading. When this hook is called, point will be on the
+heading where the invoice begins.
+
+When called, `org-invoice-current-invoice' will be set to the
+alist that represents the info for this invoice."
+ :type 'hook :group 'org-invoice)
+
+ (defcustom org-invoice-heading-hook nil
+ "Hook called when org-invoice is collecting data from a
+heading. You can use this hook to add additional information to
+the alist that represents the heading.
+
+When this hook is called, point will be on the current heading
+being processed, and `org-invoice-current-item' will contain the
+alist for the current heading.
+
+This hook is called repeatedly for each invoice item processed."
+ :type 'hook :group 'org-invoice)
+
+(defvar org-invoice-current-invoice nil
+ "Information about the current invoice.")
+
+(defvar org-invoice-current-item nil
+ "Information about the current invoice item.")
+
+(defvar org-invoice-table-params nil
+ "The table parameters currently being used.")
+
+(defvar org-invoice-total-time nil
+ "The total invoice time for the summary line.")
+
+(defvar org-invoice-total-price nil
+ "The total invoice price for the summary line.")
+
+(defconst org-invoice-version "1.0.0"
+ "The org-invoice version number.")
+
+(defun org-invoice-goto-tree (&optional tree)
+ "Move point to the heading that represents the head of the
+current invoice. The heading level will be taken from
+`org-invoice-default-level' unless tree is set to a string that
+looks like tree2, where the level is 2."
+ (let ((level org-invoice-default-level))
+ (save-match-data
+ (when (and tree (string-match "^tree\\([0-9]+\\)$" tree))
+ (setq level (string-to-number (match-string 1 tree)))))
+ (org-back-to-heading)
+ (while (and (> (org-reduced-level (org-outline-level)) level)
+ (org-up-heading-safe)))))
+
+(defun org-invoice-heading-info ()
+ "Return invoice information from the current heading."
+ (let ((title (org-no-properties (org-get-heading t)))
+ (date (org-entry-get nil "TIMESTAMP" 'selective))
+ (work (org-entry-get nil "WORK" nil))
+ (rate (or (org-entry-get nil "RATE" t) "0"))
+ (level (org-outline-level))
+ raw-date long-date)
+ (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" 'selective)))
+ (unless date (setq date (org-entry-get nil "TIMESTAMP" t)))
+ (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" t)))
+ (unless work (setq work (org-entry-get nil "CLOCKSUM" nil)))
+ (unless work (setq work "00:00"))
+ (when date
+ (setq raw-date (apply 'encode-time (org-parse-time-string date)))
+ (setq long-date (format-time-string org-invoice-long-date-format raw-date)))
+ (when (and org-invoice-strip-ts (string-match org-ts-regexp-both title))
+ (setq title (replace-match "" nil nil title)))
+ (when (string-match "^[ \t]+" title)
+ (setq title (replace-match "" nil nil title)))
+ (when (string-match "[ \t]+$" title)
+ (setq title (replace-match "" nil nil title)))
+ (setq work (org-hh:mm-string-to-minutes work))
+ (setq rate (string-to-number rate))
+ (setq org-invoice-current-item (list (cons 'title title)
+ (cons 'date date)
+ (cons 'raw-date raw-date)
+ (cons 'long-date long-date)
+ (cons 'work work)
+ (cons 'rate rate)
+ (cons 'level level)
+ (cons 'price (* rate (/ work 60.0)))))
+ (run-hook-with-args 'org-invoice-heading-hook)
+ org-invoice-current-item))
+
+(defun org-invoice-level-min-max (ls)
+ "Return a list where the car is the min level, and the cdr the max."
+ (let ((max 0) min level)
+ (dolist (info ls)
+ (when (cdr (assoc 'date info))
+ (setq level (cdr (assoc 'level info)))
+ (when (or (not min) (< level min)) (setq min level))
+ (when (> level max) (setq max level))))
+ (cons (or min 0) max)))
+
+(defun org-invoice-collapse-list (ls)
+ "Reorganize the given list by dates."
+ (let ((min-max (org-invoice-level-min-max ls)) new)
+ (dolist (info ls)
+ (let* ((date (cdr (assoc 'date info)))
+ (work (cdr (assoc 'work info)))
+ (price (cdr (assoc 'price info)))
+ (long-date (cdr (assoc 'long-date info)))
+ (level (cdr (assoc 'level info)))
+ (bucket (cdr (assoc date new))))
+ (if (and (/= (car min-max) (cdr min-max))
+ (= (car min-max) level)
+ (= work 0) (not bucket) date)
+ (progn
+ (setq info (assq-delete-all 'work info))
+ (push (cons 'total-work 0) info)
+ (push (cons date (list info)) new)
+ (setq bucket (cdr (assoc date new))))
+ (when (and date (not bucket))
+ (setq bucket (list (list (cons 'date date)
+ (cons 'title long-date)
+ (cons 'total-work 0)
+ (cons 'price 0))))
+ (push (cons date bucket) new)
+ (setq bucket (cdr (assoc date new))))
+ (when (and date bucket)
+ (setcdr (assoc 'total-work (car bucket))
+ (+ work (cdr (assoc 'total-work (car bucket)))))
+ (setcdr (assoc 'price (car bucket))
+ (+ price (cdr (assoc 'price (car bucket)))))
+ (nconc bucket (list info))))))
+ (nreverse new)))
+
+(defun org-invoice-info-to-table (info)
+ "Create a single org table row from the given info alist."
+ (let ((title (cdr (assoc 'title info)))
+ (total (cdr (assoc 'total-work info)))
+ (work (cdr (assoc 'work info)))
+ (price (cdr (assoc 'price info)))
+ (with-price (plist-get org-invoice-table-params :price)))
+ (unless total
+ (setq
+ org-invoice-total-time (+ org-invoice-total-time work)
+ org-invoice-total-price (+ org-invoice-total-price price)))
+ (setq total (and total (org-minutes-to-hh:mm-string total)))
+ (setq work (and work (org-minutes-to-hh:mm-string work)))
+ (insert-before-markers
+ (concat "|" title
+ (cond
+ (total (concat "|" total))
+ (work (concat "|" work)))
+ (and with-price price (concat "|" (format "%.2f" price)))
+ "|" "\n"))))
+
+(defun org-invoice-list-to-table (ls)
+ "Convert a list of heading info to an org table"
+ (let ((with-price (plist-get org-invoice-table-params :price))
+ (with-summary (plist-get org-invoice-table-params :summary))
+ (with-header (plist-get org-invoice-table-params :headers))
+ (org-invoice-total-time 0)
+ (org-invoice-total-price 0))
+ (insert-before-markers
+ (concat "| Task / Date | Time" (and with-price "| Price") "|\n"))
+ (dolist (info ls)
+ (insert-before-markers "|-\n")
+ (mapc 'org-invoice-info-to-table (if with-header (cdr info) (cdr (cdr info)))))
+ (when with-summary
+ (insert-before-markers
+ (concat "|-\n|Total:|"
+ (org-minutes-to-hh:mm-string org-invoice-total-time)
+ (and with-price (concat "|" (format "%.2f" org-invoice-total-price)))
+ "|\n")))))
+
+(defun org-invoice-collect-invoice-data ()
+ "Collect all the invoice data from the current OrgMode tree and
+return it. Before you call this function, move point to the
+heading that begins the invoice data, usually using the
+`org-invoice-goto-tree' function."
+ (let ((org-invoice-current-invoice
+ (list (cons 'point (point)) (cons 'buffer (current-buffer))))
+ (org-invoice-current-item nil))
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-clock-sum)
+ (run-hook-with-args 'org-invoice-start-hook)
+ (cons org-invoice-current-invoice
+ (org-invoice-collapse-list
+ (org-map-entries 'org-invoice-heading-info t 'tree 'archive))))))
+
+(defun org-dblock-write:invoice (params)
+ "Function called by OrgMode to write the invoice dblock. To
+create an invoice dblock you can use the `org-invoice-report'
+function.
+
+The following parameters can be given to the invoice block (for
+information about dblock parameters, please see the Org manual):
+
+:scope Allows you to override the `org-invoice-default-level'
+ variable. The only supported values right now are ones
+ that look like :tree1, :tree2, etc.
+
+:prices Set to nil to turn off the price column.
+
+:headers Set to nil to turn off the group headers.
+
+:summary Set to nil to turn off the final summary line."
+ (let ((scope (plist-get params :scope))
+ (org-invoice-table-params params)
+ (zone (move-marker (make-marker) (point)))
+ table)
+ (unless scope (setq scope 'default))
+ (unless (plist-member params :price) (plist-put params :price t))
+ (unless (plist-member params :summary) (plist-put params :summary t))
+ (unless (plist-member params :headers) (plist-put params :headers t))
+ (save-excursion
+ (cond
+ ((eq scope 'tree) (org-invoice-goto-tree "tree1"))
+ ((eq scope 'default) (org-invoice-goto-tree))
+ ((symbolp scope) (org-invoice-goto-tree (symbol-name scope))))
+ (setq table (org-invoice-collect-invoice-data))
+ (goto-char zone)
+ (org-invoice-list-to-table (cdr table))
+ (goto-char zone)
+ (org-table-align)
+ (move-marker zone nil))))
+
+(defun org-invoice-in-report-p ()
+ "Check to see if point is inside an invoice report."
+ (let ((pos (point)) start)
+ (save-excursion
+ (end-of-line 1)
+ (and (re-search-backward "^#\\+BEGIN:[ \t]+invoice" nil t)
+ (setq start (match-beginning 0))
+ (re-search-forward "^#\\+END:.*" nil t)
+ (>= (match-end 0) pos)
+ start))))
+
+(defun org-invoice-report (&optional jump)
+ "Create or update an invoice dblock report. If point is inside
+an existing invoice report, the report is updated. If point
+isn't inside an invoice report, a new report is created.
+
+When called with a prefix argument, move to the first invoice
+report after point and update it.
+
+For information about various settings for the invoice report,
+see the `org-dblock-write:invoice' function documentation.
+
+An invoice report is created by reading a heading tree and
+collecting information from various properties. It is assumed
+that all invoices start at a second level heading, but this can
+be configured using the `org-invoice-default-level' variable.
+
+Here is an example, where all invoices fall under the first-level
+heading Invoices:
+
+* Invoices
+** Client Foo (Jan 01 - Jan 15)
+*** [2008-01-01 Tue] Built New Server for Production
+*** [2008-01-02 Wed] Meeting with Team to Design New System
+** Client Bar (Jan 01 - Jan 15)
+*** [2008-01-01 Tue] Searched for Widgets on Google
+*** [2008-01-02 Wed] Billed You for Taking a Nap
+
+In this layout, invoices begin at level two, and invoice
+items (tasks) are at level three. You'll notice that each level
+three heading starts with an inactive timestamp. The timestamp
+can actually go anywhere you want, either in the heading, or in
+the text under the heading. But you must have a timestamp
+somewhere so that the invoice report can group your items by
+date.
+
+Properties are used to collect various bits of information for
+the invoice. All properties can be set on the invoice item
+headings, or anywhere in the tree. The invoice report will scan
+up the tree looking for each of the properties.
+
+Properties used:
+
+CLOCKSUM: You can use the Org clock-in and clock-out commands to
+ create a CLOCKSUM property. Also see WORK.
+
+WORK: An alternative to the CLOCKSUM property. This property
+ should contain the amount of work that went into this
+ invoice item formatted as HH:MM (e.g. 01:30).
+
+RATE: Used to calculate the total price for an invoice item.
+ Should be the price per hour that you charge (e.g. 45.00).
+ It might make more sense to place this property higher in
+ the hierarchy than on the invoice item headings.
+
+Using this information, a report is generated that details the
+items grouped by days. For each day you will be able to see the
+total number of hours worked, the total price, and the items
+worked on.
+
+You can place the invoice report anywhere in the tree you want.
+I place mine under a third-level heading like so:
+
+* Invoices
+** An Invoice Header
+*** [2008-11-25 Tue] An Invoice Item
+*** Invoice Report
+#+BEGIN: invoice
+#+END:"
+ (interactive "P")
+ (let ((report (org-invoice-in-report-p)))
+ (when (and (not report) jump)
+ (when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
+ (org-show-entry)
+ (beginning-of-line)
+ (setq report (point))))
+ (if report (goto-char report)
+ (org-create-dblock (list :name "invoice")))
+ (org-update-dblock)))
+
+(provide 'org-invoice)
diff --git a/contrib/lisp/org-jira.el b/contrib/lisp/org-jira.el
new file mode 100644
index 0000000..2037029
--- /dev/null
+++ b/contrib/lisp/org-jira.el
@@ -0,0 +1,65 @@
+;;; org-jira.el --- add a jira:ticket protocol to Org
+(defconst org-jira-version "0.1")
+;; Copyright (C) 2008-2012 Jonathan Arkell.
+;; Author: Jonathan Arkell <jonnay@jonnay.net>
+
+;; 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 version 2.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; For a copy of the GNU General Public License, search the Internet,
+;; or write to the Free Software Foundation, Inc., 59 Temple Place,
+;; Suite 330, Boston, MA 02111-1307 USA
+
+;;; Commentary:
+;; This adds a jira protocol to org mode.
+
+;;; Commands:
+;;
+;; Below are complete command list:
+;;
+;;
+;;; Customizable Options:
+;;
+;; Below are customizable option list:
+;;
+
+;; I had initially planned on adding bi-directional linking, so you
+;; could store links from a jira ticket. I also wanted to import
+;; tickets assigned to you as a task. However, I am no longer working
+;; with JIRA, so this is now abandonware.
+
+;;; Installation:
+;; Put org-jira.el somewhere in your load-path.
+;; (Use M-x show-variable RET load-path to see what your load path is.)
+;; Add this to your emacs init file, preferably after you load org mode.
+;(require 'org-jira)
+
+;;; TODO:
+;; - bi-directional links
+;; - deeper importing, like tasks...?
+
+;;; CHANGELOG:
+;; v 0.2 - ran through checkdoc
+;; - Abandoned.
+;; v 0.1 - Initial release
+
+(require 'jira)
+
+(org-add-link-type "jira" 'org-jira-open)
+
+(defun org-jira-open (path)
+ "Open a Jira Link from PATH."
+ (jira-show-issue path))
+
+
+(provide 'org-jira)
+
+;;; org-jira.el ends here
diff --git a/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el
new file mode 100644
index 0000000..0d5752b
--- /dev/null
+++ b/contrib/lisp/org-learn.el
@@ -0,0 +1,177 @@
+;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw at gnu dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.32trans
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; The file implements the learning algorithm described at
+;; http://supermemo.com/english/ol/sm5.htm, which is a system for reading
+;; material according to "spaced repetition". See
+;; http://en.wikipedia.org/wiki/Spaced_repetition for more details.
+;;
+;; To use, turn on state logging and schedule some piece of information you
+;; want to read. Then in the agenda buffer type
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-learn nil
+ "Options concerning the learning code in Org-mode."
+ :tag "Org Learn"
+ :group 'org-progress)
+
+(defcustom org-learn-always-reschedule nil
+ "If non-nil, always reschedule items, even if retention was \"perfect\"."
+ :type 'boolean
+ :group 'org-learn)
+
+(defcustom org-learn-fraction 0.5
+ "Controls the rate at which EF is increased or decreased.
+Must be a number between 0 and 1 (the greater it is the faster
+the changes of the OF matrix)."
+ :type 'float
+ :group 'org-learn)
+
+(defun initial-optimal-factor (n ef)
+ (if (= 1 n)
+ 4
+ ef))
+
+(defun get-optimal-factor (n ef of-matrix)
+ (let ((factors (assoc n of-matrix)))
+ (or (and factors
+ (let ((ef-of (assoc ef (cdr factors))))
+ (and ef-of (cdr ef-of))))
+ (initial-optimal-factor n ef))))
+
+(defun set-optimal-factor (n ef of-matrix of)
+ (let ((factors (assoc n of-matrix)))
+ (if factors
+ (let ((ef-of (assoc ef (cdr factors))))
+ (if ef-of
+ (setcdr ef-of of)
+ (push (cons ef of) (cdr factors))))
+ (push (cons n (list (cons ef of))) of-matrix)))
+ of-matrix)
+
+(defun inter-repetition-interval (n ef &optional of-matrix)
+ (let ((of (get-optimal-factor n ef of-matrix)))
+ (if (= 1 n)
+ of
+ (* of (inter-repetition-interval (1- n) ef of-matrix)))))
+
+(defun modify-e-factor (ef quality)
+ (if (< ef 1.3)
+ 1.3
+ (+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02)))))))
+
+(defun modify-of (of q fraction)
+ (let ((temp (* of (+ 0.72 (* q 0.07)))))
+ (+ (* (- 1 fraction) of) (* fraction temp))))
+
+(defun calculate-new-optimal-factor (interval-used quality used-of
+ old-of fraction)
+ "This implements the SM-5 learning algorithm in Lisp.
+INTERVAL-USED is the last interval used for the item in question.
+QUALITY is the quality of the repetition response.
+USED-OF is the optimal factor used in calculation of the last
+interval used for the item in question.
+OLD-OF is the previous value of the OF entry corresponding to the
+relevant repetition number and the E-Factor of the item.
+FRACTION is a number belonging to the range (0,1) determining the
+rate of modifications (the greater it is the faster the changes
+of the OF matrix).
+
+Returns the newly calculated value of the considered entry of the
+OF matrix."
+ (let (;; the value proposed for the modifier in case of q=5
+ (mod5 (/ (1+ interval-used) interval-used))
+ ;; the value proposed for the modifier in case of q=2
+ (mod2 (/ (1- interval-used) interval-used))
+ ;; the number determining how many times the OF value will
+ ;; increase or decrease
+ modifier)
+ (if (< mod5 1.05)
+ (setq mod5 1.05))
+ (if (< mod2 0.75)
+ (setq mod5 0.75))
+ (if (> quality 4)
+ (setq modifier (1+ (* (- mod5 1) (- quality 4))))
+ (setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality)))))
+ (if (< modifier 0.05)
+ (setq modifier 0.05))
+ (setq new-of (* used-of modifier))
+ (if (> quality 4)
+ (if (< new-of old-of)
+ (setq new-of old-of)))
+ (if (< quality 4)
+ (if (> new-of old-of)
+ (setq new-of old-of)))
+ (setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction))))
+ (if (< new-of 1.2)
+ (setq new-of 1.2)
+ new-of)))
+
+(defvar initial-repetition-state '(-1 1 2.5 nil))
+
+(defun determine-next-interval (n ef quality of-matrix)
+ (assert (> n 0))
+ (assert (and (>= quality 0) (<= quality 5)))
+ (if (< quality 3)
+ (list (inter-repetition-interval n ef) (1+ n) ef nil)
+ (let ((next-ef (modify-e-factor ef quality)))
+ (setq of-matrix
+ (set-optimal-factor n next-ef of-matrix
+ (modify-of (get-optimal-factor n ef of-matrix)
+ quality org-learn-fraction))
+ ef next-ef)
+ ;; For a zero-based quality of 4 or 5, don't repeat
+ (if (and (>= quality 4)
+ (not org-learn-always-reschedule))
+ (list 0 (1+ n) ef of-matrix)
+ (list (inter-repetition-interval n ef of-matrix) (1+ n)
+ ef of-matrix)))))
+
+(defun org-smart-reschedule (quality)
+ (interactive "nHow well did you remember the information (on a scale of 0-5)? ")
+ (let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
+ (learn-data (or (and learn-str
+ (read learn-str))
+ (copy-list initial-repetition-state)))
+ closed-dates)
+ (setq learn-data
+ (determine-next-interval (nth 1 learn-data)
+ (nth 2 learn-data)
+ quality
+ (nth 3 learn-data)))
+ (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
+ (if (= 0 (nth 0 learn-data))
+ (org-schedule t)
+ (org-schedule nil (time-add (current-time)
+ (days-to-time (nth 0 learn-data)))))))
+
+(provide 'org-learn)
+
+;;; org-learn.el ends here
diff --git a/contrib/lisp/org-mac-iCal.el b/contrib/lisp/org-mac-iCal.el
new file mode 100644
index 0000000..0fdc95f
--- /dev/null
+++ b/contrib/lisp/org-mac-iCal.el
@@ -0,0 +1,251 @@
+;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
+
+;; Copyright (C) 2009-2012 Christopher Suckling
+
+;; Author: Christopher Suckling <suckling at gmail dot com>
+
+;; 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.
+
+;; It is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;; Version: 0.1057.104
+;; Keywords: outlines, calendar
+
+;;; Commentary:
+;;
+;; This file provides the import of events from Mac OS X 10.5 iCal.app
+;; into the Emacs diary (it is not compatible with OS X < 10.5). The
+;; function org-mac-iCal will import events in all checked iCal.app
+;; calendars for the date range org-mac-iCal-range months, centered
+;; around the current date.
+;;
+;; CAVEAT: This function is destructive; it will overwrite the current
+;; contents of the Emacs diary.
+;;
+;; Installation: add (require 'org-mac-iCal) to your .emacs.
+;;
+;; If you view Emacs diary entries in org-agenda, the following hook
+;; will ensure that all-day events are not orphaned below TODO items
+;; and that any supplementary fields to events (e.g. Location) are
+;; grouped with their parent event
+;;
+;; (add-hook 'org-agenda-cleanup-fancy-diary-hook
+;; (lambda ()
+;; (goto-char (point-min))
+;; (save-excursion
+;; (while (re-search-forward "^[a-z]" nil t)
+;; (goto-char (match-beginning 0))
+;; (insert "0:00-24:00 ")))
+;; (while (re-search-forward "^ [a-z]" nil t)
+;; (goto-char (match-beginning 0))
+;; (save-excursion
+;; (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t))
+;; (insert (match-string 0)))))
+
+;;; Code:
+
+(defcustom org-mac-iCal-range 2
+ "The range in months to import iCal.app entries into the Emacs
+diary. The import is centered around today's date; thus a value
+of 2 imports entries for one month before and one month after
+today's date"
+ :group 'org-time
+ :type 'integer)
+
+(defun org-mac-iCal ()
+ "Selects checked calendars in iCal.app and imports them into
+the the Emacs diary"
+ (interactive)
+
+ ;; kill diary buffers then empty diary files to avoid duplicates
+ (setq currentBuffer (buffer-name))
+ (setq openBuffers (mapcar (function buffer-name) (buffer-list)))
+ (omi-kill-diary-buffer openBuffers)
+ (with-temp-buffer
+ (insert-file-contents diary-file)
+ (delete-region (point-min) (point-max))
+ (write-region (point-min) (point-max) diary-file))
+
+ ;; determine available calendars
+ (setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$"))
+ (setq caldav-calendars nil)
+ (mapc
+ (lambda (x)
+ (setq caldav-calendars (nconc caldav-calendars (directory-files x 1 ".*calendar$"))))
+ caldav-folders)
+
+ (setq local-calendars nil)
+ (setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$"))
+
+ (setq all-calendars (append caldav-calendars local-calendars))
+
+ ;; parse each calendar's Info.plist to see if calendar is checked in iCal
+ (setq all-calendars (delq 'nil (mapcar
+ (lambda (x)
+ (omi-checked x))
+ all-calendars)))
+
+ ;; for each calendar, concatenate individual events into a single ics file
+ (with-temp-buffer
+ (shell-command "sw_vers" (current-buffer))
+ (when (re-search-backward "10\\.[567]" nil t)
+ (omi-concat-leopard-ics all-calendars)))
+
+ ;; move all caldav ics files to the same place as local ics files
+ (mapc
+ (lambda (x)
+ (mapc
+ (lambda (y)
+ (rename-file (concat x "/" y);
+ (concat "~/Library/Calendars/" y)))
+ (directory-files x nil ".*ics$")))
+ caldav-folders)
+
+ ;; check calendar has contents and import
+ (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$"))
+ (mapc
+ (lambda (x)
+ (when (/= (nth 7 (file-attributes x 'string)) 0)
+ (omi-import-ics x)))
+ import-calendars)
+
+ ;; tidy up intermediate files and buffers
+ (setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list)))
+ (omi-kill-ics-buffer usedCalendarsBuffers)
+ (setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
+ (omi-delete-ics-file usedCalendarsFiles)
+
+ (org-pop-to-buffer-same-window currentBuffer))
+
+(defun omi-concat-leopard-ics (list)
+ "Leopard stores each iCal.app event in a separate ics file.
+Whilst useful for Spotlight indexing, this is less helpful for
+icalendar-import-file. omi-concat-leopard-ics concatenates these
+individual event files into a single ics file"
+ (mapc
+ (lambda (x)
+ (setq omi-leopard-events (directory-files (concat x "/Events") 1 ".*ics$"))
+ (with-temp-buffer
+ (mapc
+ (lambda (y)
+ (insert-file-contents (expand-file-name y)))
+ omi-leopard-events)
+ (write-region (point-min) (point-max) (concat (expand-file-name x) ".ics"))))
+ list))
+
+(defun omi-import-ics (string)
+ "Imports an ics file into the Emacs diary. First tidies up the
+ics file so that it is suitable for import and selects a sensible
+date range so that Emacs calendar view doesn't grind to a halt"
+ (with-temp-buffer
+ (insert-file-contents string)
+ (goto-char (point-min))
+ (while
+ (re-search-forward "^BEGIN:VCALENDAR$" nil t)
+ (setq startEntry (match-beginning 0))
+ (re-search-forward "^END:VCALENDAR$" nil t)
+ (setq endEntry (match-end 0))
+ (save-restriction
+ (narrow-to-region startEntry endEntry)
+ (goto-char (point-min))
+ (re-search-forward "\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t)
+ (if (or (eq (match-string 2) nil) (eq (match-string 3) nil))
+ (progn
+ (setq yearEntry 1)
+ (setq monthEntry 1))
+ (setq yearEntry (string-to-number (match-string 2)))
+ (setq monthEntry (string-to-number (match-string 3))))
+ (setq year (string-to-number (format-time-string "%Y")))
+ (setq month (string-to-number (format-time-string "%m")))
+ (setq now (list month 1 year))
+ (setq entryDate (list monthEntry 1 yearEntry))
+ ;; Check to see if this is a repeating event
+ (goto-char (point-min))
+ (setq isRepeating (re-search-forward "^RRULE:" nil t))
+ ;; Delete if outside range and not repeating
+ (when (and
+ (not isRepeating)
+ (> (abs (- (calendar-absolute-from-gregorian now)
+ (calendar-absolute-from-gregorian entryDate)))
+ (* (/ org-mac-iCal-range 2) 30))
+ (delete-region startEntry endEntry)))
+ (goto-char (point-max))))
+ (while
+ (re-search-forward "^END:VEVENT$" nil t)
+ (delete-blank-lines))
+ (goto-line 1)
+ (insert "BEGIN:VCALENDAR\n\n")
+ (goto-line 2)
+ (while
+ (re-search-forward "^BEGIN:VCALENDAR$" nil t)
+ (replace-match "\n"))
+ (goto-line 2)
+ (while
+ (re-search-forward "^END:VCALENDAR$" nil t)
+ (replace-match "\n"))
+ (insert "END:VCALENDAR")
+ (goto-line 1)
+ (delete-blank-lines)
+ (while
+ (re-search-forward "^END:VEVENT$" nil t)
+ (delete-blank-lines))
+ (goto-line 1)
+ (while
+ (re-search-forward "^ORG.*" nil t)
+ (replace-match "\n"))
+ (goto-line 1)
+ (write-region (point-min) (point-max) string))
+
+ (icalendar-import-file string diary-file))
+
+(defun omi-kill-diary-buffer (list)
+ (mapc
+ (lambda (x)
+ (if (string-match "^diary" x)
+ (kill-buffer x)))
+ list))
+
+(defun omi-kill-ics-buffer (list)
+ (mapc
+ (lambda (x)
+ (if (string-match "ics$" x)
+ (kill-buffer x)))
+ list))
+
+(defun omi-delete-ics-file (list)
+ (mapc
+ (lambda (x)
+ (delete-file x))
+ list))
+
+(defun omi-checked (directory)
+ "Parse Info.plist in iCal.app calendar folder and determine
+whether Checked key is 1. If Checked key is not 1, remove
+calendar from list of calendars for import"
+ (let* ((root (xml-parse-file (car (directory-files directory 1 "Info.plist"))))
+ (plist (car root))
+ (dict (car (xml-get-children plist 'dict)))
+ (keys (cdr (xml-node-children dict)))
+ (keys (mapcar
+ (lambda (x)
+ (cond ((listp x)
+ x)))
+ keys))
+ (keys (delq 'nil keys)))
+ (when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
+ directory)))
+
+(provide 'org-mac-iCal)
+
+;;; org-mac-iCal.el ends here
diff --git a/contrib/lisp/org-mac-link-grabber.el b/contrib/lisp/org-mac-link-grabber.el
new file mode 100644
index 0000000..b422bfb
--- /dev/null
+++ b/contrib/lisp/org-mac-link-grabber.el
@@ -0,0 +1,467 @@
+;;; org-mac-link-grabber.el --- Grab links and url from various mac
+;;; application and insert them as links into org-mode documents
+;;
+;; Copyright (c) 2010-2012 Free Software Foundation, Inc.
+;;
+;; Author: Anthony Lander <anthony.lander@gmail.com>
+;; Version: 1.0.1
+;; Keywords: org, mac, hyperlink
+;;
+;; 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, 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 code allows you to grab either the current selected items, or
+;; the frontmost url in various mac appliations, and insert them as
+;; hyperlinks into the current org-mode document at point.
+;;
+;; This code is heavily based on, and indeed requires,
+;; org-mac-message.el written by John Weigley and Christopher
+;; Suckling.
+;;
+;; Detailed comments for each application interface are inlined with
+;; the code. Here is a brief overview of how the code interacts with
+;; each application:
+;;
+;; Finder.app - grab links to the selected files in the frontmost window
+;; Mail.app - grab links to the selected messages in the message list
+;; AddressBook.app - Grab links to the selected addressbook Cards
+;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Safari.app - Grab the url of the frontmost tab in the frontmost window
+;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
+;; Together.app - Grab links to the selected items in the library list
+;;
+;;
+;; Installation:
+;;
+;; add (require 'org-mac-link-grabber) to your .emacs, and optionally
+;; bind a key to activate the link grabber menu, like this:
+;;
+;; (add-hook 'org-mode-hook (lambda ()
+;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link)))
+;;
+;;
+;; Usage:
+;;
+;; Type C-c g (or whatever key you defined, as above), or type M-x
+;; omlg-grab-link RET to activate the link grabber. This will present
+;; you with a menu to choose an application from which to grab a link
+;; to insert at point. You may also type C-g to abort.
+;;
+;; Customizing:
+;;
+;; You may customize which applications appear in the grab menu by
+;; customizing the group org-mac-link-grabber. Changes take effect
+;; immediately.
+;;
+;;
+;;; Code:
+
+(require 'org)
+(require 'org-mac-message)
+
+(defgroup org-mac-link-grabber nil
+ "Options concerning grabbing links from external Mac
+applications and inserting them in org documents"
+ :tag "Org Mac link grabber"
+ :group 'org-link)
+
+(defcustom org-mac-grab-Finder-app-p t
+ "Enable menu option [F]inder to grab links from the Finder"
+ :tag "Grab Finder.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Mail-app-p t
+ "Enable menu option [m]ail to grab links from Mail.app"
+ :tag "Grab Mail.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Addressbook-app-p t
+ "Enable menu option [a]ddressbook to grab links from AddressBook.app"
+ :tag "Grab AddressBook.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Safari-app-p t
+ "Enable menu option [s]afari to grab links from Safari.app"
+ :tag "Grab Safari.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox-app-p t
+ "Enable menu option [f]irefox to grab links from Firefox.app"
+ :tag "Grab Firefox.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox+Vimperator-p nil
+ "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
+ :tag "Grab Vimperator/Firefox.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Chrome-app-p t
+ "Enable menu option [f]irefox to grab links from Google Chrome.app"
+ :tag "Grab Google Chrome.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+(defcustom org-mac-grab-Together-app-p nil
+ "Enable menu option [t]ogether to grab links from Together.app"
+ :tag "Grab Together.app links"
+ :group 'org-mac-link-grabber
+ :type 'boolean)
+
+
+(defun omlg-grab-link ()
+ "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
+ (interactive)
+ (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
+ ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
+ ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
+ ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
+ ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
+ ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
+ ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
+ ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)))
+ (menu-string (make-string 0 ?x))
+ input)
+
+ ;; Create the menu string for the keymap
+ (mapc '(lambda (descriptor)
+ (when (elt descriptor 3)
+ (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
+ descriptors)
+ (setf (elt menu-string (- (length menu-string) 1)) ?:)
+
+ ;; Prompt the user, and grab the link
+ (message menu-string)
+ (setq input (read-char-exclusive))
+ (mapc '(lambda (descriptor)
+ (let ((key (elt (elt descriptor 0) 0))
+ (active (elt descriptor 3))
+ (grab-function (elt descriptor 2)))
+ (when (and active (eq input key))
+ (call-interactively grab-function))))
+ descriptors)))
+
+(defalias 'omgl-grab-link 'omlg-grab-link
+ "Renamed, and this alias will be obsolete next revision.")
+
+(defun org-mac-paste-applescript-links (as-link-list)
+ "Paste in a list of links from an applescript handler. The
+ links are of the form <link>::split::<name>"
+ (let* ((link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+
+
+;; Handle links from Firefox.app
+;;
+;; This code allows you to grab the current active url from the main
+;; Firefox.app window, and insert it as a link into an org-mode
+;; document. Unfortunately, firefox does not expose an applescript
+;; dictionary, so this is necessarily introduces some limitations.
+;;
+;; The applescript to grab the url from Firefox.app uses the System
+;; Events application to give focus to the firefox application, select
+;; the contents of the url bar, and copy it. It then uses the title of
+;; the window as the text of the link. There is no way to grab links
+;; from other open tabs, and further, if there is more than one window
+;; open, it is not clear which one will be used (though emperically it
+;; seems that it is always the last active window).
+
+(defun as-mac-firefox-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"l\" using command down\n"
+ " keystroke \"c\" using command down\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-firefox-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Firefox url...")
+ (let* ((url-and-title (as-mac-firefox-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-firefox-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-firefox-get-frontmost-url)))
+
+
+;; Handle links from Google Firefox.app running the Vimperator extension
+;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
+;; Firefox
+
+(defun as-mac-vimperator-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"y\"\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
+
+
+(defun org-mac-vimperator-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Vimperator url...")
+ (let* ((url-and-title (as-mac-vimperator-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-vimperator-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-vimperator-get-frontmost-url)))
+
+
+;; Handle links from Google Chrome.app
+;; Grab the frontmost url from Google Chrome. Same limitations are
+;; Firefox because Chrome doesn't publish an Applescript dictionary
+
+(defun as-mac-chrome-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Google Chrome\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"l\" using command down\n"
+ " keystroke \"c\" using command down\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-chrome-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Chrome url...")
+ (let* ((url-and-title (as-mac-chrome-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-chrome-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-chrome-get-frontmost-url)))
+
+
+;; Handle links from Safari.app
+;; Grab the frontmost url from Safari.
+
+(defun as-mac-safari-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "tell application \"Safari\"\n"
+ " set theUrl to URL of document 1\n"
+ " set theName to the name of the document 1\n"
+ " return theUrl & \"::split::\" & theName & \"\n\"\n"
+ "end tell\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-safari-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Safari url...")
+ (let* ((url-and-title (as-mac-safari-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-safari-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-safari-get-frontmost-url)))
+
+
+;;
+;;
+;; Handle links from together.app
+;;
+;;
+
+(org-add-link-type "x-together-item" 'org-mac-together-item-open)
+
+(defun org-mac-together-item-open (uid)
+ "Open the given uid, which is a reference to an item in Together"
+ (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
+
+(defun as-get-selected-together-items ()
+ (do-applescript
+ (concat
+ "tell application \"Together\"\n"
+ " set theLinkList to {}\n"
+ " set theSelection to selected items\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
+ " copy theLink to end of theLinkList\n"
+ " end repeat\n"
+ " return theLinkList as string\n"
+ "end tell")))
+
+(defun org-mac-together-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Togther items...")
+ (org-mac-paste-applescript-links (as-get-selected-together-items)))
+
+(defun org-mac-together-insert-selected ()
+ (interactive)
+ (insert (org-mac-together-get-selected)))
+
+
+;;
+;;
+;; Handle links from Finder.app
+;;
+;;
+
+(defun as-get-selected-finder-items ()
+ (do-applescript
+(concat
+"tell application \"Finder\"\n"
+" set theSelection to the selection\n"
+" set links to {}\n"
+" repeat with theItem in theSelection\n"
+" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
+" copy theLink to the end of links\n"
+" end repeat\n"
+" return links as string\n"
+"end tell\n")))
+
+(defun org-mac-finder-item-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Finder items...")
+ (org-mac-paste-applescript-links (as-get-selected-finder-items)))
+
+(defun org-mac-finder-insert-selected ()
+ (interactive)
+ (insert (org-mac-finder-item-get-selected)))
+
+
+;;
+;;
+;; Handle links from AddressBook.app
+;;
+;;
+
+(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
+
+(defun org-mac-addressbook-item-open (uid)
+ "Open the given uid, which is a reference to an item in Together"
+ (shell-command (concat "open \"addressbook:" uid "\"")))
+
+(defun as-get-selected-addressbook-items ()
+ (do-applescript
+ (concat
+ "tell application \"Address Book\"\n"
+ " set theSelection to the selection\n"
+ " set links to {}\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
+ " copy theLink to the end of links\n"
+ " end repeat\n"
+ " return links as string\n"
+ "end tell\n")))
+
+(defun org-mac-addressbook-item-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Address Book items...")
+ (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
+
+(defun org-mac-addressbook-insert-selected ()
+ (interactive)
+ (insert (org-mac-addressbook-item-get-selected)))
+
+
+(provide 'org-mac-link-grabber)
+
+;;; org-mac-link-grabber.el ends here
diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el
new file mode 100644
index 0000000..367a866
--- /dev/null
+++ b/contrib/lisp/org-mairix.el
@@ -0,0 +1,332 @@
+;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
+;;
+;; Copyright (C) 2007-2012 Georg C. F. Greve
+;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
+;;
+;; Author: Georg C. F. Greve <greve at fsfeurope dot org>
+;; Keywords: outlines, hypermedia, calendar, wp, email, mairix
+;; Purpose: Integrate mairix email searching into Org mode
+;; See http://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/
+;; Version: 0.5
+;;
+;; 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.
+
+;; It is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; USAGE NOTE
+;;
+;; You will need to configure mairix first, which involves setting up your
+;; .mairixrc in your home directory. Once it is working, you should set up
+;; your way to display results in your favorite way -- usually a MUA.
+;; Currently gnus and mutt are supported.
+;;
+;; After both steps are done, all you should need to hook mairix, org
+;; and your MUA together is to do (require 'org-mairix) in your
+;; startup file. Everything can then be configured normally through
+;; Emacs customisation.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'org)
+
+;;; The custom variables
+
+(defgroup org-mairix nil
+ "Mairix support/integration in org."
+ :tag "Org Mairix"
+ :group 'org)
+
+(defcustom org-mairix-threaded-links t
+ "Should new links be created as threaded links?
+If t, links will be stored as threaded searches.
+If nil, links will be stored as non-threaded searches."
+ :group 'org-mairix
+ :type 'boolean)
+
+(defcustom org-mairix-augmented-links nil
+ "Should new links be created as augmenting searches?
+If t, links will be stored as augmenting searches.
+If nil, links will be stored as normal searches.
+
+Attention: When activating this option, you will need
+to remove old articles from your mairix results group
+in some other way, mairix will not do it for you."
+ :group 'org-mairix
+ :type 'boolean)
+
+(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results
+ "Hook to call to display the results of a successful mairix search.
+Defaults to Gnus, feel free to add your own MUAs or methods."
+ :group 'org-mairix
+ :type 'hook)
+
+(defcustom org-mairix-open-command "mairix %args% '%search%'"
+ "The mairix command-line to use. If your paths are set up
+correctly, you should not need to change this.
+
+'%search%' will get substituted with the search expression, and
+'%args%' with any additional arguments."
+ :group 'org-mairix
+ :type 'string)
+
+;;; The hooks to integrate mairix into org
+
+(org-add-link-type "mairix" 'org-mairix-open)
+(add-hook 'org-store-link-functions 'org-mairix-store-gnus-link)
+
+;;; Generic org-mairix functions
+
+(defun org-mairix-construct-link (message-id)
+ "Construct a mairix: hyperlink based on message-id."
+ (concat "mairix:"
+ (if org-mairix-threaded-links "t:")
+ (if org-mairix-augmented-links "a:")
+ "@@"
+ (org-remove-angle-brackets message-id)))
+
+(defun org-store-mairix-link-props (&rest plist)
+ "Take a property list describing a mail, and add mairix link
+and description properties so that org can build a mairix link to
+it."
+ ;; We have to call `org-store-link-props' twice:
+ ;;
+ ;; - It extracts 'fromname'/'fromaddress' from 'from' property,
+ ;; and stores the updated plist to `org-store-link-plist'.
+ ;;
+ ;; - `org-email-link-description' uses these new properties to
+ ;; build a description from the previously stored plist. I
+ ;; wrote a tiny patch to `org-email-link-description' so it
+ ;; could take a non-stored plist as an optional 2nd argument,
+ ;; but the plist provided still needs 'fromname'/'fromaddress'.
+ ;;
+ ;; - Ideally we would decouple the storing bit of
+ ;; `org-store-link-props' from the extraction bit, but lots of
+ ;; stuff in `org-store-link' which calls it would need to be
+ ;; changed. Maybe just factor out the extraction so it can be
+ ;; reused separately?
+ (let ((mid (plist-get plist :message-id)))
+ (apply 'org-store-link-props
+ (append plist
+ (list :type "mairix"
+ :link (org-mairix-construct-link mid))))
+ (apply 'org-store-link-props
+ (append org-store-link-plist
+ (list :description (org-email-link-description))))))
+
+(defun org-mairix-message-send-and-exit-with-link ()
+ "Function that can be assigned as an alternative sending function,
+it sends the message and then stores a mairix link to it before burying
+the buffer just like 'message-send-and-exit' does."
+ (interactive)
+ (message-send)
+ (let* ((message-id (message-fetch-field "Message-Id"))
+ (subject (message-fetch-field "Subject"))
+ (link (org-mairix-construct-link message-id))
+ (desc (concat "Email: '" subject "'")))
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links)))
+ (message-bury (current-buffer)))
+
+(defun org-mairix-open (search)
+ "Function to open mairix link.
+
+We first need to split it into its individual parts, and then
+extract the message-id to be passed on to the display function
+before call mairix, evaluate the number of matches returned, and
+make sure to only call display of mairix succeeded in matching."
+ (let* ((args ""))
+ (if (equal (substring search 0 2) "t:" )
+ (progn (setq search (substring search 2 nil))
+ (setq args (concat args " --threads"))))
+ (if (equal (substring search 0 2) "a:")
+ (progn (setq search (substring search 2 nil))
+ (setq args (concat args " --augment"))))
+ (let ((cmdline (org-mairix-command-substitution
+ org-mairix-open-command search args)))
+ (print cmdline)
+ (setq retval (shell-command-to-string cmdline))
+ (string-match "\[0-9\]+" retval)
+ (setq matches (string-to-number (match-string 0 retval)))
+ (if (eq matches 0) (message "Link failed: no matches, sorry")
+ (message "Link returned %d matches" matches)
+ (run-hook-with-args 'org-mairix-display-hook search args)))))
+
+(defun org-mairix-command-substitution (cmd search args)
+ "Substitute '%search%' and '%args% in mairix search command."
+ (while (string-match "%search%" cmd)
+ (setq cmd (replace-match search 'fixedcase 'literal cmd)))
+ (while (string-match "%args%" cmd)
+ (setq cmd (replace-match args 'fixedcase 'literal cmd)))
+ cmd)
+
+;;; Functions necessary for integration of external MUAs.
+
+;; Of course we cannot call `org-store-link' from within an external
+;; MUA, so we need some other way of storing a link for later
+;; retrieval by org-mode and/or remember-mode. To do this we use a
+;; temporary file as a kind of dedicated clipboard.
+
+(defcustom org-mairix-link-clipboard "~/.org-mairix-link"
+ "Pseudo-clipboard file where mairix URLs get copied to by external
+applications in order to mimic `org-store-link'. Used by
+`org-mairix-insert-link'."
+ :group 'org-mairix
+ :type 'string)
+
+;; When we resolve some of the issues with `org-store-link' detailed
+;; at <http://thread.gmane.org/gmane.emacs.orgmode/4217/focus=4635>,
+;; we might not need org-mairix-insert-link.
+
+(defun org-mairix-insert-link ()
+ "Insert link from file defined by `org-mairix-link-clipboard'."
+ (interactive)
+ (let ((bytes (cadr (insert-file-contents
+ (expand-file-name org-mairix-link-clipboard)))))
+ (forward-char bytes)
+ (save-excursion
+ (forward-char -1)
+ (if (looking-at "\n")
+ (delete-char 1)))))
+
+;;; Functions necessary for mutt integration
+
+(defgroup org-mairix-mutt nil
+ "Use mutt for mairix support in org."
+ :tag "Org Mairix Mutt"
+ :group 'org-mairix)
+
+(defcustom org-mairix-mutt-display-command
+ "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f
+~/mail/mairix -e \"push <display-message>\"' &"
+ "Command to execute to display mairix search results via mutt within
+an xterm.
+
+'%search%' will get substituted with the search expression, and
+'%args%' with any additional arguments used in the search."
+ :group 'org-mairix-mutt
+ :type 'string)
+
+(defun org-mairix-mutt-display-results (search args)
+ "Display results of mairix search in mutt, using the command line
+defined in `org-mairix-mutt-display-command'."
+ ;; By default, async `shell-command' invocations display the temp
+ ;; buffer, which is annoying here. We choose a deterministic
+ ;; buffer name so we can hide it again immediately.
+ ;; Note: `call-process' is synchronous so not useful here.
+ (let ((cmd (org-mairix-command-substitution
+ org-mairix-mutt-display-command search args))
+ (tmpbufname (generate-new-buffer-name " *mairix-view*")))
+ (shell-command cmd tmpbufname)
+ (delete-windows-on (get-buffer tmpbufname))))
+
+;;; Functions necessary for gnus integration
+
+(defgroup org-mairix-gnus nil
+ "Use gnus for mairix support in org."
+ :tag "Org Mairix Gnus"
+ :group 'org-mairix)
+
+(defcustom org-mairix-gnus-results-group "nnmaildir:mairix"
+ "The group that is configured to hold the mairix search results,
+which needs to be setup independently of the org-mairix integration,
+along with general mairix configuration."
+ :group 'org-mairix-gnus
+ :type 'string)
+
+(defcustom org-mairix-gnus-select-display-group-function
+'org-mairix-gnus-select-display-group-function-gg
+ "Hook to call to select the group that contains the matching articles.
+We should not need this, it is owed to a problem of gnus that people were
+not yet able to figure out, see
+ http://article.gmane.org/gmane.emacs.gnus.general/65248
+ http://article.gmane.org/gmane.emacs.gnus.general/65265
+ http://article.gmane.org/gmane.emacs.gnus.user/9596
+for reference.
+
+It seems gnus needs a 'forget/ignore everything you think you
+know about that group' function. Volunteers?"
+ :group 'org-mairix-gnus
+ :type 'hook)
+
+(defun org-mairix-store-gnus-link ()
+ "Store a link to the current gnus message as a Mairix search for its
+Message ID."
+
+ ;; gnus integration
+ (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
+ (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
+ (let* ((article (gnus-summary-article-number))
+ (header (gnus-summary-article-header article))
+ (from (mail-header-from header))
+ (message-id (mail-header-id header))
+ (subject (gnus-summary-subject-string)))
+ (org-store-mairix-link-props :from from
+ :subject subject
+ :message-id message-id))))
+
+(defun org-mairix-gnus-display-results (search args)
+ "Display results of mairix search in Gnus.
+
+Note: This does not work as cleanly as I would like it to. The
+problem being that Gnus should simply reread the group cleanly,
+without remembering anything. At the moment it seems to be unable
+to do that -- so you're likely to see zombies floating around.
+
+If you can improve this, please do!"
+ (if (not (equal (substring search 0 2) "m:" ))
+ (error "org-mairix-gnus-display-results: display of search other than
+message-id not implemented yet"))
+ (setq message-id (substring search 2 nil))
+ (require 'gnus)
+ (require 'gnus-sum)
+ ;; FIXME: (bzg/gg) We might need to make sure gnus is running here,
+ ;; and to start it in case it isn't running already. Does
+ ;; anyone know a function to do that? It seems main org mode
+ ;; does not do this, either.
+ (funcall (cdr (assq 'gnus org-link-frame-setup)))
+ (if gnus-other-frame-object (select-frame gnus-other-frame-object))
+
+ ;; FIXME: This is horribly broken. Please see
+ ;; http://article.gmane.org/gmane.emacs.gnus.general/65248
+ ;; http://article.gmane.org/gmane.emacs.gnus.general/65265
+ ;; http://article.gmane.org/gmane.emacs.gnus.user/9596
+ ;; for reference.
+ ;;
+ ;; It seems gnus needs a "forget/ignore everything you think you
+ ;; know about that group" function. Volunteers?
+ ;;
+ ;; For now different methods seem to work differently well for
+ ;; different people. So we're playing hook-selection here to make
+ ;; it easy to play around until we found a proper solution.
+ (run-hook-with-args 'org-mairix-gnus-select-display-group-function)
+ (gnus-summary-select-article
+ nil t t (car (gnus-find-matching-articles "message-id" message-id))))
+
+(defun org-mairix-gnus-select-display-group-function-gg ()
+ "Georg's hack to select a group that gnus (falsely) believes to be
+empty to then call rebuilding of the summary. It leaves zombies of
+old searches around, though."
+ (gnus-group-quick-select-group 0 org-mairix-gnus-results-group)
+ (gnus-group-clear-data)
+ (gnus-summary-reselect-current-group t t))
+
+(defun org-mairix-gnus-select-display-group-function-bzg ()
+ "This is the classic way the org mode is using, and it seems to be
+using better for Bastien, so it may work for you."
+ (gnus-group-clear-data org-mairix-gnus-results-group)
+ (gnus-group-read-group t nil org-mairix-gnus-results-group))
+
+(provide 'org-mairix)
+
+;;; org-mairix.el ends here
diff --git a/contrib/lisp/org-man.el b/contrib/lisp/org-man.el
new file mode 100644
index 0000000..27e8cca
--- /dev/null
+++ b/contrib/lisp/org-man.el
@@ -0,0 +1,64 @@
+;;; org-man.el - Support for links to manpages in Org-mode
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 1.0
+;;
+;; This file is not yet 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'org)
+
+(org-add-link-type "man" 'org-man-open)
+(add-hook 'org-store-link-functions 'org-man-store-link)
+
+(defcustom org-man-command 'man
+ "The Emacs command to be used to display a man page."
+ :group 'org-link
+ :type '(choice (const man) (const woman)))
+
+(defun org-man-open (path)
+ "Visit the manpage on PATH.
+PATH should be a topic that can be thrown at the man command."
+ (funcall org-man-command path))
+
+(defun org-man-store-link ()
+ "Store a link to a README file."
+ (when (memq major-mode '(Man-mode woman-mode))
+ ;; This is a man page, we do make this link
+ (let* ((page (org-man-get-page-name))
+ (link (concat "man:" page))
+ (description (format "Manpage for %s" page)))
+ (org-store-link-props
+ :type "man"
+ :link link
+ :description description))))
+
+(defun org-man-get-page-name ()
+ "Extract the page name from the buffer name."
+ ;; This works for both `Man-mode' and `woman-mode'.
+ (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
+ (match-string 1 (buffer-name))
+ (error "Cannot create link to this man page")))
+
+(provide 'org-man)
+
+;;; org-man.el ends here
diff --git a/contrib/lisp/org-md.el b/contrib/lisp/org-md.el
new file mode 100644
index 0000000..4579ca3
--- /dev/null
+++ b/contrib/lisp/org-md.el
@@ -0,0 +1,461 @@
+;;; org-md.el --- Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Keywords: org, wp, tex
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a Markdown back-end (vanilla flavour) for
+;; Org exporter, based on `e-html'.
+;;
+;; It provides two commands for export, depending on the desired
+;; output: `org-md-export-as-markdown' (temporary buffer) and
+;; `org-md-export-to-markdown' ("md" file).
+
+;;; Code:
+
+(require 'org-e-html)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-md nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Markdown"
+ :group 'org-export
+ :version "24.2")
+
+(defcustom org-md-headline-style 'atx
+ "Style used to format headlines.
+This variable can be set to either `atx' or `setext'."
+ :group 'org-export-md
+ :type '(choice
+ (const :tag "Use \"atx\" style" atx)
+ (const :tag "Use \"Setext\" style" setext)))
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend md e-html
+ :export-block ("MD" "MARKDOWN")
+ :filters-alist ((:filter-parse-tree . org-md-separate-elements))
+ :translate-alist ((bold . org-md-bold)
+ (code . org-md-verbatim)
+ (example-block . org-md-example-block)
+ (footnote-definition . ignore)
+ (footnote-reference . ignore)
+ (headline . org-md-headline)
+ (horizontal-rule . org-md-horizontal-rule)
+ (inline-src-block . org-md-verbatim)
+ (italic . org-md-italic)
+ (item . org-md-item)
+ (line-break . org-md-line-break)
+ (link . org-md-link)
+ (paragraph . org-md-paragraph)
+ (plain-list . org-md-plain-list)
+ (plain-text . org-md-plain-text)
+ (quote-block . org-md-quote-block)
+ (quote-section . org-md-example-block)
+ (section . org-md-section)
+ (src-block . org-md-example-block)
+ (template . org-md-template)
+ (verbatim . org-md-verbatim)))
+
+
+
+;;; Filters
+
+(defun org-md-separate-elements (tree backend info)
+ "Make sure elements are separated by at least one blank line.
+
+TREE is the parse tree being exported. BACKEND is the export
+back-end used. INFO is a plist used as a communication channel.
+
+Assume BACKEND is `md'."
+ (org-element-map
+ tree org-element-all-elements
+ (lambda (elem)
+ (unless (eq (org-element-type elem) 'org-data)
+ (org-element-put-property
+ elem :post-blank
+ (let ((post-blank (org-element-property :post-blank elem)))
+ (if (not post-blank) 1 (max 1 post-blank)))))))
+ ;; Return updated tree.
+ tree)
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-md-bold (bold contents info)
+ "Transcode BOLD object into Markdown format.
+CONTENTS is the text within bold markup. INFO is a plist used as
+a communication channel."
+ (format "**%s**" contents))
+
+
+;;;; Code and Verbatim
+
+(defun org-md-verbatim (verbatim contents info)
+ "Transcode VERBATIM object into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((value (org-element-property :value verbatim)))
+ (format (cond ((not (string-match "`" value)) "`%s`")
+ ((or (string-match "\\``" value)
+ (string-match "`\\'" value))
+ "`` %s ``")
+ (t "``%s``"))
+ value)))
+
+
+;;;; Example Block and Src Block
+
+(defun org-md-example-block (example-block contents info)
+ "Transcode EXAMPLE-BLOCK element into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (replace-regexp-in-string
+ "^" " "
+ (org-remove-indentation
+ (org-element-property :value example-block))))
+
+
+;;;; Headline
+
+(defun org-md-headline (headline contents info)
+ "Transcode HEADLINE element into Markdown format.
+CONTENTS is the headline contents. INFO is a plist used as
+a communication channel."
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (title (org-export-data (org-element-property :title headline) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword
+ headline)))
+ (and todo (concat (org-export-data todo info) " ")))))
+ (tags (and (plist-get info :with-tags)
+ (let ((tag-list (org-export-get-tags headline info)))
+ (and tag-list
+ (format " :%s:"
+ (mapconcat 'identity tag-list ":"))))))
+ (priority
+ (and (plist-get info :with-priority)
+ (let ((char (org-element-property :priority headline)))
+ (and char (format "[#%c] " char)))))
+ ;; Headline text without tags.
+ (heading (concat todo priority title)))
+ (cond
+ ;; Cannot create an headline. Fall-back to a list.
+ ((or (org-export-low-level-p headline info)
+ (not (memq org-md-headline-style '(atx setext)))
+ (and (eq org-md-headline-style 'atx) (> level 6))
+ (and (eq org-md-headline-style 'setext) (> level 2)))
+ (let ((bullet
+ (if (not (org-export-numbered-headline-p headline info)) "-"
+ (concat (number-to-string
+ (car (last (org-export-get-headline-number
+ headline info))))
+ "."))))
+ (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags
+ "\n\n"
+ (and contents
+ (replace-regexp-in-string "^" " " contents)))))
+ ;; Use "Setext" style.
+ ((eq org-md-headline-style 'setext)
+ (concat heading tags "\n"
+ (make-string (length heading) (if (= level 1) ?= ?-))
+ "\n\n"
+ contents))
+ ;; Use "atx" style.
+ (t (concat (make-string level ?#) " " heading tags "\n\n" contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-md-horizontal-rule (horizontal-rule contents info)
+ "Transcode HORIZONTAL-RULE element into Markdown format.
+CONTENTS is the horizontal rule contents. INFO is a plist used
+as a communication channel."
+ "---")
+
+
+;;;; Italic
+
+(defun org-md-italic (italic contents info)
+ "Transcode ITALIC object into Markdown format.
+CONTENTS is the text within italic markup. INFO is a plist used
+as a communication channel."
+ (format "*%s*" contents))
+
+
+;;;; Item
+
+(defun org-md-item (item contents info)
+ "Transcode ITEM element into Markdown format.
+CONTENTS is the item contents. INFO is a plist used as
+a communication channel."
+ (let* ((type (org-element-property :type (org-export-get-parent item)))
+ (struct (org-element-property :structure item))
+ (bullet (if (not (eq type 'ordered)) "-"
+ (concat (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))
+ "."))))
+ (concat bullet
+ (make-string (- 4 (length bullet)) ? )
+ (case (org-element-property :checkbox item)
+ (on "[X] ")
+ (trans "[-] ")
+ (off "[ ] "))
+ (let ((tag (org-element-property :tag item)))
+ (and tag (format "**%s:** "(org-export-data tag info))))
+ (org-trim (replace-regexp-in-string "^" " " contents)))))
+
+
+;;;; Line Break
+
+(defun org-md-line-break (line-break contents info)
+ "Transcode LINE-BREAK object into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ " ")
+
+
+;;;; Link
+
+(defun org-md-link (link contents info)
+ "Transcode LINE-BREAK object into Markdown format.
+CONTENTS is the link's description. INFO is a plist used as
+a communication channel."
+ (let ((--link-org-files-as-html-maybe
+ (function
+ (lambda (raw-path info)
+ ;; Treat links to `file.org' as links to `file.html', if
+ ;; needed. See `org-e-html-link-org-files-as-html'.
+ (cond
+ ((and org-e-html-link-org-files-as-html
+ (string= ".org"
+ (downcase (file-name-extension raw-path "."))))
+ (concat (file-name-sans-extension raw-path) "."
+ (plist-get info :html-extension)))
+ (t raw-path)))))
+ (type (org-element-property :type link)))
+ (cond ((member type '("custom-id" "id"))
+ (let ((destination (org-export-resolve-id-link link info)))
+ (if (stringp destination) ; External file.
+ (let ((path (funcall --link-org-files-as-html-maybe
+ destination info)))
+ (if (not contents) (format "<%s>" path)
+ (format "[%s](%s)" contents path)))
+ (concat
+ (and contents (concat contents " "))
+ (format "(%s)"
+ (format (org-export-translate "See section %s" :html info)
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info)
+ ".")))))))
+ ((org-export-inline-image-p link org-e-html-inline-image-rules)
+ (format "![%s](%s)"
+ (let ((caption
+ (org-element-property
+ :caption (org-export-get-parent-element link))))
+ (when caption (org-export-data (car caption) info)))
+ path))
+ ((string= type "coderef")
+ (let ((ref (org-element-property :path link)))
+ (format (org-export-get-coderef-format ref contents)
+ (org-export-resolve-coderef ref info))))
+ ((equal type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (org-export-data (org-element-contents destination) info)))
+ ((equal type "fuzzy")
+ (let ((destination (org-export-resolve-fuzzy-link link info)))
+ ;; Ignore invisible "#+TARGET: path".
+ (unless (eq (org-element-type destination) 'keyword)
+ (if (org-string-nw-p contents) contents
+ (when destination
+ (let ((number (org-export-get-ordinal destination info)))
+ (when number
+ (if (atom number) (number-to-string number)
+ (mapconcat 'number-to-string number ".")))))))))
+ (t (let* ((raw-path (org-element-property :path link))
+ (path (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((equal type "file")
+ ;; Extract just the file path and strip
+ ;; all other components.
+ (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ ;; Treat links to ".org" files as ".html",
+ ;; if needed.
+ (setq raw-path
+ (funcall --link-org-files-as-html-maybe
+ raw-path info))
+ ;; If file path is absolute, prepend it
+ ;; with protocol component - "file://".
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (concat "file://" (expand-file-name raw-path))))
+ (t raw-path))))
+ (if (not contents) (format "<%s>" path)
+ (format "[%s](%s)" contents path)))))))
+
+
+;;;; Paragraph
+
+(defun org-md-paragraph (paragraph contents info)
+ "Transcode PARAGRAPH element into Markdown format.
+CONTENTS is the paragraph contents. INFO is a plist used as
+a communication channel."
+ (let ((first-object (car (org-element-contents paragraph))))
+ ;; If paragraph starts with a #, protect it.
+ (if (and (stringp first-object) (string-match "\\`#" first-object))
+ (replace-regexp-in-string "\\`#" "\\#" contents nil t)
+ contents)))
+
+
+;;;; Plain List
+
+(defun org-md-plain-list (plain-list contents info)
+ "Transcode PLAIN-LIST element into Markdown format.
+CONTENTS is the plain-list contents. INFO is a plist used as
+a communication channel."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-md-plain-text (text info)
+ "Transcode a TEXT string into Markdown format.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; Protect ambiguous #. This will protect # at the beginning of
+ ;; a line, but not at the beginning of a paragraph. See
+ ;; `org-md-paragraph'.
+ (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text))
+ ;; Protect ambiguous !
+ (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1))
+ ;; Protect `, *, _ and \
+ (setq text
+ (replace-regexp-in-string
+ "[`*_\\]" (lambda (rep) (concat "\\\\" (match-string 1 rep))) text))
+ ;; Handle special strings, if required.
+ (when (plist-get info :with-special-strings)
+ (setq text (org-e-html-convert-special-strings text)))
+ ;; Handle break preservation, if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text)))
+ ;; Return value.
+ text)
+
+
+;;;; Quote Block
+
+(defun org-md-quote-block (quote-block contents info)
+ "Transcode QUOTE-BLOCK element into Markdown format.
+CONTENTS is the quote-block contents. INFO is a plist used as
+a communication channel."
+ (replace-regexp-in-string
+ "^" "> "
+ (replace-regexp-in-string "\n\\'" "" contents)))
+
+
+;;;; Section
+
+(defun org-md-section (section contents info)
+ "Transcode SECTION element into Markdown format.
+CONTENTS is the section contents. INFO is a plist used as
+a communication channel."
+ contents)
+
+
+;;;; Template
+
+(defun org-md-template (contents info)
+ "Return complete document string after Markdown conversion.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ contents)
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-md-export-as-markdown (&optional subtreep visible-only)
+ "Export current buffer to a text buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org MD Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (let ((outbuf (org-export-to-buffer
+ 'md "*Org MD Export*" subtreep visible-only)))
+ (with-current-buffer outbuf (text-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf))))
+
+
+;;;###autoload
+(defun org-md-export-to-markdown (&optional subtreep visible-only pub-dir)
+ "Export current buffer to a Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep pub-dir)))
+ (org-export-to-file 'md outfile subtreep visible-only)))
+
+
+(provide 'org-md)
+;;; org-md.el ends here
diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
new file mode 100644
index 0000000..fc333be
--- /dev/null
+++ b/contrib/lisp/org-mime.el
@@ -0,0 +1,336 @@
+;;; org-mime.el --- org html export for text/html MIME emails
+
+;; Copyright (C) 2010-2012 Eric Schulte
+
+;; Author: Eric Schulte
+;; Keywords: mime, mail, email, html
+;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php
+;; Version: 0.01
+
+;; This file is not part of GNU Emacs.
+
+;;; License:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; WYSWYG, html mime composition using org-mode
+;;
+;; For mail composed using the orgstruct-mode minor mode, this
+;; provides a function for converting all or part of your mail buffer
+;; to embedded html as exported by org-mode. Call `org-mime-htmlize'
+;; in a message buffer to convert either the active region or the
+;; entire buffer to html.
+;;
+;; Similarly the `org-mime-org-buffer-htmlize' function can be called
+;; from within an org-mode buffer to convert the buffer to html, and
+;; package the results into an email handling with appropriate MIME
+;; encoding.
+;;
+;; you might want to bind this to a key with something like the
+;; following message-mode binding
+;;
+;; (add-hook 'message-mode-hook
+;; (lambda ()
+;; (local-set-key "\C-c\M-o" 'org-mime-htmlize)))
+;;
+;; and the following org-mode binding
+;;
+;; (add-hook 'org-mode-hook
+;; (lambda ()
+;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize)))
+
+;;; Code:
+(require 'cl)
+
+(defcustom org-mime-use-property-inheritance nil
+ "Non-nil means al MAIL_ properties apply also for sublevels."
+ :group 'org-mime
+ :type 'boolean)
+
+(defcustom org-mime-default-header
+ "#+OPTIONS: latex:t\n"
+ "Default header to control html export options, and ensure
+ first line isn't assumed to be a title line."
+ :group 'org-mime
+ :type 'string)
+
+(defcustom org-mime-library 'mml
+ "Library to use for marking up MIME elements."
+ :group 'org-mime
+ :type '(choice 'mml 'semi 'vm))
+
+(defcustom org-mime-preserve-breaks t
+ "Used as temporary value of `org-export-preserve-breaks' during
+ mime encoding."
+ :group 'org-mime
+ :type 'boolean)
+
+(defcustom org-mime-fixedwith-wrap
+ "<pre style=\"font-family: courier, monospace;\">\n%s</pre>\n"
+ "Format string used to wrap a fixedwidth HTML email."
+ :group 'org-mime
+ :type 'string)
+
+(defcustom org-mime-html-hook nil
+ "Hook to run over the html buffer before attachment to email.
+ This could be used for example to post-process html elements."
+ :group 'org-mime
+ :type 'hook)
+
+(mapc (lambda (fmt)
+ (eval `(defcustom
+ ,(intern (concat "org-mime-pre-" fmt "-hook"))
+ nil
+ (concat "Hook to run before " fmt " export.\nFunctions "
+ "should take no arguments and will be run in a "
+ "buffer holding\nthe text to be exported."))))
+ '("ascii" "org" "html"))
+
+(defcustom org-mime-send-subtree-hook nil
+ "Hook to run in the subtree in the Org-mode file before export.")
+
+(defcustom org-mime-send-buffer-hook nil
+ "Hook to run in the Org-mode file before export.")
+
+;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements
+(defun org-mime-change-element-style (element style)
+ "Set new default htlm style for <ELEMENT> elements in exported html."
+ (while (re-search-forward (format "<%s" element) nil t)
+ (replace-match (format "<%s style=\"%s\"" element style))))
+
+(defun org-mime-change-class-style (class style)
+ "Set new default htlm style for objects with classs=CLASS in
+exported html."
+ (while (re-search-forward (format "class=\"%s\"" class) nil t)
+ (replace-match (format "class=\"%s\" style=\"%s\"" class style))))
+
+;; ;; example addition to `org-mime-html-hook' adding a dark background
+;; ;; color to <pre> elements
+;; (add-hook 'org-mime-html-hook
+;; (lambda ()
+;; (org-mime-change-element-style
+;; "pre" (format "color: %s; background-color: %s;"
+;; "#E6E1DC" "#232323"))
+;; (org-mime-change-class-style
+;; "verse" "border-left: 2px solid gray; padding-left: 4px;")))
+
+(defun org-mime-file (ext path id)
+ "Markup a file for attachment."
+ (case org-mime-library
+ ('mml (format (concat "<#part type=\"%s\" filename=\"%s\" "
+ "disposition=inline id=\"<%s>\">\n<#/part>\n")
+ ext path id))
+ ('semi (concat
+ (format (concat "--[[%s\nContent-Disposition: "
+ "inline;\nContent-ID: <%s>][base64]]\n")
+ ext id)
+ (base64-encode-string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (binary-insert-encoded-file path)
+ (buffer-string)))))
+ ('vm "?")))
+
+(defun org-mime-multipart (plain html &optional images)
+ "Markup a multipart/alternative with text/plain and text/html alternatives.
+If the html portion of the message includes images wrap the html
+and images in a multipart/related part."
+ (case org-mime-library
+ ('mml (concat "<#multipart type=alternative><#part type=text/plain>"
+ plain
+ (when images "<#multipart type=related>")
+ "<#part type=text/html>"
+ html
+ images
+ (when images "<#/multipart>\n")
+ "<#/multipart>\n"))
+ ('semi (concat
+ "--" "<<alternative>>-{\n"
+ "--" "[[text/plain]]\n" plain
+ (when images (concat "--" "<<alternative>>-{\n"))
+ "--" "[[text/html]]\n" html
+ images
+ (when images (concat "--" "}-<<alternative>>\n"))
+ "--" "}-<<alternative>>\n"))
+ ('vm "?")))
+
+(defun org-mime-replace-images (str current-file)
+ "Replace images in html files with cid links."
+ (let (html-images)
+ (cons
+ (replace-regexp-in-string ;; replace images in html
+ "src=\"\\([^\"]+\\)\""
+ (lambda (text)
+ (format
+ "src=\"cid:%s\""
+ (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text)
+ (match-string 1 text)))
+ (path (expand-file-name
+ url (file-name-directory current-file)))
+ (ext (file-name-extension path))
+ (id (replace-regexp-in-string "[\/\\\\]" "_" path)))
+ (add-to-list 'html-images
+ (org-mime-file (concat "image/" ext) path id))
+ id)))
+ str)
+ html-images)))
+
+(defun org-mime-htmlize (arg)
+ "Export a portion of an email body composed using `mml-mode' to
+html using `org-mode'. If called with an active region only
+export that region, otherwise export the entire body."
+ (interactive "P")
+ (let* ((region-p (org-region-active-p))
+ (html-start (or (and region-p (region-beginning))
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward mail-header-separator)
+ (+ (point) 1))))
+ (html-end (or (and region-p (region-end))
+ ;; TODO: should catch signature...
+ (point-max)))
+ (raw-body (buffer-substring html-start html-end))
+ (tmp-file (make-temp-name (expand-file-name
+ "mail" temporary-file-directory)))
+ (body (org-export-string raw-body 'org (file-name-directory tmp-file)))
+ ;; because we probably don't want to skip part of our mail
+ (org-export-skip-text-before-1st-heading nil)
+ ;; because we probably don't want to export a huge style file
+ (org-export-htmlize-output-type 'inline-css)
+ ;; makes the replies with ">"s look nicer
+ (org-export-preserve-breaks org-mime-preserve-breaks)
+ ;; dvipng for inline latex because MathJax doesn't work in mail
+ (org-export-with-LaTeX-fragments 'dvipng)
+ ;; to hold attachments for inline html images
+ (html-and-images
+ (org-mime-replace-images
+ (org-export-string raw-body 'html (file-name-directory tmp-file))
+ tmp-file))
+ (html-images (unless arg (cdr html-and-images)))
+ (html (org-mime-apply-html-hook
+ (if arg
+ (format org-mime-fixedwith-wrap body)
+ (car html-and-images)))))
+ (delete-region html-start html-end)
+ (save-excursion
+ (goto-char html-start)
+ (insert (org-mime-multipart
+ body html (mapconcat 'identity html-images "\n"))))))
+
+(defun org-mime-apply-html-hook (html)
+ (if org-mime-html-hook
+ (with-temp-buffer
+ (insert html)
+ (goto-char (point-min))
+ (run-hooks 'org-mime-html-hook)
+ (buffer-string))
+ html))
+
+(defmacro org-mime-try (&rest body)
+ `(condition-case nil ,@body (error nil)))
+
+(defun org-mime-send-subtree (&optional fmt)
+ (save-restriction
+ (org-narrow-to-subtree)
+ (run-hooks 'org-mime-send-subtree-hook)
+ (flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance)))
+ (let* ((file (buffer-file-name (current-buffer)))
+ (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
+ (to (mp "MAIL_TO"))
+ (cc (mp "MAIL_CC"))
+ (bcc (mp "MAIL_BCC"))
+ (body (buffer-substring
+ (save-excursion (goto-char (point-min))
+ (forward-line 1)
+ (when (looking-at "[ \t]*:PROPERTIES:")
+ (re-search-forward ":END:" nil)
+ (forward-char))
+ (point))
+ (point-max))))
+ (org-mime-compose body (or fmt 'org) file to subject
+ `((cc . ,cc) (bcc . ,bcc)))))))
+
+(defun org-mime-send-buffer (&optional fmt)
+ (run-hooks 'org-mime-send-buffer-hook)
+ (let* ((region-p (org-region-active-p))
+ (subject (org-export-grab-title-from-buffer))
+ (file (buffer-file-name (current-buffer)))
+ (body-start (or (and region-p (region-beginning))
+ (save-excursion (goto-char (point-min)))))
+ (body-end (or (and region-p (region-end)) (point-max)))
+ (temp-body-file (make-temp-file "org-mime-export"))
+ (body (buffer-substring body-start body-end)))
+ (org-mime-compose body (or fmt 'org) file nil subject)))
+
+(defun org-mime-compose (body fmt file &optional to subject headers)
+ (require 'message)
+ (message-mail to subject headers nil)
+ (message-goto-body)
+ (flet ((bhook (body fmt)
+ (let ((hook (intern (concat "org-mime-pre-"
+ (symbol-name fmt)
+ "-hook"))))
+ (if (> (eval `(length ,hook)) 0)
+ (with-temp-buffer
+ (insert body)
+ (goto-char (point-min))
+ (eval `(run-hooks ',hook))
+ (buffer-string))
+ body))))
+ (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
+ (cond
+ ((eq fmt 'org)
+ (insert (org-export-string (org-babel-trim (bhook body 'org)) 'org)))
+ ((eq fmt 'ascii)
+ (insert (org-export-string
+ (concat "#+Title:\n" (bhook body 'ascii)) 'ascii)))
+ ((or (eq fmt 'html) (eq fmt 'html-ascii))
+ (let* ((org-link-file-path-type 'absolute)
+ ;; we probably don't want to export a huge style file
+ (org-export-htmlize-output-type 'inline-css)
+ (html-and-images (org-mime-replace-images
+ (org-export-string
+ (bhook body 'html)
+ 'html (file-name-nondirectory file))
+ file))
+ (images (cdr html-and-images))
+ (html (org-mime-apply-html-hook (car html-and-images))))
+ (insert (org-mime-multipart
+ (org-export-string
+ (org-babel-trim
+ (bhook body (if (eq fmt 'html) 'org 'ascii)))
+ (if (eq fmt 'html) 'org 'ascii))
+ html)
+ (mapconcat 'identity images "\n"))))))))
+
+(defun org-mime-org-buffer-htmlize ()
+ "Create an email buffer containing the current org-mode file
+ exported to html and encoded in both html and in org formats as
+ mime alternatives."
+ (interactive)
+ (org-mime-send-buffer 'html))
+
+(defun org-mime-subtree ()
+ "Create an email buffer containing the current org-mode subtree
+ exported to a org format or to the format specified by the
+ MAIL_FMT property of the subtree."
+ (interactive)
+ (org-mime-send-subtree
+ (or (org-entry-get nil "MAIL_FMT" org-mime-use-property-inheritance) 'org)))
+
+(provide 'org-mime)
diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el
new file mode 100644
index 0000000..8ea5fa9
--- /dev/null
+++ b/contrib/lisp/org-mtags.el
@@ -0,0 +1,257 @@
+;;; org-mtags.el --- Muse-like tags in Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+;;
+;; This file is not yet 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, 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; 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 modules implements some of the formatting tags available in
+;; Emacs Muse. This is not a way if adding new functionality, but just
+;; a different way to write some formatting directives. The advantage is
+;; that files written in this way can be read by Muse reasonably well,
+;; and that this provides an alternative way of writing formatting
+;; directives in Org, a way that some might find more pleasant to type
+;; and look at that the Org's #+BEGIN..#+END notation.
+
+;; The goal of this development is to make it easier for people to
+;; move between both worlds as they see fit for different tasks.
+
+;; The following muse tags will be translated during export into their
+;; native Org equivalents:
+;;
+;; <br>
+;; Needs to be at the end of a line. Will be translated to "\\".
+;;
+;; <example switches="-n -r">
+;; Needs to be on a line by itself, similarly the </example> tag.
+;; Will be translated into Org's #+BEGIN_EXAMPLE construct.
+;;
+;; <quote>
+;; Needs to be on a line by itself, similarly the </quote> tag.
+;; Will be translated into Org's #+BEGIN_QUOTE construct.
+;;
+;; <comment>
+;; Needs to be on a line by itself, similarly the </comment> tag.
+;; Will be translated into Org's #+BEGIN_COMMENT construct.
+;;
+;; <verse>
+;; Needs to be on a line by itself, similarly the </verse> tag.
+;; Will be translated into Org's #+BEGIN_VERSE construct.
+;;
+;; <contents>
+;; This gets translated into "[TABLE-OF-CONTENTS]". It will not
+;; trigger the production of a table of contents - that is done
+;; in Org with the "#+OPTIONS: toc:t" setting. But it will define
+;; the location where the TOC will be placed.
+;;
+;; <literal style="STYLE"> ;; only latex, html, and docbook supported
+;; in Org.
+;; Needs to be on a line by itself, similarly the </literal> tag.
+;;
+;; <src lang="LANG" switches="-n -r">
+;; Needs to be on a line by itself, similarly the </src> tag.
+;; Will be translated into Org's BEGIN_SRC construct.
+;;
+;; <include file="FILE" markup="MARKUP" lang="LANG"
+;; prefix="str" prefix1="str" switches="-n -r">
+;; Needs to be on a line by itself.
+;; Will be translated into Org's #+INCLUDE construct.
+;;
+;; The lisp/perl/ruby/python tags can be implemented using the
+;; `org-eval.el' module, which see.
+
+(require 'org)
+
+;;; Customization
+
+(defgroup org-mtags nil
+ "Options concerning Muse tags in Org mode."
+ :tag "Org Muse Tags"
+ :group 'org)
+
+(defface org-mtags ; similar to shadow
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face for Muse-like tags in Org."
+ :group 'org-mtags
+ :group 'org-faces)
+
+(defcustom org-mtags-prefer-muse-templates t
+ "Non-nil means prefere Muse tags for structure elements.
+This is relevane when expanding the templates defined in the variable
+`org-structure-templates'."
+ :group 'org-mtags
+ :type 'boolean)
+
+(defconst org-mtags-supported-tags
+ '("example" "quote" "comment" "verse" "contents" "literal" "src" "include")
+ "The tags that are supported by org-mtags.el for conversion.
+In addition to this list, the <br> tag is supported as well.")
+
+(defconst org-mtags-fontification-re
+ (concat
+ "^[ \t]*</?\\("
+ (mapconcat 'identity org-mtags-supported-tags "\\|")
+ "\\)\\>[^>]*>\\|<br>[ \t]*$")
+ "Regular expression used for fontifying muse tags.")
+
+(defun org-mtags-replace ()
+ "Replace Muse-like tags with the appropriate Org constructs.
+The is done in the entire buffer."
+ (interactive) ;; FIXME
+ (let ((re (concat "^[ \t]*\\(</?\\("
+ (mapconcat 'identity org-mtags-supported-tags "\\|")
+ "\\)\\>\\)"))
+ info tag rpl style markup lang file prefix prefix1 switches)
+ ;; First, do the <br> tag
+ (goto-char (point-min))
+ (while (re-search-forward "<br>[ \t]*$" nil t)
+ (replace-match "\\\\" t t))
+ ;; Now, all the other tags
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (goto-char (match-beginning 1))
+ (setq info (org-mtags-get-tag-and-attributes))
+ (if (not info)
+ (end-of-line 1)
+ (setq tag (plist-get info :tag))
+ (cond
+ ((equal tag "contents")
+ (setq rpl "[TABLE-OF-CONTENTS]")
+ ;; FIXME: also trigger TOC in options-plist?????
+ )
+ ((member tag '("quote" "comment" "verse"))
+ (if (plist-get info :closing)
+ (setq rpl (format "#+END_%s" (upcase tag)))
+ (setq rpl (format "#+BEGIN_%s" (upcase tag)))))
+ ((equal tag "literal")
+ (setq style (plist-get info :style))
+ (and style (setq style (downcase style)))
+ (if (plist-get info :closing)
+ (setq rpl (cond
+ ((member style '("latex"))
+ "#+END_LaTeX")
+ ((member style '("html"))
+ "#+END_HTML")
+ ((member style '("docbook"))
+ "#+END_DOCBOOK")
+ ((member style '("ascii"))
+ "#+END_ASCII")))
+ (setq rpl (cond
+ ((member style '("latex"))
+ "#+BEGIN_LaTeX")
+ ((member style '("html"))
+ "#+BEGIN_HTML")
+ ((member style '("ascii"))
+ "#+BEGIN_ASCII")))))
+ ((equal tag "example")
+ (if (plist-get info :closing)
+ (setq rpl "#+END_EXAMPLE")
+ (setq rpl "#+BEGIN_EXAMPLE")
+ (when (setq switches (plist-get info :switches))
+ (setq rpl (concat rpl " " switches)))))
+ ((equal tag "src")
+ (if (plist-get info :closing)
+ (setq rpl "#+END_SRC")
+ (setq rpl "#+BEGIN_SRC")
+ (when (setq lang (plist-get info :lang))
+ (setq rpl (concat rpl " " lang))
+ (when (setq switches (plist-get info :switches))
+ (setq rpl (concat rpl " " switches))))))
+ ((equal tag "include")
+ (setq file (plist-get info :file)
+ markup (downcase (plist-get info :markup))
+ lang (plist-get info :lang)
+ prefix (plist-get info :prefix)
+ prefix1 (plist-get info :prefix1)
+ switches (plist-get info :switches))
+ (setq rpl "#+INCLUDE")
+ (setq rpl (concat rpl " " (prin1-to-string file)))
+ (when markup
+ (setq rpl (concat rpl " " markup))
+ (when (and (equal markup "src") lang)
+ (setq rpl (concat rpl " " lang))))
+ (when prefix
+ (setq rpl (concat rpl " :prefix " (prin1-to-string prefix))))
+ (when prefix1
+ (setq rpl (concat rpl " :prefix1 " (prin1-to-string prefix1))))
+ (when switches
+ (setq rpl (concat rpl " " switches)))))
+ (when rpl
+ (goto-char (plist-get info :match-beginning))
+ (delete-region (point-at-bol) (plist-get info :match-end))
+ (insert rpl))))))
+
+(defun org-mtags-get-tag-and-attributes ()
+ "Parse a Muse-like tag at point ant rturn the information about it.
+The return value is a property list which contains all the attributes
+with string values. In addition, it reutnrs the following properties:
+
+:tag The tag as a string.
+:match-beginning The beginning of the match, just before \"<\".
+:match-end The end of the match, just after \">\".
+:closing t when the tag starts with \"</\"."
+ (when (looking-at "<\\(/\\)?\\([a-zA-Z]+\\>\\)\\([^>]*\\)>")
+ (let ((start 0)
+ tag rest prop attributes endp val)
+ (setq tag (org-match-string-no-properties 2)
+ endp (match-end 1)
+ rest (and (match-end 3)
+ (org-match-string-no-properties 3))
+ attributes (list :tag tag
+ :match-beginning (match-beginning 0)
+ :match-end (match-end 0)
+ :closing endp))
+ (when rest
+ (while (string-match "\\([a-zA-Z]+\\)=\\([^ \t\n>]+\\|\"[^>]+\"\\)"
+ rest start)
+ (setq start (match-end 0)
+ prop (org-match-string-no-properties 1 rest)
+ val (org-remove-double-quotes
+ (org-match-string-no-properties 2 rest)))
+ (setq attributes (plist-put attributes
+ (intern (concat ":" prop)) val))))
+ attributes)))
+
+(defun org-mtags-fontify-tags (limit)
+ "Fontify the muse-like tags."
+ (while (re-search-forward org-mtags-fontification-re limit t)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(face org-mtags font-lock-multiline t
+ font-lock-fontified t))))
+
+(add-hook 'org-export-preprocess-hook 'org-mtags-replace)
+(add-hook 'org-font-lock-hook 'org-mtags-fontify-tags)
+
+(provide 'org-mtags)
+
+;;; org-mtags.el ends here
diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
new file mode 100644
index 0000000..9ddf150
--- /dev/null
+++ b/contrib/lisp/org-notify.el
@@ -0,0 +1,377 @@
+;;; org-notify.el --- Notifications for Org-mode
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Peter Münster <pmrb@free.fr>
+;; Keywords: notification, todo-list, alarm, reminder, pop-up
+
+;; 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:
+
+;; Get notifications, when there is something to do.
+;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a
+;; present for a birthday, and then another notification one hour before to
+;; have enough time to choose the right clothes.
+;; For other events, e.g. rolling the dustbin to the roadside once per week,
+;; you probably need another kind of notification strategy.
+;; This package tries to satisfy the various needs.
+
+;; In order to activate this package, you must add the following code
+;; into your .emacs:
+;;
+;; (require 'org-notify)
+;; (org-notify-start)
+
+;; Example setup:
+;; (org-notify-add 'appt
+;; '(:time "-1s" :period "20s" :duration 10
+;; :actions (-message -ding))
+;; '(:time "15m" :period "2m" :duration 100
+;; :actions -notify)
+;; '(:time "2h" :period "5m" :actions -message)
+;; '(:time "3d" :actions -email))
+;; This means for todo-items with `notify' property set to `appt': 3 days
+;; before deadline, send a reminder-email, 2 hours before deadline, start to
+;; send messages every 5 minutes, then 15 minutes before deadline, start to
+;; pop up notification windows every 2 minutes. The timeout of the window is
+;; set to 100 seconds. Finally, when deadline is overdue, send messages and
+;; make noise."
+
+;; Take also a look at the function `org-notify-add'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-element)
+
+(declare-function appt-delete-window "appt" ())
+(declare-function notifications-notify "notifications" (&rest prms))
+(declare-function article-lapsed-string "gnus-art" (t &optional ms))
+
+(defgroup org-notify nil
+ "Options for Org-mode notifications."
+ :tag "Org Notify"
+ :group 'org)
+
+(defcustom org-notify-audible t
+ "Non-nil means beep to indicate notification."
+ :type 'boolean
+ :group 'org-notify)
+
+(defconst org-notify-actions
+ '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
+ "week" "one week later")
+ "Possible actions for call-back functions.")
+
+(defconst org-notify-window-buffer-name "*org-notify-%s*"
+ "Buffer-name for the `org-notify-action-window' function.")
+
+(defvar org-notify-map nil
+ "Mapping between names and parameter lists.")
+
+(defvar org-notify-timer nil
+ "Timer of the notification daemon.")
+
+(defvar org-notify-parse-file nil
+ "Index of current file, that `org-element-parse-buffer' is parsing.")
+
+(defvar org-notify-on-action-map nil
+ "Mapping between on-action identifiers and parameter lists.")
+
+(defun org-notify-string->seconds (str)
+ "Convert time string STR to number of seconds."
+ (when str
+ (let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60))
+ ("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60))
+ ("M" . ,(* 30 24 60 60))))
+ (letters (concat
+ (mapcar (lambda (x) (string-to-char (car x))) conv)))
+ (case-fold-search nil))
+ (string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str)
+ (* (string-to-number (match-string 2 str))
+ (cdr (assoc (match-string 3 str) conv))
+ (if (= (length (match-string 1 str)) 1) -1 1)))))
+
+(defun org-notify-make-todo (heading &rest ignored)
+ "Create one todo item."
+ (macrolet ((get (k) `(plist-get list ,k))
+ (pr (k v) `(setq result (plist-put result ,k ,v))))
+ (let* ((list (nth 1 heading)) (notify (or (get :notify) "default"))
+ (deadline (get :deadline)) (heading (get :raw-value))
+ result)
+ (when (and (eq (get :todo-type) 'todo) heading deadline)
+ (pr :heading heading) (pr :notify (intern notify))
+ (pr :begin (get :begin))
+ (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
+ (pr :timestamp deadline) (pr :uid (md5 (concat heading deadline)))
+ (pr :deadline (- (org-time-string-to-seconds deadline)
+ (org-float-time))))
+ result)))
+
+(defun org-notify-todo-list ()
+ "Create the todo-list for one org-agenda file."
+ (let* ((files (org-agenda-files 'unrestricted))
+ (max (1- (length files))))
+ (setq org-notify-parse-file
+ (if (or (not org-notify-parse-file) (>= org-notify-parse-file max))
+ 0
+ (1+ org-notify-parse-file)))
+ (save-excursion
+ (with-current-buffer (find-file-noselect
+ (nth org-notify-parse-file files))
+ (org-element-map (org-element-parse-buffer 'headline)
+ 'headline 'org-notify-make-todo)))))
+
+(defun org-notify-maybe-too-late (diff period heading)
+ "Print waring message, when notified significantly later than defined by
+PERIOD."
+ (if (> (/ diff period) 1.5)
+ (message "Warning: notification for \"%s\" behind schedule!" heading))
+ t)
+
+(defun org-notify-process ()
+ "Process the todo-list, and possibly notify user about upcoming or
+forgotten tasks."
+ (macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo ,k)))
+ (dolist (todo (org-notify-todo-list))
+ (let* ((deadline (td :deadline)) (heading (td :heading))
+ (uid (td :uid)) (last-run-sym
+ (intern (concat ":last-run-" uid))))
+ (dolist (prms (plist-get org-notify-map (td :notify)))
+ (when (< deadline (org-notify-string->seconds (prm :time)))
+ (let ((period (org-notify-string->seconds (prm :period)))
+ (last-run (prm last-run-sym)) (now (org-float-time))
+ (actions (prm :actions)) diff plist)
+ (when (or (not last-run)
+ (and period (< period (setq diff (- now last-run)))
+ (org-notify-maybe-too-late diff period heading)))
+ (setq prms (plist-put prms last-run-sym now)
+ plist (append todo prms))
+ (if (if (plist-member prms :audible)
+ (prm :audible)
+ org-notify-audible)
+ (ding))
+ (unless (listp actions)
+ (setq actions (list actions)))
+ (dolist (action actions)
+ (funcall (if (fboundp action) action
+ (intern (concat "org-notify-action"
+ (symbol-name action))))
+ plist))))
+ (return)))))))
+
+(defun org-notify-add (name &rest params)
+ "Add a new notification type. The NAME can be used in Org-mode property
+`notify'. If NAME is `default', the notification type applies for todo items
+without the `notify' property. This file predefines such a default
+notification type.
+
+Each element of PARAMS is a list with parameters for a given time
+distance to the deadline. This distance must increase from one element to
+the next.
+List of possible parameters:
+ :time Time distance to deadline, when this type of notification shall
+ start. It's a string: an integral value (positive or negative)
+ followed by a unit (s, m, h, d, w, M).
+ :actions A function or a list of functions to be called to notify the
+ user. Instead of a function name, you can also supply a suffix
+ of one of the various predefined `org-notify-action-xxx'
+ functions.
+ :period Optional: can be used to repeat the actions periodically. Same
+ format as :time.
+ :duration Some actions use this parameter to specify the duration of the
+ notification. It's an integral number in seconds.
+ :audible Overwrite the value of `org-notify-audible' for this action.
+
+For the actions, you can use your own functions or some of the predefined
+ones, whose names are prefixed with `org-notify-action-'."
+ (setq org-notify-map (plist-put org-notify-map name params)))
+
+(defun org-notify-start (&optional secs)
+ "Start the notification daemon. If SECS is positive, it's the
+period in seconds for processing the notifications of one
+org-agenda file, and if negative, notifications will be checked
+only when emacs is idle for -SECS seconds. The default value for
+SECS is 20."
+ (if org-notify-timer
+ (org-notify-stop))
+ (setq secs (or secs 20)
+ org-notify-timer (if (< secs 0)
+ (run-with-idle-timer (* -1 secs) t
+ 'org-notify-process)
+ (run-with-timer secs secs 'org-notify-process))))
+
+(defun org-notify-stop ()
+ "Stop the notification daemon."
+ (when org-notify-timer
+ (cancel-timer org-notify-timer)
+ (setq org-notify-timer nil)))
+
+(defun org-notify-on-action (plist key)
+ "User wants to see action."
+ (let ((file (plist-get plist :file))
+ (begin (plist-get plist :begin)))
+ (if (string-equal key "show")
+ (progn
+ (switch-to-buffer (find-file-noselect file))
+ (org-with-wide-buffer
+ (goto-char begin)
+ (show-entry))
+ (goto-char begin)
+ (search-forward "DEADLINE: <")
+ (if (display-graphic-p)
+ (x-focus-frame nil)))
+ (save-excursion
+ (with-current-buffer (find-file-noselect file)
+ (org-with-wide-buffer
+ (goto-char begin)
+ (search-forward "DEADLINE: <")
+ (cond
+ ((string-equal key "done") (org-todo))
+ ((string-equal key "hour") (org-timestamp-change 60 'minute))
+ ((string-equal key "day") (org-timestamp-up-day))
+ ((string-equal key "week") (org-timestamp-change 7 'day)))))))))
+
+(defun org-notify-on-action-notify (id key)
+ "User wants to see action after mouse-click in notify window."
+ (org-notify-on-action (plist-get org-notify-on-action-map id) key)
+ (org-notify-on-close id nil))
+
+(defun org-notify-on-action-button (button)
+ "User wants to see action after button activation."
+ (macrolet ((get (k) `(button-get button ,k)))
+ (org-notify-on-action (get 'plist) (get 'key))
+ (org-notify-delete-window (get 'buffer))
+ (cancel-timer (get 'timer))))
+
+(defun org-notify-delete-window (buffer)
+ "Delete the notification window."
+ (require 'appt)
+ (let ((appt-buffer-name buffer)
+ (appt-audible nil))
+ (appt-delete-window)))
+
+(defun org-notify-on-close (id reason)
+ "Notification window has been closed."
+ (setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil)))
+
+(defun org-notify-action-message (plist)
+ "Print a message."
+ (message "TODO: \"%s\" at %s!" (plist-get plist :heading)
+ (plist-get plist :timestamp)))
+
+(defun org-notify-action-ding (plist)
+ "Make noise."
+ (let ((timer (run-with-timer 0 1 'ding)))
+ (run-with-timer (or (plist-get plist :duration) 3) nil
+ 'cancel-timer timer)))
+
+(defun org-notify-body-text (plist)
+ "Make human readable string for remaining time to deadline."
+ (require 'gnus-art)
+ (format "%s\n(%s)"
+ (replace-regexp-in-string
+ " in the future" ""
+ (article-lapsed-string
+ (time-add (current-time)
+ (seconds-to-time (plist-get plist :deadline))) 2))
+ (plist-get plist :timestamp)))
+
+(defun org-notify-action-email (plist)
+ "Send email to user."
+ (compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
+ (insert (org-notify-body-text plist))
+ (funcall send-mail-function)
+ (flet ((yes-or-no-p (prompt) t))
+ (kill-buffer)))
+
+(defun org-notify-select-highest-window ()
+ "Select the highest window on the frame, that is not is not an
+org-notify window. Mostly copied from `appt-select-lowest-window'."
+ (let ((highest-window (selected-window))
+ (bottom-edge (nth 3 (window-edges)))
+ next-bottom-edge)
+ (walk-windows (lambda (w)
+ (when (and
+ (not (string-match "^\\*org-notify-.*\\*$"
+ (buffer-name
+ (window-buffer w))))
+ (> bottom-edge (setq next-bottom-edge
+ (nth 3 (window-edges w)))))
+ (setq bottom-edge next-bottom-edge
+ highest-window w))) 'nomini)
+ (select-window highest-window)))
+
+(defun org-notify-action-window (plist)
+ "Pop up a window, mostly copied from `appt-disp-window'."
+ (save-excursion
+ (macrolet ((get (k) `(plist-get plist ,k)))
+ (let ((this-window (selected-window))
+ (buf (get-buffer-create
+ (format org-notify-window-buffer-name (get :uid)))))
+ (when (minibufferp)
+ (other-window 1)
+ (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
+ (if (cdr (assq 'unsplittable (frame-parameters)))
+ (progn (set-buffer buf) (display-buffer buf))
+ (unless (or (special-display-p (buffer-name buf))
+ (same-window-p (buffer-name buf)))
+ (org-notify-select-highest-window)
+ (when (>= (window-height) (* 2 window-min-height))
+ (select-window (split-window nil nil 'above))))
+ (switch-to-buffer buf))
+ (setq buffer-read-only nil buffer-undo-list t)
+ (erase-buffer)
+ (insert (format "TODO: %s, %s.\n" (get :heading)
+ (org-notify-body-text plist)))
+ (let ((timer (run-with-timer (or (get :duration) 10) nil
+ 'org-notify-delete-window buf)))
+ (dotimes (i (/ (length org-notify-actions) 2))
+ (let ((key (nth (* i 2) org-notify-actions))
+ (text (nth (1+ (* i 2)) org-notify-actions)))
+ (insert-button text 'action 'org-notify-on-action-button
+ 'key key 'buffer buf 'plist plist 'timer timer)
+ (insert " "))))
+ (shrink-window-if-larger-than-buffer (get-buffer-window buf t))
+ (set-buffer-modified-p nil) (setq buffer-read-only t)
+ (raise-frame (selected-frame)) (select-window this-window)))))
+
+(defun org-notify-action-notify (plist)
+ "Pop up a notification window."
+ (require 'notifications)
+ (let* ((duration (plist-get plist :duration))
+ (id (notifications-notify
+ :title (plist-get plist :heading)
+ :body (org-notify-body-text plist)
+ :timeout (if duration (* duration 1000))
+ :actions org-notify-actions
+ :on-action 'org-notify-on-action-notify)))
+ (setq org-notify-on-action-map
+ (plist-put org-notify-on-action-map id plist))))
+
+(defun org-notify-action-notify/window (plist)
+ "For a graphics display, pop up a notification window, for a text
+terminal an emacs window."
+ (if (display-graphic-p)
+ (org-notify-action-notify plist)
+ (org-notify-action-window plist)))
+
+;;; Provide a minimal default setup.
+(org-notify-add 'default '(:time "1h" :actions -notify/window
+ :period "2m" :duration 60))
+
+(provide 'org-notify)
+
+;;; org-notify.el ends here
diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el
new file mode 100644
index 0000000..0affd71
--- /dev/null
+++ b/contrib/lisp/org-notmuch.el
@@ -0,0 +1,105 @@
+;;; org-notmuch.el --- Support for links to notmuch messages from within Org-mode
+
+;; Copyright (C) 2010-2012 Matthieu Lemerre
+
+;; Author: Matthieu Lemerre <racin@free.fr>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is not part of GNU Emacs.
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This file implements links to notmuch messages and "searchs". A
+;; search is a query to be performed by notmuch; it is the equivalent
+;; to folders in other mail clients. Similarly, mails are refered to
+;; by a query, so both a link can refer to several mails.
+
+;; Links have one the following form
+;; notmuch:<search terms>
+;; notmuch-search:<search terms>.
+
+;; The first form open the queries in notmuch-show mode, whereas the
+;; second link open it in notmuch-search mode. Note that queries are
+;; performed at the time the link is opened, and the result may be
+;; different from whet the link was stored.
+
+;;; Code:
+
+(require 'org)
+
+;; Install the link type
+(org-add-link-type "notmuch" 'org-notmuch-open)
+(add-hook 'org-store-link-functions 'org-notmuch-store-link)
+
+(defun org-notmuch-store-link ()
+ "Store a link to a notmuch search or message."
+ (when (eq major-mode 'notmuch-show-mode)
+ (let* ((message-id (notmuch-show-get-prop :id))
+ (subject (notmuch-show-get-subject))
+ (to (notmuch-show-get-to))
+ (from (notmuch-show-get-from))
+ desc link)
+ (org-store-link-props :type "notmuch" :from from :to to
+ :subject subject :message-id message-id)
+ (setq desc (org-email-link-description))
+ (setq link (concat "notmuch:" "id:" message-id))
+ (org-add-link-props :link link :description desc)
+ link)))
+
+(defun org-notmuch-open (path)
+ "Follow a notmuch message link specified by PATH."
+ (org-notmuch-follow-link path))
+
+(defun org-notmuch-follow-link (search)
+ "Follow a notmuch link to SEARCH.
+
+Can link to more than one message, if so all matching messages are shown."
+ (require 'notmuch)
+ (notmuch-show (org-link-unescape search)))
+
+
+
+
+(org-add-link-type "notmuch-search" 'org-notmuch-search-open)
+(add-hook 'org-store-link-functions 'org-notmuch-search-store-link)
+
+(defun org-notmuch-search-store-link ()
+ "Store a link to a notmuch search or message."
+ (when (eq major-mode 'notmuch-search-mode)
+ (let ((link (concat "notmuch-search:"
+ (org-link-escape notmuch-search-query-string)))
+ (desc (concat "Notmuch search: " notmuch-search-query-string)))
+ (org-store-link-props :type "notmuch-search"
+ :link link
+ :description desc)
+ link)))
+
+(defun org-notmuch-search-open (path)
+ "Follow a notmuch message link specified by PATH."
+ (message path)
+ (org-notmuch-search-follow-link path))
+
+(defun org-notmuch-search-follow-link (search)
+ "Follow a notmuch link by displaying SEARCH in notmuch-search mode."
+ (require 'notmuch)
+ (notmuch-search (org-link-unescape search)))
+
+(provide 'org-notmuch)
+
+;;; org-notmuch.el ends here
diff --git a/contrib/lisp/org-panel.el b/contrib/lisp/org-panel.el
new file mode 100644
index 0000000..3ffdfaf
--- /dev/null
+++ b/contrib/lisp/org-panel.el
@@ -0,0 +1,641 @@
+;;; org-panel.el --- Simple routines for us with bad memory
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Created: Thu Nov 15 15:35:03 2007
+;; Version: 0.21
+;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
+;; URL:
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
+;; `time-date'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This defines a kind of control panel for `org-mode'. This control
+;; panel should make it fast to move around and edit structure etc.
+;;
+;; To bring up the control panel type
+;;
+;; M-x orgpan-panel
+;;
+;; Type ? there for help.
+;;
+;; I suggest you add the following to your .emacs for quick access of
+;; the panel:
+;;
+;; (eval-after-load 'org-mode
+;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(require 'org)
+(require 'outline)
+
+;; Fix-me: this is for testing. A minor mode version interferes badly
+;; with emulation minor modes. On the other hand, the other version
+;; interferes badly with (interactive ...).
+(defvar orgpan-minor-mode-version t)
+
+(defface orgpan-field
+ '((t (:inherit 'widget-field)))
+ "Face for fields."
+ :group 'winsize)
+(defvar orgpan-field-face 'orgpan-field)
+
+(defface orgpan-active-field
+ '((t (:inherit 'highlight)))
+ "Face for fields."
+ :group 'winsize)
+(defvar orgpan-active-field-face 'orgpan-active-field)
+
+(defface orgpan-spaceline
+ '((t (:height 0.2)))
+ "Face for spacing lines."
+ :group 'winsize)
+
+(defcustom orgpan-panel-buttons nil
+ "Panel style, if non-nil use buttons.
+If there are buttons in the panel they are used to change the way
+the arrow keys work. The panel looks something like this, with
+the first button chosen:
+
+ [Navigate] [Restructure] [TODO/Priority]
+ ----------
+ up/down, left: Go to, right: Visibility
+
+The line below the buttons try to give a short hint about what
+the arrow keys does. \(Personally I prefer the version without
+buttons since I then do not have to remember which button is
+active.)"
+ :type 'boolean
+ :group 'winsize)
+
+;; Fix-me: add org-mode-map
+(defconst orgpan-org-mode-commands nil)
+(defconst orgpan-org-commands
+ '(
+ orgpan-copy-subtree
+ orgpan-cut-subtree
+ orgpan-paste-subtree
+ undo
+ ;;
+ ;orgpan-occur
+ ;;
+ org-cycle
+ org-global-cycle
+ outline-up-heading
+ outline-next-visible-heading
+ outline-previous-visible-heading
+ outline-forward-same-level
+ outline-backward-same-level
+ org-todo
+ org-show-todo-tree
+ org-priority-up
+ org-priority-down
+ org-move-subtree-up
+ org-move-subtree-down
+ org-do-promote
+ org-do-demote
+ org-promote-subtree
+ org-demote-subtree))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Hook functions etc
+
+;;(defvar orgpan-this-panel-window nil)
+
+(defun orgpan-delete-panel ()
+ "Remove the panel."
+ (interactive)
+ (when (buffer-live-p orgpan-panel-buffer)
+ (delete-windows-on orgpan-panel-buffer)
+ (kill-buffer orgpan-panel-buffer))
+ (setq orgpan-panel-buffer nil)
+ (setq orgpan-panel-window nil)
+ (orgpan-panel-minor-mode 0)
+ (remove-hook 'post-command-hook 'orgpan-minor-post-command)
+ (remove-hook 'post-command-hook 'orgpan-mode-post-command)
+ ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
+ )
+
+(defvar orgpan-last-command-was-from-panel nil)
+(defun orgpan-mode-pre-command ()
+ (setq orgpan-last-command-was-from-panel nil)
+ (condition-case err
+ (if (not (and (windowp orgpan-org-window)
+ (window-live-p orgpan-org-window)))
+ (progn
+ (setq this-command 'ignore)
+ (orgpan-delete-panel)
+ (message "The window belonging to the panel had disappeared, removed panel."))
+ (let ((buf (window-buffer orgpan-org-window)))
+ (when (with-current-buffer buf
+ (derived-mode-p 'org-mode))
+ (setq orgpan-last-org-buffer buf))
+ ;; Fix me: add a list of those commands that are not
+ ;; meaningful from the panel (for example org-time-stamp)
+ (when (or (memq this-command orgpan-org-commands)
+ (memq this-command orgpan-org-mode-commands)
+ ;; For some reason not all org commands are found above:
+ (string= "org-" (substring (format "%s" this-command) 0 4)))
+ (if (not (with-current-buffer buf
+ (derived-mode-p 'org-mode)))
+ (progn
+ (if (buffer-live-p orgpan-org-buffer)
+ (set-window-buffer orgpan-org-window orgpan-org-buffer)
+ (message "Please use `l' or `b' to choose an org-mode buffer"))
+ (setq this-command 'ignore))
+ (setq orgpan-org-buffer (window-buffer orgpan-org-window))
+ (setq orgpan-last-command-was-from-panel t)
+ (select-window orgpan-org-window)
+ ;;(when (active-minibuffer-window
+ ;;(set-buffer orgpan-org-buffer)
+ ))))
+ (error (lwarn 't :warning "orgpan-pre: %S" err))))
+
+(defun orgpan-mode-post-command ()
+ (condition-case err
+ (progn
+ (unless (and (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window)
+ (bufferp orgpan-panel-buffer)
+ (buffer-live-p orgpan-panel-buffer))
+ ;;(orgpan-delete-panel)
+ )
+ (when (and orgpan-last-command-was-from-panel
+ (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window))
+ (select-window orgpan-panel-window)
+ (when (derived-mode-p 'orgpan-mode)
+ (setq deactivate-mark t)
+ (when orgpan-panel-buttons
+ (unless (and orgpan-point
+ (= (point) orgpan-point))
+ ;; Go backward so it is possible to click on a "button":
+ (orgpan-backward-field)))))
+ (setq orgpan-this-panel-window nil))
+ (error (lwarn 't :warning "orgpan-post: %S" err))))
+
+;; (defun orgpan-window-config-change ()
+;; "Check if any frame is displaying an orgpan panel.
+;; If not remove `orgpan-mode-post-command' and this function from
+;; the hooks."
+;; (condition-case err
+;; (unless (and (
+;; (let ((found-pan nil))
+;; (dolist (f (frame-list))
+;; (dolist (w (window-list f 'nomini))
+;; (with-current-buffer (window-buffer w)
+;; (when (derived-mode-p 'orgpan-mode)
+;; (setq found-pan t)))))
+;; (unless found-pan
+;; (remove-hook 'post-command-hook 'orgpan-mode-post-command)
+;; (remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)))
+;; (error (lwarn 't :warning "Error in orgpan-config-change: %S" err))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Commands
+
+(defun orgpan-last-buffer ()
+ "Open last org-mode buffer in panels org window."
+ (interactive)
+ (let ((buf (window-buffer orgpan-org-window))
+ (last-buf orgpan-last-org-buffer))
+ (when (with-current-buffer buf
+ (derived-mode-p 'org-mode))
+ (setq orgpan-last-org-buffer buf))
+ (when (eq last-buf buf)
+ (setq last-buf nil))
+ (if (not last-buf)
+ (orgpan-switch-buffer)
+ (set-window-buffer orgpan-org-window last-buf))))
+
+(defun orgpan-switch-buffer ()
+ "Switch to next org-mode buffer in panels org window."
+ (interactive)
+ (let ((buf (window-buffer orgpan-org-window))
+ (org-buffers nil))
+ (with-current-buffer buf
+ (when (derived-mode-p 'org-mode)
+ (bury-buffer buf)
+ (setq orgpan-last-org-buffer buf)))
+ (setq org-buffers (delq nil (mapcar (lambda (buf)
+ (when (with-current-buffer buf
+ (derived-mode-p 'org-mode))
+ buf))
+ (buffer-list))))
+ (setq org-buffers (delq buf org-buffers))
+ (set-window-buffer orgpan-org-window (car org-buffers))
+ (setq orgpan-org-buffer (car org-buffers))))
+
+(defun orgpan-paste-subtree ()
+ (interactive)
+ (if (y-or-n-p "Paste subtree here? ")
+ (org-paste-subtree)
+ (message "Nothing was pasted")))
+
+(defun orgpan-cut-subtree ()
+ (interactive)
+ (let ((heading (progn
+ (org-back-to-heading)
+ (buffer-substring (point) (line-end-position))
+ )))
+ (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
+ (org-cut-subtree)
+ (message "Nothing was cut"))))
+
+(defun orgpan-copy-subtree ()
+ (interactive)
+ (let ((heading (progn
+ (org-back-to-heading)
+ (buffer-substring (point) (line-end-position))
+ )))
+ (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
+ (org-copy-subtree)
+ (message "Nothing was copied"))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Buttons
+
+(defvar orgpan-ovl-help nil)
+
+(defun orgpan-check-panel-mode ()
+ (unless (derived-mode-p 'orgpan-mode)
+ (error "Not orgpan-mode in buffer: " major-mode)))
+
+(defun orgpan-display-bindings-help ()
+ (orgpan-check-panel-mode)
+ (setq orgpan-point (point))
+ (let* ((ovls (overlays-at (point)))
+ (ovl (car ovls))
+ (help (when ovl (overlay-get ovl 'orgpan-explain))))
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (overlay-put o 'face orgpan-field-face))
+ (overlay-put ovl 'face orgpan-active-field-face)
+ (overlay-put orgpan-ovl-help 'before-string help)))
+
+(defun orgpan-forward-field ()
+ (interactive)
+ (orgpan-check-panel-mode)
+ (let ((pos (next-overlay-change (point))))
+ (unless (overlays-at pos)
+ (setq pos (next-overlay-change pos)))
+ (when (= pos (point-max))
+ (setq pos (point-min))
+ (unless (overlays-at pos)
+ (setq pos (next-overlay-change pos))))
+ (goto-char pos))
+ (orgpan-display-bindings-help))
+
+(defun orgpan-backward-field ()
+ (interactive)
+ (orgpan-check-panel-mode)
+ (when (= (point) (point-min))
+ (goto-char (point-max)))
+ (let ((pos (previous-overlay-change (point))))
+ (unless (overlays-at pos)
+ (setq pos (previous-overlay-change pos)))
+ (goto-char pos))
+ (orgpan-display-bindings-help))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mode
+
+(defconst orgpan-mode-map
+ ;; Fix-me: clean up here!
+ ;; Fix-me: viper support
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?q] 'orgpan-delete-panel)
+ (define-key map [??] 'orgpan-help)
+ ;; Copying etc
+ (define-key map [?c] 'orgpan-copy-subtree)
+ (define-key map [?x] 'orgpan-cut-subtree)
+ (define-key map [?p] 'orgpan-paste-subtree)
+ (define-key map [?z] 'undo)
+ ;; Buffers:
+ (define-key map [?b] 'orgpan-switch-buffer)
+ (define-key map [?l] 'orgpan-last-buffer)
+ ;; Some keys for moving between headings. Emacs keys for next/prev
+ ;; line seems ok:
+ (define-key map [(control ?p)] 'outline-previous-visible-heading)
+ (define-key map [(control ?n)] 'outline-next-visible-heading)
+ (define-key map [(shift control ?p)] 'outline-backward-same-level)
+ (define-key map [(shift control ?n)] 'outline-forward-same-level)
+ ;; A mnemunic for up:
+ (define-key map [(control ?u)] 'outline-up-heading)
+ ;; Search sparse tree:
+ ;;
+ ;; Fix-me: Search does not work, some problem with
+ ;; interactive. Probably have to turn the whole thing around and
+ ;; always be in the org buffer, but with a minor mode running
+ ;; there.
+ ;;
+ ;;(define-key map [?s] 'org-sparse-tree)
+ (define-key map [?s] 'orgpan-occur)
+ ;; Same as in org-mode:
+ ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
+ ;; Fix-me: This leads to strange problems:
+ ;;(define-key map [t] 'ignore)
+ map))
+
+(defun orgpan-occur ()
+ "Replacement for `org-occur'.
+Technical reasons."
+ (interactive)
+ (let ((rgx (read-from-minibuffer "my mini Regexp: ")))
+ (setq orgpan-last-command-was-from-panel t)
+ (select-window orgpan-org-window)
+ (org-occur rgx)))
+
+(defvar orgpan-panel-window nil
+ "The window showing `orgpan-panel-buffer'.")
+
+(defvar orgpan-panel-buffer nil
+ "The panel buffer.
+There can be only one such buffer at any time.")
+
+(defvar orgpan-org-window nil)
+;;(make-variable-buffer-local 'orgpan-org-window)
+
+;; Fix-me: used?
+(defvar orgpan-org-buffer nil)
+;;(make-variable-buffer-local 'orgpan-org-buffer)
+
+(defvar orgpan-last-org-buffer nil)
+;;(make-variable-buffer-local 'orgpan-last-org-buffer)
+
+(defvar orgpan-point nil)
+;;(make-variable-buffer-local 'orgpan-point)
+
+(defun orgpan-avoid-viper-in-buffer ()
+ ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
+ (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
+ (set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
+ (local-set-key [?\ ] 'ignore))
+
+(define-derived-mode orgpan-mode nil "Org-Panel"
+ "Mode for org-simple.el control panel."
+ (setq buffer-read-only t)
+ (unless orgpan-minor-mode-version
+ (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
+ (add-hook 'post-command-hook 'orgpan-mode-post-command t))
+ (orgpan-avoid-viper-in-buffer)
+ (setq cursor-type nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Panel layout
+
+(defun orgpan-insert-field (text keymap explain)
+ (insert text)
+ (let* ((end (point))
+ (len (length text))
+ (beg (- end len))
+ (ovl (make-overlay beg end)))
+ (overlay-put ovl 'face orgpan-field-face)
+ (overlay-put ovl 'keymap keymap)
+ (overlay-put ovl 'orgpan-explain explain)))
+
+(defconst orgpan-with-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map org-mode-map)
+ ;; Users are used to tabbing between fields:
+ (define-key map [(tab)] 'orgpan-forward-field)
+ (define-key map [(shift tab)] 'orgpan-backward-field)
+ ;; Now we must use something else for visibility (first does not work if Viper):
+ (define-key map [(meta tab)] 'org-cycle)
+ (define-key map [(control meta tab)] 'org-global-cycle)
+ map))
+
+(defconst orgpan-without-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map org-mode-map)
+ ;; Visibility (those are in org-mode-map):
+ ;;(define-key map [tab] 'org-cycle)
+ ;;(define-key map [(shift tab)] 'org-global-cycle)
+ ;; Navigate:
+ (define-key map [left] 'outline-up-heading)
+ (define-key map [right] 'org-cycle)
+ (define-key map [up] 'outline-previous-visible-heading)
+ (define-key map [down] 'outline-next-visible-heading)
+ (define-key map [(shift down)] 'outline-forward-same-level)
+ (define-key map [(shift up)] 'outline-backward-same-level)
+ ;; Restructure:
+ (define-key map [(control up)] 'org-move-subtree-up)
+ (define-key map [(control down)] 'org-move-subtree-down)
+ (define-key map [(control left)] 'org-do-promote)
+ (define-key map [(control right)] 'org-do-demote)
+ (define-key map [(control shift left)] 'org-promote-subtree)
+ (define-key map [(control shift right)] 'org-demote-subtree)
+ ;; Todo etc
+ (define-key map [?+] 'org-priority-up)
+ (define-key map [?-] 'org-priority-down)
+ (define-key map [?t] 'org-todo)
+ map))
+
+(defun orgpan-make-panel-without-buttons (buf)
+ (with-current-buffer buf
+ (insert (propertize "Org Panel" 'face 'orgpan-active-field))
+ (insert " ? for help, q quit\n")
+ (insert (propertize "arrows" 'face 'font-lock-keyword-face)
+ ": Go to, "
+ (propertize "C-arrows" 'face 'font-lock-keyword-face)
+ ": Edit tree\n"
+ (propertize "cxpz" 'face 'font-lock-keyword-face)
+ ": copy cut paste undo, "
+ (propertize "tT+-" 'face 'font-lock-keyword-face)
+ ": todo priority, "
+ (propertize "s" 'face 'font-lock-keyword-face)
+ " search"
+ )
+ (set-keymap-parent orgpan-mode-map orgpan-without-keymap)
+ ))
+
+(defun orgpan-make-panel-with-buttons (buf)
+ (with-current-buffer buf
+ (let* ((base-map (make-sparse-keymap))
+ (space-line (propertize "\n\n" 'face 'orgpan-spaceline))
+ (arrow-face 'font-lock-keyword-face)
+ (L (propertize "left" 'face arrow-face))
+ (R (propertize "right" 'face arrow-face))
+ (U (propertize "up" 'face arrow-face))
+ (D (propertize "down" 'face arrow-face)))
+ ;;(message D)(sit-for 2)
+ (define-key base-map [left] 'ignore)
+ (define-key base-map [right] 'ignore)
+ (define-key base-map [up] 'ignore)
+ (define-key base-map [down] 'ignore)
+ (define-key base-map [?q] 'delete-window)
+ (define-key base-map [??] 'orgpan-help)
+ ;; Navigating
+ (let ((map (copy-keymap base-map)))
+ (define-key map [left] 'outline-up-heading)
+ (define-key map [right] 'org-cycle)
+ (define-key map [up] 'outline-previous-visible-heading)
+ (define-key map [down] 'outline-next-visible-heading)
+ (define-key map [(shift down)] 'outline-forward-same-level)
+ (define-key map [(shift up)] 'outline-backward-same-level)
+ (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility")))
+ (insert " ")
+ (let ((map (copy-keymap base-map)))
+ (define-key map [up] 'org-move-subtree-up)
+ (define-key map [down] 'org-move-subtree-down)
+ (define-key map [left] 'org-do-promote)
+ (define-key map [right] 'org-do-demote)
+ (define-key map [(shift left)] 'org-promote-subtree)
+ (define-key map [(shift right)] 'org-demote-subtree)
+ (orgpan-insert-field
+ "Restructure" map
+ (concat U "/" D ": "
+ (propertize "Move" 'face 'font-lock-warning-face)
+ ", " L "/" R ": "
+ (propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face))))
+ (insert " ")
+ (let ((map (copy-keymap base-map)))
+ (define-key map [up] 'org-priority-up)
+ (define-key map [down] 'org-priority-down)
+ (define-key map [right] 'org-todo)
+ (orgpan-insert-field "TODO/priority" map
+ (concat R ": TODO, " U "/" D ": Priority")))
+ )
+ (insert " ? for help, q quit\n")
+ (orgpan-display-bindings-help)
+ (setq orgpan-ovl-help (make-overlay (point) (point)))
+ ))
+
+(defun orgpan-make-panel-buffer ()
+ "Make the panel buffer."
+ (let* ((buf-name "*Org Panel*"))
+ (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
+ (setq orgpan-panel-buffer (get-buffer-create buf-name))
+ (if orgpan-panel-buttons
+ (orgpan-make-panel-with-buttons orgpan-panel-buffer)
+ (orgpan-make-panel-without-buttons orgpan-panel-buffer))
+ (with-current-buffer orgpan-panel-buffer
+ (orgpan-mode)
+ (goto-char (point-min)))
+ orgpan-panel-buffer))
+
+(defun orgpan-help ()
+ (interactive)
+ (set-keymap-parent orgpan-with-keymap nil)
+ (set-keymap-parent orgpan-without-keymap nil)
+ (describe-function 'orgpan-panel)
+ (set-keymap-parent orgpan-with-keymap org-mode-map)
+ (set-keymap-parent orgpan-without-keymap org-mode-map)
+ (message "Use 'l' to remove help window")
+ )
+
+(defun orgpan-panel ()
+ "Create a control panel for current `org-mode' buffer.
+The control panel may be used to quickly move around and change
+the headings. The idea is that when you want to to a lot of this
+kind of editing you should be able to do that with few
+keystrokes (and without having to remember the complicated
+keystrokes). A typical situation when this perhaps can be useful
+is when you are looking at your notes file \(usually ~/.notes,
+see `remember-data-file') where you have saved quick notes with
+`remember'.
+
+The keys below are defined in the panel. Note that the commands
+are carried out in the `org-mode' buffer that belongs to the
+panel.
+
+\\{orgpan-mode-map}
+
+In addition to the keys above most of the keys in `org-mode' can
+also be used from the panel.
+
+Note: There are two forms of the control panel, one with buttons
+and one without. The default is without, see
+`orgpan-panel-buttons'. If buttons are used choosing a different
+button changes the binding of the arrow keys."
+ (interactive)
+ (unless (derived-mode-p 'org-mode)
+ (error "Buffer is not in org-mode"))
+ (orgpan-delete-panel)
+ (unless orgpan-org-mode-commands
+ (map-keymap (lambda (ev def)
+ (when (and def
+ (symbolp def)
+ (fboundp def))
+ (setq orgpan-org-mode-commands
+ (cons def orgpan-org-mode-commands))))
+ org-mode-map))
+ ;;(org-back-to-heading)
+ ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
+ (split-window)
+ (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
+ (setq orgpan-panel-window (selected-window))
+ ;;(set-window-dedicated-p (selected-window) t)
+ (fit-window-to-buffer nil nil 3)
+ (setq orgpan-org-window (next-window))
+ ;; The minor mode version starts here:
+ (when orgpan-minor-mode-version
+ (select-window orgpan-org-window)
+ (orgpan-panel-minor-mode 1)
+ (add-hook 'post-command-hook 'orgpan-minor-post-command t)))
+
+(defun orgpan-minor-post-command ()
+ (unless (and
+ ;; Check org window and buffer
+ (windowp orgpan-org-window)
+ (window-live-p orgpan-org-window)
+ (eq orgpan-org-window (selected-window))
+ (derived-mode-p 'org-mode)
+ ;; Check panel window and buffer
+ (windowp orgpan-panel-window)
+ (window-live-p orgpan-panel-window)
+ (bufferp orgpan-panel-buffer)
+ (buffer-live-p orgpan-panel-buffer)
+ (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
+ ;; Check minor mode
+ orgpan-panel-minor-mode)
+ (orgpan-delete-panel)))
+
+(define-minor-mode orgpan-panel-minor-mode
+ "Minor mode used in `org-mode' buffer when showing panel."
+ :keymap orgpan-mode-map
+ :lighter " PANEL"
+ :group 'orgpan
+ )
+
+
+(provide 'org-panel)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; org-panel.el ends here
diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-registry.el
new file mode 100644
index 0000000..c1a1c6c
--- /dev/null
+++ b/contrib/lisp/org-registry.el
@@ -0,0 +1,271 @@
+;;; org-registry.el --- a registry for Org links
+;;
+;; Copyright 2007-2012 Bastien Guerry
+;;
+;; Emacs Lisp Archive Entry
+;; Filename: org-registry.el
+;; Version: 0.1a
+;; Author: Bastien Guerry <bzg AT gnu DOT org>
+;; Maintainer: Bastien Guerry <bzg AT gnu DOT org>
+;; Keywords: org, wp, registry
+;; Description: Shows Org files where the current buffer is linked
+;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, 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 library add a registry to your Org setup.
+;;
+;; Org files are full of links inserted with `org-store-link'. This links
+;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
+;; Actually, they come from potentially *everywhere* since Org lets you
+;; define your own storing/following functions.
+;;
+;; So, what if you are on a e-mail, webpage or whatever and want to know if
+;; this buffer has already been linked to somewhere in your agenda files?
+;;
+;; This is were org-registry comes in handy.
+;;
+;; M-x org-registry-show will tell you the name of the file
+;; C-u M-x org-registry-show will directly jump to the file
+;;
+;; In case there are several files where the link lives in:
+;;
+;; M-x org-registry-show will display them in a new window
+;; C-u M-x org-registry-show will prompt for a file to visit
+;;
+;; Add this to your Org configuration:
+;;
+;; (require 'org-registry)
+;; (org-registry-initialize)
+;;
+;; If you want to update the registry with newly inserted links in the
+;; current buffer: M-x org-registry-update
+;;
+;; If you want this job to be done each time you save an Org buffer,
+;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
+;;
+;; (org-registry-insinuate)
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-registry nil
+ "A registry for Org."
+ :group 'org)
+
+(defcustom org-registry-file
+ (concat (getenv "HOME") "/.org-registry.el")
+ "The Org registry file."
+ :group 'org-registry
+ :type 'file)
+
+(defcustom org-registry-find-file 'find-file-other-window
+ "How to find visit files."
+ :type 'function
+ :group 'org-registry)
+
+(defvar org-registry-alist nil
+ "An alist containing the Org registry.")
+
+;;;###autoload
+(defun org-registry-show (&optional visit)
+ "Show Org files where there are links pointing to the current
+buffer."
+ (interactive "P")
+ (org-registry-initialize)
+ (let* ((blink (or (org-remember-annotation) ""))
+ (link (when (string-match org-bracket-link-regexp blink)
+ (match-string-no-properties 1 blink)))
+ (desc (or (and (string-match org-bracket-link-regexp blink)
+ (match-string-no-properties 3 blink)) "No description"))
+ (files (org-registry-assoc-all link))
+ file point selection tmphist)
+ (cond ((and files visit)
+ ;; result(s) to visit
+ (cond ((< 1 (length files))
+ ;; more than one result
+ (setq tmphist (mapcar (lambda(entry)
+ (format "%s (%d) [%s]"
+ (nth 3 entry) ; file
+ (nth 2 entry) ; point
+ (nth 1 entry))) files))
+ (setq selection (completing-read "File: " tmphist
+ nil t nil 'tmphist))
+ (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
+ (setq file (match-string 1 selection))
+ (setq point (string-to-number (match-string 2 selection))))
+ ((eq 1 (length files))
+ ;; just one result
+ (setq file (nth 3 (car files)))
+ (setq point (nth 2 (car files)))))
+ ;; visit the (selected) file
+ (funcall org-registry-find-file file)
+ (goto-char point)
+ (unless (org-before-first-heading-p)
+ (org-show-context)))
+ ((and files (not visit))
+ ;; result(s) to display
+ (cond ((eq 1 (length files))
+ ;; show one file
+ (message "Link in file %s (%d) [%s]"
+ (nth 3 (car files))
+ (nth 2 (car files))
+ (nth 1 (car files))))
+ (t (org-registry-display-files files link))))
+ (t (message "No link to this in org-agenda-files")))))
+
+(defun org-registry-display-files (files link)
+ "Display files in a separate window."
+ (switch-to-buffer-other-window
+ (get-buffer-create " *Org registry info*"))
+ (erase-buffer)
+ (insert (format "Files pointing to %s:\n\n" link))
+ (let (file)
+ (while (setq file (pop files))
+ (insert (format "%s (%d) [%s]\n" (nth 3 file)
+ (nth 2 file) (nth 1 file)))))
+ (shrink-window-if-larger-than-buffer)
+ (other-window 1))
+
+(defun org-registry-assoc-all (link &optional registry)
+ "Return all associated entries of LINK in the registry."
+ (org-registry-find-all
+ (lambda (entry) (string= link (car entry)))
+ registry))
+
+(defun org-registry-find-all (test &optional registry)
+ "Return all entries satisfying `test' in the registry."
+ (delq nil
+ (mapcar
+ (lambda (x) (and (funcall test x) x))
+ (or registry org-registry-alist))))
+
+;;;###autoload
+(defun org-registry-visit ()
+ "If an Org file contains a link to the current location, visit
+this file."
+ (interactive)
+ (org-registry-show t))
+
+;;;###autoload
+(defun org-registry-initialize (&optional from-scratch)
+ "Initialize `org-registry-alist'.
+If FROM-SCRATCH is non-nil or the registry does not exist yet,
+create a new registry from scratch and eval it. If the registry
+exists, eval `org-registry-file' and make it the new value for
+`org-registry-alist'."
+ (interactive "P")
+ (if (or from-scratch (not (file-exists-p org-registry-file)))
+ ;; create a new registry
+ (let ((files org-agenda-files) file)
+ (while (setq file (pop files))
+ (setq file (expand-file-name file))
+ (mapc (lambda (entry)
+ (add-to-list 'org-registry-alist entry))
+ (org-registry-get-entries file)))
+ (when from-scratch
+ (org-registry-create org-registry-alist)))
+ ;; eval the registry file
+ (with-temp-buffer
+ (insert-file-contents org-registry-file)
+ (eval-buffer))))
+
+;;;###autoload
+(defun org-registry-insinuate ()
+ "Call `org-registry-update' after saving in Org-mode.
+Use with caution. This could slow down things a bit."
+ (interactive)
+ (add-hook 'org-mode-hook
+ (lambda() (add-hook 'after-save-hook
+ 'org-registry-update t t))))
+
+(defun org-registry-get-entries (file)
+ "List Org links in FILE that will be put in the registry."
+ (let (bufstr result)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward org-angle-link-re nil t)
+ (let* ((point (match-beginning 0))
+ (link (match-string-no-properties 0))
+ (desc (match-string-no-properties 0)))
+ (add-to-list 'result (list link desc point file))))
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (let* ((point (match-beginning 0))
+ (link (match-string-no-properties 1))
+ (desc (or (match-string-no-properties 3) "No description")))
+ (add-to-list 'result (list link desc point file)))))
+ ;; return the list of new entries
+ result))
+
+;;;###autoload
+(defun org-registry-update ()
+ "Update the registry for the current Org file."
+ (interactive)
+ (unless (eq major-mode 'org-mode) (error "Not in org-mode"))
+ (let* ((from-file (expand-file-name (buffer-file-name)))
+ (new-entries (org-registry-get-entries from-file)))
+ (with-temp-buffer
+ (unless (file-exists-p org-registry-file)
+ (org-registry-initialize t))
+ (find-file org-registry-file)
+ (goto-char (point-min))
+ (while (re-search-forward (concat from-file "\")$") nil t)
+ (let ((end (1+ (match-end 0)))
+ (beg (progn (re-search-backward "^(\"" nil t)
+ (match-beginning 0))))
+ (delete-region beg end)))
+ (goto-char (point-min))
+ (re-search-forward "^(\"" nil t)
+ (goto-char (match-beginning 0))
+ (mapc (lambda (elem)
+ (insert (with-output-to-string (prin1 elem)) "\n"))
+ new-entries)
+ (save-buffer)
+ (kill-buffer (current-buffer)))
+ (message (format "Org registry updated for %s"
+ (file-name-nondirectory from-file)))))
+
+(defun org-registry-create (entries)
+ "Create `org-registry-file' with ENTRIES."
+ (let (entry)
+ (with-temp-buffer
+ (find-file org-registry-file)
+ (erase-buffer)
+ (insert
+ (with-output-to-string
+ (princ ";; -*- emacs-lisp -*-\n")
+ (princ ";; Org registry\n")
+ (princ ";; You shouldn't try to modify this buffer manually\n\n")
+ (princ "(setq org-registry-alist\n'(\n")
+ (while entries
+ (when (setq entry (pop entries))
+ (prin1 entry)
+ (princ "\n")))
+ (princ "))\n")))
+ (save-buffer)
+ (kill-buffer (current-buffer))))
+ (message "Org registry created"))
+
+(provide 'org-registry)
+
+;;; User Options, Variables
+
+;;; org-registry.el ends here
diff --git a/contrib/lisp/org-screen.el b/contrib/lisp/org-screen.el
new file mode 100644
index 0000000..a517b4b
--- /dev/null
+++ b/contrib/lisp/org-screen.el
@@ -0,0 +1,108 @@
+;;; org-screen.el --- Integreate Org-mode with screen.
+
+;; Copyright (c) 2008-2012 Andrew Hyatt
+;;
+;; Author: Andrew Hyatt <ahyatt at gmail dot com>
+;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
+;;
+;; This file is not yet 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, 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; 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 contains functionality to integrate screen and org-mode.
+;; When using org-mode, it is often useful to take tasks that have
+;; some command-line work associated with them, and associate them
+;; with a screen session. Screen is used rather than a direct
+;; terminal to facilitate portability of the resulting session.
+;;
+;; To use screen in org, in your .emacs file, simply put this file in
+;; a directory in your load-path and write:
+;;
+;; (require 'org-screen)
+;;
+;; When have a task and want to start some command-line activity
+;; associated with that task, go to the end of your item and type:
+;;
+;; M-x org-screen
+;;
+;; This will prompt you for a name of a screen session. Type in a
+;; name and it will insert a link into your org file at your current
+;; location.
+;;
+;; When you want to visit the link, go to the link and type C-c C-o to
+;; open the link.
+;;
+;; You may want to get rid of the constant queries about whether you
+;; really want to execute lisp code. Do so by adding to your .emacs:
+;;
+;; (setq org-confirm-elisp-link-function nil)
+
+(require 'term)
+(require 'org)
+
+(defcustom org-screen-program-name "/usr/bin/screen"
+ "Full location of the screen executable."
+ :group 'org-screen
+ :type 'string)
+
+(defun org-screen (name)
+ "Start a screen session with name"
+ (interactive "MScreen name: ")
+ (save-excursion
+ (org-screen-helper name "-S"))
+ (insert-string (concat "[[screen:" name "]]")))
+
+(defun org-screen-buffer-name (name)
+ "Returns the buffer name corresponding to the screen name given."
+ (concat "*screen " name "*"))
+
+(defun org-screen-helper (name arg)
+ "This method will create a screen session with a specified name
+and taking the specified screen arguments. Much of this function
+is copied from ansi-term method."
+
+ ;; Pick the name of the new buffer.
+ (let ((term-ansi-buffer-name
+ (generate-new-buffer-name
+ (org-screen-buffer-name name))))
+ (setq term-ansi-buffer-name
+ (term-ansi-make-term
+ term-ansi-buffer-name org-screen-program-name nil arg name))
+ (set-buffer term-ansi-buffer-name)
+ (term-mode)
+ (term-char-mode)
+ (term-set-escape-char ?\C-x)
+ term-ansi-buffer-name))
+
+(defun org-screen-goto (name)
+ "Open the screen with the specified name in the window"
+ (interactive "MScreen name: ")
+ (let ((screen-buffer-name (org-screen-buffer-name name)))
+ (if (member screen-buffer-name
+ (mapcar 'buffer-name (buffer-list)))
+ (org-pop-to-buffer-same-window screen-buffer-name)
+ (org-pop-to-buffer-same-window (org-screen-helper name "-dr")))))
+
+(if org-link-abbrev-alist
+ (add-to-list 'org-link-abbrev-alist
+ '("screen" . "elisp:(org-screen-goto \"%s\")"))
+ (setq org-link-abbrev-alist
+ '(("screen" . "elisp:(org-screen-goto \"%s\")"))))
+
+(provide 'org-screen)
diff --git a/contrib/lisp/org-secretary.el b/contrib/lisp/org-secretary.el
new file mode 100644
index 0000000..5db60f6
--- /dev/null
+++ b/contrib/lisp/org-secretary.el
@@ -0,0 +1,232 @@
+;;; org-secretary.el --- Team management with org-mode
+;; Copyright (C) 2010-2012 Juan Reyero
+;;
+;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
+;; Keywords: outlines, tasks, team, management
+;; Homepage: http://juanreyero.com/article/emacs/org-teams.html
+;; Version: 0.02
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; THis file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This module implements helper functions for team management. It
+;; makes it easy to keep track of the work of several people. It
+;; keeps context (with whom and where you are) and allows you to use
+;; it to metadata to your notes, and to query the tasks associated
+;; with the people you are with and the place.
+;;
+;; See http://juanreyero.com/article/emacs/org-teams.html for a full
+;; explanation and configuration instructions.
+;;
+;;; Configuration
+;;;;;;;;;;;;;;;;;
+;;
+;; In short; your todos use the TODO keyword, your team's use TASK.
+;; Your org-todo-keywords should look something like this:
+;;
+;; (setq org-todo-keywords
+;; '((sequence "TODO(t)" "|" "DONE(d)" "CANCELLED(c)")
+;; (sequence "TASK(f)" "|" "DONE(d)")
+;; (sequence "MAYBE(m)" "|" "CANCELLED(c)")))
+;;
+;; It helps to distinguish them by color, like this:
+;;
+;; (setq org-todo-keyword-faces
+;; '(("TODO" . (:foreground "DarkOrange1" :weight bold))
+;; ("MAYBE" . (:foreground "sea green"))
+;; ("DONE" . (:foreground "light sea green"))
+;; ("CANCELLED" . (:foreground "forest green"))
+;; ("TASK" . (:foreground "blue"))))
+;;
+;; If you want to keep track of stuck projects you should tag your
+;; projects with :prj:, and define:
+;;
+;; (setq org-tags-exclude-from-inheritance '("prj")
+;; org-stuck-projects '("+prj/-MAYBE-DONE"
+;; ("TODO" "TASK") ()))
+;;
+;; Define a tag that marks TASK entries as yours:
+;;
+;; (setq org-sec-me "juanre")
+;;
+;; Finally, you add the special views to your org-agenda-custom-commands:
+;;
+;; (setq org-agenda-custom-commands
+;; '(("h" "Work todos" tags-todo
+;; "-personal-doat={.+}-dowith={.+}/!-TASK"
+;; ((org-agenda-todo-ignore-scheduled t)))
+;; ("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE"
+;; ((org-agenda-todo-ignore-scheduled nil)))
+;; ("A" "Work todos with doat or dowith" tags-todo
+;; "-personal+doat={.+}|dowith={.+}/!-TASK"
+;; ((org-agenda-todo-ignore-scheduled nil)))
+;; ("j" "TODO dowith and TASK with"
+;; ((org-sec-with-view "TODO dowith")
+;; (org-sec-where-view "TODO doat")
+;; (org-sec-assigned-with-view "TASK with")
+;; (org-sec-stuck-with-view "STUCK with")))
+;; ("J" "Interactive TODO dowith and TASK with"
+;; ((org-sec-who-view "TODO dowith")))))
+;;
+;;; Usage
+;;;;;;;;;
+;;
+;; Do C-c w to say with whom you are meeting (a space-separated list
+;; of names). Maybe do also C-c W to say where you are. Then do C-c a
+;; j to see:
+;; - Todo items defined with TODO (ie, mine) in which the
+;; =dowith= property matches any of the people with me.
+;; - Todo items defined with TODO in which the =doat= property
+;; matches my current location.
+;; - Todo items defined with TASK that are tagged with the name
+;; of any of the people with me (this is, assigned to them).
+;; - Stuck projects tagged with the name of the people with me.
+;;
+;; Use C-c j to add meta-data with the people with me, the
+;; location and the time to entries.
+
+(require 'org)
+
+(defvar org-sec-me nil
+ "Tag that defines TASK todo entries associated to me")
+
+(defvar org-sec-with nil
+ "Value of the :with: property when doing an
+ org-sec-tag-entry. Change it with org-sec-set-with,
+ set to C-c w. Defaults to org-sec-me")
+
+(defvar org-sec-where ""
+ "Value of the :at: property when doing an
+ org-sec-tag-entry. Change it with org-sec-set-with,
+ set to C-c W")
+
+(defvar org-sec-with-history '()
+ "History list of :with: properties")
+
+(defvar org-sec-where-history '()
+ "History list of :where: properties")
+
+(defun org-sec-set-with ()
+ "Changes the value of the org-sec-with variable for use in the
+ next call of org-sec-tag-entry. Leave it empty to default to
+ org-sec-me (you)."
+ (interactive)
+ (setq org-sec-with (let ((w (read-string "With: " nil
+ 'org-sec-with-history "")))
+ (if (string= w "")
+ nil
+ w))))
+(global-set-key "\C-cw" 'org-sec-set-with)
+
+(defun org-sec-set-where ()
+ "Changes the value of the org-sec-where variable for use
+ in the next call of org-sec-tag-entry."
+ (interactive)
+ (setq org-sec-where
+ (read-string "Where: " nil
+ 'org-sec-where-history "")))
+(global-set-key "\C-cW" 'org-sec-set-where)
+
+(defun org-sec-set-dowith ()
+ "Sets the value of the dowith property."
+ (interactive)
+ (let ((do-with
+ (read-string "Do with: "
+ nil 'org-sec-dowith-history "")))
+ (unless (string= do-with "")
+ (org-entry-put nil "dowith" do-with))))
+(global-set-key "\C-cd" 'org-sec-set-dowith)
+
+(defun org-sec-set-doat ()
+ "Sets the value of the doat property."
+ (interactive)
+ (let ((do-at (read-string "Do at: "
+ nil 'org-sec-doat-history "")))
+ (unless (string= do-at "")
+ (org-entry-put nil "doat" do-at))))
+(global-set-key "\C-cD" 'org-sec-set-doat)
+
+(defun org-sec-tag-entry ()
+ "Adds a :with: property with the value of org-sec-with if
+ defined, an :at: property with the value of org-sec-where
+ if defined, and an :on: property with the current time."
+ (interactive)
+ (save-excursion
+ (org-entry-put nil "on" (format-time-string
+ (org-time-stamp-format 'long)
+ (current-time)))
+ (unless (string= org-sec-where "")
+ (org-entry-put nil "at" org-sec-where))
+ (if org-sec-with
+ (org-entry-put nil "with" org-sec-with))))
+(global-set-key "\C-cj" 'org-sec-tag-entry)
+
+(defun join (lst sep &optional pre post)
+ (mapconcat (function (lambda (x) (concat pre x post))) lst sep))
+
+(defun org-sec-get-with ()
+ (if org-sec-with
+ org-sec-with
+ org-sec-me))
+
+(defun org-sec-with-view (par &optional who)
+ "Select tasks marked as dowith=who, where who
+ defaults to the value of org-sec-with."
+ (org-tags-view '(4) (join (split-string (if who
+ who
+ (org-sec-get-with)))
+ "|" "dowith=\"" "\"")))
+
+(defun org-sec-where-view (par)
+ "Select tasks marked as doat=org-sec-where."
+ (org-tags-view '(4) (concat "doat={" org-sec-where "}")))
+
+(defun org-sec-assigned-with-view (par &optional who)
+ "Select tasks assigned to who, by default org-sec-with."
+ (org-tags-view '(4)
+ (concat (join (split-string (if who
+ who
+ (org-sec-get-with)))
+ "|")
+ "/TASK")))
+
+(defun org-sec-stuck-with-view (par &optional who)
+ "Select stuck projects assigned to who, by default
+ org-sec-with."
+ (let ((org-stuck-projects
+ `(,(concat "+prj+"
+ (join (split-string (if who
+ who
+ (org-sec-get-with))) "|")
+ "/-MAYBE-DONE")
+ ("TODO" "TASK") ())))
+ (org-agenda-list-stuck-projects)))
+
+(defun org-sec-who-view (par)
+ "Builds agenda for a given user. Queried. "
+ (let ((who (read-string "Build todo for user/tag: "
+ "" "" "")))
+ (org-sec-with-view "TODO dowith" who)
+ (org-sec-assigned-with-view "TASK with" who)
+ (org-sec-stuck-with-view "STUCK with" who)))
+
+(provide 'org-secretary)
+
+;;; org-secretary.el ends here
diff --git a/contrib/lisp/org-static-mathjax.el b/contrib/lisp/org-static-mathjax.el
new file mode 100644
index 0000000..29f2cfe
--- /dev/null
+++ b/contrib/lisp/org-static-mathjax.el
@@ -0,0 +1,171 @@
+;;; org-static-mathjax.el --- Muse-like tags in Org-mode
+;;
+;; Author: Jan Böker <jan dot boecker at jboecker dot de>
+
+;; This elisp code integrates Static MathJax into the
+;; HTML export process of Org-mode.
+;;
+;; The supporting files for this package are in contrib/scripts/staticmathjax
+;; Please read the README.org file in that directory for more information.
+
+;; To use it, evaluate it on startup, add the following to your .emacs:
+
+;; (require 'org-static-mathjax)
+;;
+;; You will then have to customize the following two variables:
+;; - org-static-mathjax-app-ini-path
+;; - org-static-mathjax-local-mathjax-path
+;;
+;; If xulrunner is not in your $PATH, you will also need to customize
+;; org-static-mathjax-xulrunner-path.
+;;
+;; If everything is setup correctly, you can trigger Static MathJax on
+;; export to HTML by adding the following line to your Org file:
+;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html"
+;;
+;; You can omit either argument.
+;; embed-fonts defaults to nil. If you do not specify output-file-name,
+;; the exported file is overwritten with the static version.
+;;
+;; If embed-fonts is non-nil, the fonts are embedded directly into the
+;; output file using data: URIs.
+;;
+;; output-file-name specifies the file name of the static version. You
+;; can use any arbitrary lisp form here, for example:
+;; output-file-name:(concat (file-name-sans-extension buffer-file-name) "-static.html")
+;;
+;; The StaticMathJax XULRunner application expects a UTF-8 encoded
+;; input file. If the static version displays random characters instead
+;; of your math, add the following line at the top of your Org file:
+;; -*- coding: utf-8; -*-
+;;
+;; License: GPL v2 or later
+
+(defcustom org-static-mathjax-app-ini-path
+ (or (expand-file-name
+ "../scripts/staticmatchjax/application.ini"
+ (file-name-directory (or load-file-name buffer-file-name)))
+ "")
+ "Path to \"application.ini\" of the Static MathJax XULRunner application.
+If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set
+this to ~/.local/staticmathjax/application.ini"
+ :type 'string)
+
+(defcustom org-static-mathjax-xulrunner-path
+ "xulrunner"
+ "Path to your xulrunner binary"
+ :type 'string)
+
+(defcustom org-static-mathjax-local-mathjax-path
+ ""
+ "Extract the MathJax zip file somewhere on your local
+hard drive and specify the path here.
+
+The directory has to be writeable, as org-static-mathjax
+creates a temporary file there during export."
+ :type 'string)
+
+(defvar org-static-mathjax-debug
+ nil
+ "If non-nil, org-static-mathjax will print some debug messages")
+
+(defun org-static-mathjax-hook-installer ()
+ "Installs org-static-mathjax-process in after-save-hook.
+
+Sets the following buffer-local variables for org-static-mathjax-process to pick up:
+org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML export
+org-static-mathjax-options: The string given with #+STATICMATHJAX: in the file"
+ (let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax)))
+ (if static-mathjax-option-string
+ (progn (set (make-local-variable 'org-static-mathjax-options) static-mathjax-option-string)
+ (set (make-local-variable 'org-static-mathjax-mathjax-path)
+ (nth 1 (assq 'path org-export-html-mathjax-options)))
+ (let ((mathjax-options (plist-get opt-plist :mathjax)))
+ (if mathjax-options
+ (if (string-match "\\<path:" mathjax-options)
+ (set 'org-static-mathjax-mathjax-path
+ (car (read-from-string
+ (substring mathjax-options (match-end 0))))))))
+ (add-hook 'after-save-hook
+ 'org-static-mathjax-process
+ nil t)))))
+
+
+(defun org-static-mathjax-process ()
+ (save-excursion
+ ; some sanity checking
+ (if (or (string= org-static-mathjax-app-ini-path "")
+ (not (file-exists-p org-static-mathjax-app-ini-path)))
+ (error "Static MathJax: You must customize org-static-mathjax-app-ini-path!"))
+ (if (or (string= org-static-mathjax-local-mathjax-path "")
+ (not (file-exists-p org-static-mathjax-local-mathjax-path)))
+ (error "Static MathJax: You must customize org-static-mathjax-local-mathjax-path!"))
+
+ ; define variables
+ (let* ((options org-static-mathjax-options)
+ (output-file-name buffer-file-name)
+ (input-file-name (let ((temporary-file-directory (file-name-directory org-static-mathjax-local-mathjax-path)))
+ (make-temp-file "org-static-mathjax-" nil ".html")))
+ (html-code (buffer-string))
+ (mathjax-oldpath (concat "src=\"" org-static-mathjax-mathjax-path))
+ (mathjax-newpath (concat "src=\"" org-static-mathjax-local-mathjax-path))
+ embed-fonts)
+ ; read file-local options
+ (mapc
+ (lambda (symbol)
+ (if (string-match (concat "\\<" (symbol-name symbol) ":") options)
+ (set symbol (eval (car (read-from-string
+ (substring options (match-end 0))))))))
+ '(embed-fonts output-file-name))
+
+ ; debug
+ (when org-static-mathjax-debug
+ (message "output file name, embed-fonts")
+ (print output-file-name)
+ (print embed-fonts))
+
+ ; open (temporary) input file, copy contents there, replace MathJax path with local installation
+ (with-temp-buffer
+ (insert html-code)
+ (goto-char 1)
+ (replace-regexp mathjax-oldpath mathjax-newpath)
+ (write-file input-file-name))
+
+ ; prepare argument list for call-process
+ (let ((call-process-args (list org-static-mathjax-xulrunner-path
+ nil nil nil
+ org-static-mathjax-app-ini-path
+ input-file-name
+ output-file-name)))
+ ; if fonts are embedded, just append the --embed-fonts flag
+ (if embed-fonts
+ (add-to-list 'call-process-args "--embed-fonts" t))
+ ; if fonts are not embedded, the XULRunner app must replace all references
+ ; to the font files with the real location (Firefox inserts file:// URLs there,
+ ; because we are using a local MathJax installation here)
+ (if (not embed-fonts)
+ (progn
+ (add-to-list 'call-process-args "--final-mathjax-url" t)
+ (add-to-list 'call-process-args
+ (file-name-directory org-static-mathjax-mathjax-path)
+ t)))
+
+ ; debug
+ (when org-static-mathjax-debug
+ (print call-process-args))
+ ; call it
+ (apply 'call-process call-process-args)
+ ; delete our temporary input file
+ (kill-buffer)
+ (delete-file input-file-name)
+ (let ((backup-file (concat input-file-name "~")))
+ (if (file-exists-p backup-file)
+ (delete-file backup-file)))))))
+
+(add-to-list 'org-export-inbuffer-options-extra
+'("STATICMATHJAX" :static-mathjax))
+
+(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer)
+
+
+(provide 'org-static-mathjax)
diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el
new file mode 100644
index 0000000..6977f1f
--- /dev/null
+++ b/contrib/lisp/org-sudoku.el
@@ -0,0 +1,290 @@
+;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp, games
+;; Homepage: http://orgmode.org
+;; Version: 0.01
+;;
+;; This file is not yet 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, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This is a quick hack to create and solve SUDOKU games in org tables.
+;;
+;; Commands:
+;;
+;; org-sudoku-create Create a new SUDOKU game
+;; org-sudoku-solve-field Solve the field at point in a SUDOKU game
+;; (this is for cheeting when you are stuck)
+;; org-sudoku-solve Solve the entire game
+;;
+
+;;; Code
+
+(require 'org)
+(require 'org-table)
+
+;;; Customization
+
+(defvar org-sudoku-size 9
+ "The size of the sudoku game, 9 for a 9x9 game and 4 for a 4x4 game.
+Larger games do not seem to work because of limited resources - even though
+the algorithm is general.")
+
+(defvar org-sudoku-timeout 2.0
+ "Timeout for finding a solution when creating a new game.
+After this timeout, the program starts over from scratch to create
+a game.")
+
+;;; Interactive commands
+
+(defun org-sudoku-create (nfilled)
+ "Create a sudoku game."
+ (interactive "nNumber of pre-filled fields: ")
+ (let ((sizesq org-sudoku-size)
+ game)
+ (loop for i from 1 to org-sudoku-size do
+ (loop for j from 1 to org-sudoku-size do
+ (push (list (cons i j) 0) game)))
+ (setq game (nreverse game))
+ (random t)
+ (setq game (org-sudoku-build-allowed game))
+ (setq game (org-sudoku-set-field game (cons 1 1)
+ (1+ (random org-sudoku-size))))
+ (catch 'solved
+ (let ((cnt 0))
+ (while t
+ (catch 'abort
+ (message "Attempt %d to create a game" (setq cnt (1+ cnt)))
+ (setq game1 (org-sudoku-deep-copy game))
+ (setq game1 (org-sudoku-solve-game
+ game1 'random (+ (float-time) org-sudoku-timeout)))
+ (when game1
+ (setq game game1)
+ (throw 'solved t))))))
+ (let ((sqrtsize (floor (sqrt org-sudoku-size))))
+ (loop for i from 1 to org-sudoku-size do
+ (insert "| |\n")
+ (if (and (= (mod i sqrtsize) 0) (< i org-sudoku-size))
+ (insert "|-\n")))
+ (backward-char 5)
+ (org-table-align))
+ (while (> (length game) nfilled)
+ (setq game (delete (nth (1+ (random (length game))) game) game)))
+ (mapc (lambda (e)
+ (org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
+ game)
+ (org-table-align)
+ (org-table-goto-line 1)
+ (org-table-goto-column 1)
+ (message "Enjoy!")))
+
+(defun org-sudoku-solve ()
+ "Solve the sudoku game in the table at point."
+ (interactive)
+ (unless (org-at-table-p)
+ (error "not at a table"))
+ (let (game)
+ (setq game (org-sudoku-get-game))
+ (setq game (org-sudoku-build-allowed game))
+ (setq game (org-sudoku-solve-game game))
+ ;; Insert the values
+ (mapc (lambda (e)
+ (org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
+ game)
+ (org-table-align)))
+
+(defun org-sudoku-solve-field ()
+ "Just solve the field at point.
+This works by solving the whole game, then inserting only the single field."
+ (interactive)
+ (unless (org-at-table-p)
+ (error "Not at a table"))
+ (org-table-check-inside-data-field)
+ (let ((i (org-table-current-dline))
+ (j (org-table-current-column))
+ game)
+ (setq game (org-sudoku-get-game))
+ (setq game (org-sudoku-build-allowed game))
+ (setq game (org-sudoku-solve-game game))
+ (if game
+ (progn
+ (org-table-put i j (number-to-string
+ (nth 1 (assoc (cons i j) game)))
+ 'align)
+ (org-table-goto-line i)
+ (org-table-goto-column j))
+ (error "No solution"))))
+
+;;; Internal functions
+
+(defun org-sudoku-get-game ()
+ "Interpret table at point as sudoku game and read it.
+A game structure is returned."
+ (let (b e g i j game)
+
+ (org-table-goto-line 1)
+ (org-table-goto-column 1)
+ (setq b (point))
+ (org-table-goto-line org-sudoku-size)
+ (org-table-goto-column org-sudoku-size)
+ (setq e (point))
+ (setq g (org-table-copy-region b e))
+ (setq i 0 j 0)
+ (mapc (lambda (c)
+ (setq i (1+ i) j 0)
+ (mapc
+ (lambda (v)
+ (setq j (1+ j))
+ (push (list (cons i j)
+ (string-to-number v))
+ game))
+ c))
+ g)
+ (nreverse game)))
+
+(defun org-sudoku-build-allowed (game)
+ (let (i j v numbers)
+ (loop for i from 1 to org-sudoku-size do
+ (push i numbers))
+ (setq numbers (nreverse numbers))
+ ;; add the lists of allowed values for each entry
+ (setq game (mapcar
+ (lambda (e)
+ (list (car e) (nth 1 e)
+ (if (= (nth 1 e) 0)
+ (copy-sequence numbers)
+ nil)))
+ game))
+ ;; remove the known values from the list of allowed values
+ (mapc
+ (lambda (e)
+ (setq i (caar e) j (cdar e) v (cadr e))
+ (when (> v 0)
+ ;; We do have a value here
+ (mapc
+ (lambda (f)
+ (setq a (assoc f game))
+ (setf (nth 2 a) (delete v (nth 2 a))))
+ (cons (cons i j) (org-sudoku-rel-fields i j)))))
+ game)
+ game))
+
+(defun org-sudoku-find-next-constrained-field (game)
+ (setq game (mapcar (lambda (e) (if (nth 2 e) e nil)) game))
+ (setq game (delq nil game))
+ (let (va vb la lb)
+ (setq game
+ (sort game (lambda (a b)
+ (setq va (nth 1 a) vb (nth 1 b)
+ la (length (nth 2 a)) lb (length (nth 2 b)))
+ (cond
+ ((and (= va 0) (> vb 0)) t)
+ ((and (> va 0) (= vb 0)) nil)
+ ((not (= (* va vb) 0)) nil)
+ (t (< la lb))))))
+ (if (or (not game) (> 0 (nth 1 (car game))))
+ nil
+ (caar game))))
+
+(defun org-sudoku-solve-game (game &optional random stop-at)
+ "Solve GAME.
+If RANDOM is non-nit, select candidates randomly from a fields option.
+If RANDOM is nil, always start with the first allowed value and try
+solving from there.
+STOP-AT can be a float time, the solver will abort at that time because
+it is probably stuck."
+ (let (e v v1 allowed next g)
+ (when (and stop-at
+ (> (float-time) stop-at))
+ (setq game nil)
+ (throw 'abort nil))
+ (while (setq next (org-sudoku-find-next-constrained-field game))
+ (setq e (assoc next game)
+ v (nth 1 e)
+ allowed (nth 2 e))
+ (catch 'solved
+ (if (= (length allowed) 1)
+ (setq game (org-sudoku-set-field game next (car allowed)))
+ (while allowed
+ (setq g (org-sudoku-deep-copy game))
+ (if (not random)
+ (setq v1 (car allowed))
+ (setq v1 (nth (random (length allowed)) allowed)))
+ (setq g (org-sudoku-set-field g next v1))
+ (setq g (org-sudoku-solve-game g random stop-at))
+ (when g
+ (setq game g)
+ (throw 'solved g)))
+ (setq game nil))))
+ (if (or (not game)
+ (org-sudoku-unknown-field-p game))
+ nil
+ game)))
+
+(defun org-sudoku-unknown-field-p (game)
+ "Are there still unknown fields in the game?"
+ (delq nil (mapcar (lambda (e) (if (> (nth 1 e) 0) nil t)) game)))
+
+(defun org-sudoku-deep-copy (game)
+ "Make a copy of the game so that manipulating the copy does not change the parent."
+ (mapcar (lambda(e)
+ (list (car e) (nth 1 e) (copy-sequence (nth 2 e))))
+ game))
+
+(defun org-sudoku-set-field (game field value)
+ "Put VALUE into FIELD, and tell related fields that they cannot be VALUE."
+ (let (i j)
+ (setq i (car field) j (cdr field))
+ (setq a (assoc field game))
+ (setf (nth 1 a) value)
+ (setf (nth 2 a) nil)
+
+ ;; Remove value from all related fields
+ (mapc
+ (lambda (f)
+ (setq a (assoc f game))
+ (setf (nth 2 a) (delete value (nth 2 a))))
+ (org-sudoku-rel-fields i j))
+ game))
+
+(defun org-sudoku-rel-fields (i j)
+ "Compute the list of related fields for field (i j)."
+ (let ((sqrtsize (floor (sqrt org-sudoku-size)))
+ ll imin imax jmin jmax f)
+ (setq f (cons i j))
+ (loop for ii from 1 to org-sudoku-size do
+ (or (= ii i) (push (cons ii j) ll)))
+ (loop for jj from 1 to org-sudoku-size do
+ (or (= jj j) (push (cons i jj) ll)))
+ (setq imin (1+ (* sqrtsize (/ (1- i) sqrtsize)))
+ imax (+ imin sqrtsize -1))
+ (setq jmin (1+ (* sqrtsize (/ (1- j) sqrtsize)))
+ jmax (+ jmin sqrtsize -1))
+ (loop for ii from imin to imax do
+ (loop for jj from jmin to jmax do
+ (setq ff (cons ii jj))
+ (or (equal ff f)
+ (member ff ll)
+ (push ff ll))))
+ ll))
+
+;;; org-sudoku ends here
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
new file mode 100644
index 0000000..3f37cb8
--- /dev/null
+++ b/contrib/lisp/org-toc.el
@@ -0,0 +1,488 @@
+;;; org-toc.el --- Table of contents for Org-mode buffer
+
+;; Copyright 2007-2012 Free Software Foundation, Inc.
+;;
+;; Author: Bastien Guerry <bzg AT gnu DOT org>
+;; Keywords: Org table of contents
+;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-toc.el
+;; Version: 0.8
+
+;; 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, 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 library implements a browsable table of contents for Org files.
+
+;; Put this file into your load-path and the following into your ~/.emacs:
+;; (require 'org-toc)
+
+;;; Code:
+
+(provide 'org-toc)
+(eval-when-compile
+ (require 'cl))
+
+;;; Custom variables:
+(defvar org-toc-base-buffer nil)
+(defvar org-toc-columns-shown nil)
+(defvar org-toc-odd-levels-only nil)
+(defvar org-toc-config-alist nil)
+(defvar org-toc-cycle-global-status nil)
+(defalias 'org-show-table-of-contents 'org-toc-show)
+
+(defgroup org-toc nil
+ "Options concerning the browsable table of contents of Org-mode."
+ :tag "Org TOC"
+ :group 'org)
+
+(defcustom org-toc-default-depth 1
+ "Default depth when invoking `org-toc-show' without argument."
+ :group 'org-toc
+ :type '(choice
+ (const :tag "same as base buffer" nil)
+ (integer :tag "level")))
+
+(defcustom org-toc-follow-mode nil
+ "Non-nil means navigating through the table of contents will
+move the point in the Org buffer accordingly."
+ :group 'org-toc
+ :type 'boolean)
+
+(defcustom org-toc-info-mode nil
+ "Non-nil means navigating through the table of contents will
+show the properties for the current headline in the echo-area."
+ :group 'org-toc
+ :type 'boolean)
+
+(defcustom org-toc-show-subtree-mode nil
+ "Non-nil means show subtree when going to headline or following
+it while browsing the table of contents."
+ :group 'org-toc
+ :type '(choice
+ (const :tag "show subtree" t)
+ (const :tag "show entry" nil)))
+
+(defcustom org-toc-recenter-mode t
+ "Non-nil means recenter the Org buffer when following the
+headlines in the TOC buffer."
+ :group 'org-toc
+ :type 'boolean)
+
+(defcustom org-toc-recenter 0
+ "Where to recenter the Org buffer when unfolding a subtree.
+This variable is only used when `org-toc-recenter-mode' is set to
+'custom. A value >=1000 will call recenter with no arg."
+ :group 'org-toc
+ :type 'integer)
+
+(defcustom org-toc-info-exclude '("ALLTAGS")
+ "A list of excluded properties when displaying info in the
+echo-area. The COLUMNS property is always exluded."
+ :group 'org-toc
+ :type 'lits)
+
+;;; Org TOC mode:
+(defvar org-toc-mode-map (make-sparse-keymap)
+ "Keymap for `org-toc-mode'.")
+
+(defun org-toc-mode ()
+ "A major mode for browsing the table of contents of an Org buffer.
+
+\\{org-toc-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map org-toc-mode-map)
+ (setq mode-name "Org TOC")
+ (setq major-mode 'org-toc-mode))
+
+;; toggle modes
+(define-key org-toc-mode-map "f" 'org-toc-follow-mode)
+(define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode)
+(define-key org-toc-mode-map "s" 'org-toc-store-config)
+(define-key org-toc-mode-map "g" 'org-toc-restore-config)
+(define-key org-toc-mode-map "i" 'org-toc-info-mode)
+(define-key org-toc-mode-map "r" 'org-toc-recenter-mode)
+
+;; navigation keys
+(define-key org-toc-mode-map "p" 'org-toc-previous)
+(define-key org-toc-mode-map "n" 'org-toc-next)
+(define-key org-toc-mode-map [(left)] 'org-toc-previous)
+(define-key org-toc-mode-map [(right)] 'org-toc-next)
+(define-key org-toc-mode-map [(up)] 'org-toc-previous)
+(define-key org-toc-mode-map [(down)] 'org-toc-next)
+(define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1 (point))))
+(define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2 (point))))
+(define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3 (point))))
+(define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4 (point))))
+(define-key org-toc-mode-map " " 'org-toc-goto)
+(define-key org-toc-mode-map "q" 'org-toc-quit)
+(define-key org-toc-mode-map "x" 'org-toc-quit)
+;; go to the location and stay in the base buffer
+(define-key org-toc-mode-map [(tab)] 'org-toc-jump)
+(define-key org-toc-mode-map "v" 'org-toc-jump)
+;; go to the location and delete other windows
+(define-key org-toc-mode-map [(return)]
+ (lambda() (interactive) (org-toc-jump t)))
+
+;; special keys
+(define-key org-toc-mode-map "c" 'org-toc-columns)
+(define-key org-toc-mode-map "?" 'org-toc-help)
+(define-key org-toc-mode-map ":" 'org-toc-cycle-subtree)
+(define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point)
+;; global cycling in the base buffer
+(define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>")
+ 'org-toc-cycle-base-buffer)
+;; subtree cycling in the base buffer
+(define-key org-toc-mode-map [(control tab)]
+ (lambda() (interactive) (org-toc-goto nil t)))
+
+;;; Toggle functions:
+(defun org-toc-follow-mode ()
+ "Toggle follow mode in a `org-toc-mode' buffer."
+ (interactive)
+ (setq org-toc-follow-mode (not org-toc-follow-mode))
+ (message "Follow mode is %s"
+ (if org-toc-follow-mode "on" "off")))
+
+(defun org-toc-info-mode ()
+ "Toggle info mode in a `org-toc-mode' buffer."
+ (interactive)
+ (setq org-toc-info-mode (not org-toc-info-mode))
+ (message "Info mode is %s"
+ (if org-toc-info-mode "on" "off")))
+
+(defun org-toc-show-subtree-mode ()
+ "Toggle show subtree mode in a `org-toc-mode' buffer."
+ (interactive)
+ (setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode))
+ (message "Show subtree mode is %s"
+ (if org-toc-show-subtree-mode "on" "off")))
+
+(defun org-toc-recenter-mode (&optional line)
+ "Toggle recenter mode in a `org-toc-mode' buffer. If LINE is
+specified, then make `org-toc-recenter' use this value."
+ (interactive "P")
+ (setq org-toc-recenter-mode (not org-toc-recenter-mode))
+ (when (numberp line)
+ (setq org-toc-recenter-mode t)
+ (setq org-toc-recenter line))
+ (message "Recenter mode is %s"
+ (if org-toc-recenter-mode
+ (format "on, line %d" org-toc-recenter) "off")))
+
+(defun org-toc-cycle-subtree ()
+ "Locally cycle a headline through two states: 'children and
+'folded"
+ (interactive)
+ (let ((beg (point))
+ (end (save-excursion (end-of-line) (point)))
+ (ov (car (overlays-at (point))))
+ status)
+ (if ov (setq status (overlay-get ov 'status))
+ (setq ov (make-overlay beg end)))
+ ;; change the folding status of this headline
+ (cond ((or (null status) (eq status 'folded))
+ (show-children)
+ (message "CHILDREN")
+ (overlay-put ov 'status 'children))
+ ((eq status 'children)
+ (show-branches)
+ (message "BRANCHES")
+ (overlay-put ov 'status 'branches))
+ (t (hide-subtree)
+ (message "FOLDED")
+ (overlay-put ov 'status 'folded)))))
+
+;;; Main show function:
+;; FIXME name this org-before-first-heading-p?
+(defun org-toc-before-first-heading-p ()
+ "Before first heading?"
+ (save-excursion
+ (null (re-search-backward org-outline-regexp-bol nil t))))
+
+;;;###autoload
+(defun org-toc-show (&optional depth position)
+ "Show the table of contents of the current Org-mode buffer."
+ (interactive "P")
+ (if (eq major-mode 'org-mode)
+ (progn (setq org-toc-base-buffer (current-buffer))
+ (setq org-toc-odd-levels-only org-odd-levels-only))
+ (if (eq major-mode 'org-toc-mode)
+ (org-pop-to-buffer-same-window org-toc-base-buffer)
+ (error "Not in an Org buffer")))
+ ;; create the new window display
+ (let ((pos (or position
+ (save-excursion
+ (if (org-toc-before-first-heading-p)
+ (progn (re-search-forward org-outline-regexp-bol nil t)
+ (match-beginning 0))
+ (point))))))
+ (setq org-toc-cycle-global-status org-cycle-global-status)
+ (delete-other-windows)
+ (and (get-buffer "*org-toc*") (kill-buffer "*org-toc*"))
+ (switch-to-buffer-other-window
+ (make-indirect-buffer org-toc-base-buffer "*org-toc*"))
+ ;; make content before 1st headline invisible
+ (goto-char (point-min))
+ (let* ((beg (point-min))
+ (end (and (re-search-forward "^\\*" nil t)
+ (1- (match-beginning 0))))
+ (ov (make-overlay beg end))
+ (help (format "Table of contents for %s (press ? for a quick help):\n"
+ (buffer-name org-toc-base-buffer))))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'before-string help))
+ ;; build the browsable TOC
+ (cond (depth
+ (let* ((dpth (if org-toc-odd-levels-only
+ (1- (* depth 2)) depth)))
+ (org-content dpth)
+ (setq org-toc-cycle-global-status
+ `(org-content ,dpth))))
+ ((null org-toc-default-depth)
+ (if (eq org-toc-cycle-global-status 'overview)
+ (progn (org-overview)
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview))
+ (progn (org-overview)
+ ;; FIXME org-content to show only headlines?
+ (org-content)
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents))))
+ (t (let* ((dpth0 org-toc-default-depth)
+ (dpth (if org-toc-odd-levels-only
+ (1- (* dpth0 2)) dpth0)))
+ (org-content dpth)
+ (setq org-toc-cycle-global-status
+ `(org-content ,dpth)))))
+ (goto-char pos))
+ (move-beginning-of-line nil)
+ (org-toc-mode)
+ (shrink-window-if-larger-than-buffer)
+ (setq buffer-read-only t))
+
+;;; Navigation functions:
+(defun org-toc-goto (&optional jump cycle)
+ "From Org TOC buffer, follow the targeted subtree in the Org window.
+If JUMP is non-nil, go to the base buffer.
+If JUMP is 'delete, go to the base buffer and delete other windows.
+If CYCLE is non-nil, cycle the targeted subtree in the Org window."
+ (interactive)
+ (let ((pos (point))
+ (toc-buf (current-buffer)))
+ (switch-to-buffer-other-window org-toc-base-buffer)
+ (goto-char pos)
+ (if cycle (org-cycle)
+ (progn (org-overview)
+ (if org-toc-show-subtree-mode
+ (org-show-subtree)
+ (org-show-entry))
+ (org-show-context)))
+ (if org-toc-recenter-mode
+ (if (>= org-toc-recenter 1000) (recenter)
+ (recenter org-toc-recenter)))
+ (cond ((null jump)
+ (switch-to-buffer-other-window toc-buf))
+ ((eq jump 'delete)
+ (delete-other-windows)))))
+
+(defun org-toc-cycle-base-buffer ()
+ "Call `org-cycle' with a prefix argument in the base buffer."
+ (interactive)
+ (switch-to-buffer-other-window org-toc-base-buffer)
+ (org-cycle t)
+ (other-window 1))
+
+(defun org-toc-jump (&optional delete)
+ "From Org TOC buffer, jump to the targeted subtree in the Org window.
+If DELETE is non-nil, delete other windows when in the Org buffer."
+ (interactive "P")
+ (if delete (org-toc-goto 'delete)
+ (org-toc-goto t)))
+
+(defun org-toc-previous ()
+ "Go to the previous headline of the TOC."
+ (interactive)
+ (if (save-excursion
+ (beginning-of-line)
+ (re-search-backward "^\\*" nil t))
+ (outline-previous-visible-heading 1)
+ (message "No previous heading"))
+ (if org-toc-info-mode (org-toc-info))
+ (if org-toc-follow-mode (org-toc-goto)))
+
+(defun org-toc-next ()
+ "Go to the next headline of the TOC."
+ (interactive)
+ (outline-next-visible-heading 1)
+ (if org-toc-info-mode (org-toc-info))
+ (if org-toc-follow-mode (org-toc-goto)))
+
+(defun org-toc-quit ()
+ "Quit the current Org TOC buffer."
+ (interactive)
+ (kill-this-buffer)
+ (other-window 1)
+ (delete-other-windows))
+
+;;; Special functions:
+(defun org-toc-columns ()
+ "Toggle columns view in the Org buffer from Org TOC."
+ (interactive)
+ (let ((indirect-buffer (current-buffer)))
+ (org-pop-to-buffer-same-window org-toc-base-buffer)
+ (if (not org-toc-columns-shown)
+ (progn (org-columns)
+ (setq org-toc-columns-shown t))
+ (progn (org-columns-remove-overlays)
+ (setq org-toc-columns-shown nil)))
+ (org-pop-to-buffer-same-window indirect-buffer)))
+
+(defun org-toc-info ()
+ "Show properties of current subtree in the echo-area."
+ (interactive)
+ (let ((pos (point))
+ (indirect-buffer (current-buffer))
+ props prop msg)
+ (org-pop-to-buffer-same-window org-toc-base-buffer)
+ (goto-char pos)
+ (setq props (org-entry-properties))
+ (while (setq prop (pop props))
+ (unless (or (equal (car prop) "COLUMNS")
+ (member (car prop) org-toc-info-exclude))
+ (let ((p (car prop))
+ (v (cdr prop)))
+ (if (equal p "TAGS")
+ (setq v (mapconcat 'identity (split-string v ":" t) " ")))
+ (setq p (concat p ":"))
+ (add-text-properties 0 (length p) '(face org-special-keyword) p)
+ (setq msg (concat msg p " " v " ")))))
+ (org-pop-to-buffer-same-window indirect-buffer)
+ (message msg)))
+
+;;; Store and restore TOC configuration:
+(defun org-toc-store-config ()
+ "Store the current status of the tables of contents in
+`org-toc-config-alist'."
+ (interactive)
+ (let ((file (buffer-file-name org-toc-base-buffer))
+ (pos (point))
+ (hlcfg (org-toc-get-headlines-status)))
+ (setq org-toc-config-alist
+ (delete (assoc file org-toc-config-alist)
+ org-toc-config-alist))
+ (add-to-list 'org-toc-config-alist
+ `(,file ,pos ,org-toc-cycle-global-status ,hlcfg))
+ (message "TOC configuration saved: (%s)"
+ (if (listp org-toc-cycle-global-status)
+ (concat "org-content "
+ (number-to-string
+ (cadr org-toc-cycle-global-status)))
+ (symbol-name org-toc-cycle-global-status)))))
+
+(defun org-toc-restore-config ()
+ "Get the stored status in `org-toc-config-alist' and set the
+current table of contents to it."
+ (interactive)
+ (let* ((file (buffer-file-name org-toc-base-buffer))
+ (conf (cdr (assoc file org-toc-config-alist)))
+ (pos (car conf))
+ (status (cadr conf))
+ (hlcfg (caddr conf)) hlcfg0 ov)
+ (cond ((listp status)
+ (org-toc-show (cadr status) (point)))
+ ((eq status 'overview)
+ (org-overview)
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview))
+ (t
+ (org-overview)
+ (org-content)
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents)))
+ (while (setq hlcfg0 (pop hlcfg))
+ (save-excursion
+ (goto-char (point-min))
+ (when (search-forward (car hlcfg0) nil t)
+ (unless (overlays-at (match-beginning 0))
+ (setq ov (make-overlay (match-beginning 0)
+ (match-end 0))))
+ (cond ((eq (cdr hlcfg0) 'children)
+ (show-children)
+ (message "CHILDREN")
+ (overlay-put ov 'status 'children))
+ ((eq (cdr hlcfg0) 'branches)
+ (show-branches)
+ (message "BRANCHES")
+ (overlay-put ov 'status 'branches))))))
+ (goto-char pos)
+ (if org-toc-follow-mode (org-toc-goto))
+ (message "Last TOC configuration restored")
+ (sit-for 1)
+ (if org-toc-info-mode (org-toc-info))))
+
+(defun org-toc-get-headlines-status ()
+ "Return an alist of headlines and their associated folding
+status."
+ (let (output ovs)
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (goto-char (next-overlay-change (point))))
+ (when (looking-at org-outline-regexp-bol)
+ (add-to-list
+ 'output
+ (cons (buffer-substring-no-properties
+ (match-beginning 0)
+ (save-excursion
+ (end-of-line) (point)))
+ (overlay-get
+ (car (overlays-at (point))) 'status))))))
+ ;; return an alist like (("* Headline" . 'status))
+ output))
+
+;; In Org TOC buffer, hide headlines below the first level.
+(defun org-toc-help ()
+ "Display a quick help message in the echo-area for `org-toc-mode'."
+ (interactive)
+ (let ((st-start 0)
+ (help-message
+ "\[space\] show heading \[1-4\] hide headlines below this level
+\[TAB\] jump to heading \[f\] toggle follow mode (currently %s)
+\[return\] jump and delete others windows \[i\] toggle info mode (currently %s)
+\[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s)
+\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s)
+\[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s)
+\[n/p\] next/previous heading \[s\] save TOC configuration
+\[q\] quit the TOC \[g\] restore last TOC configuration"))
+ (while (string-match "\\[[^]]+\\]" help-message st-start)
+ (add-text-properties (match-beginning 0)
+ (match-end 0) '(face bold) help-message)
+ (setq st-start (match-end 0)))
+ (message help-message
+ (if org-toc-follow-mode "on" "off")
+ (if org-toc-info-mode "on" "off")
+ (if org-toc-show-subtree-mode "on" "off")
+ (if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off")
+ (if org-toc-columns-shown "on" "off"))))
+
+
+;;;;##########################################################################
+;;;; User Options, Variables
+;;;;##########################################################################
+
+;;; org-toc.el ends here
diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el
new file mode 100644
index 0000000..1d12862
--- /dev/null
+++ b/contrib/lisp/org-track.el
@@ -0,0 +1,219 @@
+;;; org-track.el --- Track the most recent Org-mode version available.
+;;
+;; Copyright (C) 2009-2012
+;; Free Software Foundation, Inc.
+;;
+;; Author: Bastien Guerry <bzg at altern dot org>
+;; Eric S Fraga <e.fraga at ucl.ac dot uk>
+;; Sebastian Rose <sebastian_rose at gmx dot de>
+;; The Worg people http://orgmode.org/worg/
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.29a
+;;
+;; Released under the GNU General Public License version 3
+;; see: http://www.gnu.org/licenses/gpl-3.0.html
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Download the latest development tarball, unpack and optionally compile it
+;;
+;; Usage:
+;;
+;; (require 'org-track)
+;;
+;; ;; ... somewhere in your setup (use customize):
+;;
+;; (setq org-track-directory "~/test/")
+;; (setq org-track-compile-sources nil)
+;; (setq org-track-remove-package t)
+;;
+;; M-x org-track-update RET
+
+
+
+(require 'url-parse)
+(require 'url-handlers)
+(autoload 'url-file-local-copy "url-handlers")
+(autoload 'url-generic-parse-url "url-parse")
+
+
+
+
+
+;;; Variables:
+
+(defgroup org-track nil
+ "Track the most recent Org-mode version available.
+
+To use org-track, adjust `org-track-directory'.
+Org will download the archived latest git version for you,
+unpack it into that directory (i.e. a subdirectory
+`org-mode/' is added), create the autoloads file
+`org-install.el' for you and, optionally, compile the
+sources.
+All you'll have to do is call `M-x org-track-update' from
+time to time."
+ :version "22.1"
+ :group 'org)
+
+(defcustom org-track-directory "~/.emacs.d/org/lisp"
+ "Directory where your org-mode/ directory lives.
+If that directory does not exist, it will be created."
+ :type 'directory)
+
+(defcustom org-track-compile-sources t
+ "If `nil', never compile org-sources.
+Org will only create the autoloads file `org-install.el' for
+you then. If `t', compile the sources, too.
+Note, that emacs preferes compiled elisp files over
+non-compiled ones."
+ :type 'boolean)
+
+(defcustom org-track-org-url "http://orgmode.org/"
+ "The URL where the package to download can be found.
+Please append a slash."
+ :type 'string)
+
+(defcustom org-track-org-package "org-latest.tar.gz"
+ "The basename of the package you use.
+Defaults to the development version of Org-mode.
+This should be a *.tar.gz package, since emacs provides all
+you need to unpack it."
+ :type 'string)
+
+(defcustom org-track-remove-package nil
+ "Remove org-latest.tar.gz after updates?"
+ :type 'boolean)
+
+
+
+
+
+;;; Frontend
+
+(defun org-track-update ()
+ "Update to current Org-mode version.
+Also, generate autoloads and evtl. compile the sources."
+ (interactive)
+ (let* ((base (file-truename org-track-directory))
+ (org-exists (file-exists-p
+ (file-truename
+ (concat base "/org-mode/lisp/org.el"))))
+ (nobase (not (file-directory-p
+ (file-truename org-track-directory)))))
+ (if nobase
+ (when (y-or-n-p
+ (format "Directory %s does not exist. Create it?" base))
+ (make-directory base t)
+ (setq nobase nil)))
+ (if nobase
+ (message "Not creating %s - giving up." org-track-directory)
+ (condition-case err
+ (progn
+ (org-track-fetch-package)
+ (org-track-compile-org))
+ (error (message "%s" (error-message-string err)))))))
+
+
+
+
+;;; tar related functions
+
+;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure
+;; that? If the maintainers of that package decide, that an assynchronous
+;; download might be better??? (used by `url-file-local-copy')
+
+;;;###autoload
+(defun org-track-fetch-package (&optional directory)
+ "Fetch Org package depending on `org-track-fetch-package-extension'.
+If DIRECTORY is defined, unpack the package there, i.e. add the
+subdirectory org-mode/ to DIRECTORY."
+ (interactive "Dorg-track directory: ")
+ (let* ((pack (concat
+ (if (string-match "/$" org-track-org-url)
+ org-track-org-url
+ (concat org-track-org-url "/"))
+ org-track-org-package))
+ (base (file-truename
+ (or directory org-track-directory)))
+ (target (file-truename
+ (concat base "/" org-track-org-package)))
+ url download tarbuff)
+ (message "Fetching to %s - this might take some time..." base)
+ (setq url (url-generic-parse-url pack))
+ (setq download (url-file-local-copy url)) ;; errors if fail
+ (copy-file download target t)
+ (delete-file download)
+ ;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to
+ ;; ensure tar-mode is used:
+ (add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode))
+ (setq tarbuff (find-file target))
+ (with-current-buffer tarbuff ;; with-temp-buffer does not work with tar-mode??
+ (tar-untar-buffer))
+ (kill-buffer tarbuff)
+ (if org-track-remove-package
+ (delete-file target))))
+
+
+
+
+;;; Compile Org-mode sources
+
+
+;;;###autoload
+(defun org-track-compile-org (&optional directory)
+ "Compile all *.el files that come with org-mode.
+Generate the autoloads file `org-install.el'.
+
+DIRECTORY is where the directory org-mode/ lives (i.e. the
+ parent directory of your local repo."
+ (interactive)
+ ;; file-truename expands the filename and removes double slash, if exists:
+ (setq directory (file-truename
+ (concat
+ (or directory
+ (file-truename (concat org-track-directory "/org-mode/lisp")))
+ "/")))
+ (add-to-list 'load-path directory)
+ (let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
+ ;; create the org-install file
+ (require 'autoload)
+ (setq esf/org-install-file (concat directory "org-install.el"))
+ (find-file esf/org-install-file)
+ (erase-buffer)
+ (mapc (lambda (x)
+ (generate-file-autoloads x))
+ list-of-org-files)
+ (insert "\n(provide (quote org-install))\n")
+ (save-buffer)
+ (kill-buffer)
+ (byte-compile-file esf/org-install-file t)
+
+ (mapc (lambda (f)
+ (if (file-exists-p (concat f "c"))
+ (delete-file (concat f "c"))))
+ list-of-org-files)
+ (if org-track-compile-sources
+ (mapc (lambda (f) (byte-compile-file f)) list-of-org-files))))
+
+
+(provide 'org-track)
+
+;;; org-track.el ends here
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
new file mode 100644
index 0000000..7425d32
--- /dev/null
+++ b/contrib/lisp/org-velocity.el
@@ -0,0 +1,724 @@
+;;; org-velocity.el --- something like Notational Velocity for Org.
+
+;; Copyright (C) 2010-2012 Paul M. Rodriguez
+
+;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
+;; Created: 2010-05-05
+;; Version: 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 version 2.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; For a copy of the GNU General Public License, search the Internet,
+;; or write to the Free Software Foundation, Inc., 59 Temple Place,
+;; Suite 330, Boston, MA 02111-1307 USA
+
+;;; Commentary:
+;; Org-Velocity.el is an interface for Org inspired by the minimalist
+;; notetaking program Notational Velocity. The idea is to let you
+;; amass and access brief notes on many subjects with minimal fuss.
+;; Each note is an entry in an ordinary Org file.
+
+;; Org-Velocity can be used in two ways: when called outside Org, to
+;; store and access notes in a designated bucket file; or, when called
+;; inside Org, as a method for navigating any Org file. (Setting the
+;; option `org-velocity-always-use-bucket' disables navigation inside
+;; Org files by default, although you can still force this behavior by
+;; calling `org-velocity-read' with an argument.)
+
+;; Org-Velocity prompts for search terms in the minibuffer. A list of
+;; headings of entries whose text matches your search is updated as
+;; you type; you can end the search and visit an entry at any time by
+;; clicking on its heading.
+
+;; RET displays the results. If there are no matches, Org-Velocity
+;; offers to create a new entry with your search string as its
+;; heading. If there are matches, it displays a list of results where
+;; the heading of each matching entry is hinted with a number or
+;; letter; clicking a result, or typing the matching hint, opens the
+;; entry for editing in an indirect buffer. 0 forces a new entry; RET
+;; reopens the search for editing.
+
+;; You can customize every step in this process, including the search
+;; method, completion for search terms, and templates for creating new
+;; entries; M-x customize-group RET org-velocity RET to see all the
+;; options.
+
+;; Thanks to Richard Riley, Carsten Dominik, Bastien Guerry, and Jeff
+;; Horn for their suggestions.
+
+;;; Usage:
+;; (require 'org-velocity)
+;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory))
+;; (global-set-key (kbd "C-c v") 'org-velocity)
+
+;;; Code:
+(require 'org)
+(require 'button)
+(require 'electric)
+(require 'dabbrev)
+(eval-when-compile (require 'cl))
+
+(defgroup org-velocity nil
+ "Notational Velocity-style interface for Org."
+ :tag "Org-Velocity"
+ :group 'outlines
+ :group 'hypermedia
+ :group 'org)
+
+(defcustom org-velocity-bucket ""
+ "Where is the bucket file?"
+ :group 'org-velocity
+ :type 'file)
+
+(defcustom org-velocity-search-is-incremental t
+ "Show results incrementally when possible?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-show-previews t
+ "Show previews of the text of each heading?"
+ :group 'velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-exit-on-match nil
+ "When searching incrementally, exit on a single match?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-force-new nil
+ "Should exiting the minibuffer with C-j force a new entry?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-use-search-ring t
+ "Push search to `search-ring' when visiting an entry?
+
+This means that C-s C-s will take you directly to the first
+instance of the search string."
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-always-use-bucket nil
+ "Use bucket file even when called from an Org buffer?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-use-completion nil
+ "Use completion?
+
+Notwithstanding the value of this option, calling
+`dabbrev-expand' always completes against the text of the bucket
+file."
+ :group 'org-velocity
+ :type '(choice
+ (const :tag "Do not use completion" nil)
+ (const :tag "Use completion" t))
+ :safe 'booleanp)
+
+(defcustom org-velocity-search-method 'phrase
+ "Match on whole phrase, any word, or all words?"
+ :group 'org-velocity
+ :type '(choice
+ (const :tag "Match whole phrase" phrase)
+ (const :tag "Match any word" any)
+ (const :tag "Match all words" all)
+ (const :tag "Match a regular expression" regexp))
+ :safe (lambda (v) (memq v '(phrase any all regexp))))
+
+(defcustom org-velocity-capture-templates
+ '(("v"
+ "Velocity entry"
+ entry
+ (file "")
+ "* %:search\n\n%i%?"))
+ "Use these template with `org-capture'.
+Meanwhile `org-default-notes-file' is bound to `org-velocity-bucket-file'.
+The keyword :search inserts the current search.
+See the documentation for `org-capture-templates'."
+ :group 'org-velocity
+ :type (or (get 'org-capture-templates 'custom-type) 'list))
+
+(defsubst org-velocity-grab-preview ()
+ "Grab preview of a subtree.
+The length of the preview is determined by `window-width'.
+
+Replace all contiguous whitespace with single spaces."
+ (let ((start (progn
+ (forward-line 1)
+ (if (looking-at org-property-start-re)
+ (re-search-forward org-property-end-re)
+ (1- (point))))))
+ (mapconcat
+ #'identity
+ (split-string
+ (buffer-substring-no-properties
+ start
+ (min
+ (+ start (window-width))
+ (point-max))))
+ " ")))
+
+(defstruct org-velocity-heading buffer position name level preview)
+
+(defsubst org-velocity-nearest-heading (position)
+ "Return last heading at POSITION.
+If there is no last heading, return nil."
+ (save-excursion
+ (goto-char position)
+ (re-search-backward org-velocity-heading-regexp)
+ (let ((components (org-heading-components)))
+ (make-org-velocity-heading
+ :buffer (current-buffer)
+ :position (point)
+ :name (nth 4 components)
+ :level (nth 0 components)
+ :preview (if org-velocity-show-previews
+ (org-velocity-grab-preview))))))
+
+(defconst org-velocity-index
+ (eval-when-compile
+ (nconc (number-sequence 49 57) ;numbers
+ (number-sequence 97 122) ;lowercase letters
+ (number-sequence 65 90))) ;uppercase letters
+ "List of chars for indexing results.")
+
+(defconst org-velocity-match-buffer-name "*Velocity matches*")
+
+(defconst org-velocity-heading-regexp "^\\* "
+ "Regexp to match only top-level headings.")
+
+(defvar org-velocity-search nil
+ "Variable to bind to current search.")
+
+(defun org-velocity-buffer-file-name (&optional buffer)
+ "Return the name of the file BUFFER saves to.
+Same as function `buffer-file-name' unless BUFFER is an indirect
+buffer or a minibuffer. In the former case, return the file name
+of the base buffer; in the latter, return the file name of
+`minibuffer-selected-window' (or its base buffer)."
+ (let ((buffer (if (minibufferp buffer)
+ (window-buffer (minibuffer-selected-window))
+ buffer)))
+ (buffer-file-name
+ (or (buffer-base-buffer buffer)
+ buffer))))
+
+(defun org-velocity-minibuffer-contents ()
+ "Return the contents of the minibuffer when it is active."
+ (if (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (minibuffer-contents))))
+
+(defsubst org-velocity-singlep (object)
+ "Return t when OBJECT is a list or sequence of one element."
+ (if (consp object)
+ (null (cdr object))
+ (= (length object) 1)))
+
+(defun org-velocity-bucket-file ()
+ "Return the proper file for Org-Velocity to search.
+If `org-velocity-always-use-bucket' is t, use bucket file;
+complain if missing. Otherwise, if an Org file is current, then
+use it."
+ (let ((org-velocity-bucket
+ (when org-velocity-bucket (expand-file-name org-velocity-bucket)))
+ (buffer
+ (let ((buffer-file (org-velocity-buffer-file-name)))
+ (when buffer-file
+ ;; Use the target in capture buffers.
+ (org-find-base-buffer-visiting buffer-file)))))
+ (if org-velocity-always-use-bucket
+ (or org-velocity-bucket (error "Bucket required but not defined"))
+ (if (and (eq (buffer-local-value 'major-mode (or buffer (current-buffer)))
+ 'org-mode)
+ (org-velocity-buffer-file-name))
+ (org-velocity-buffer-file-name)
+ (or org-velocity-bucket
+ (error "No bucket and not an Org file"))))))
+
+(defvar org-velocity-bucket-buffer nil)
+
+(defsubst org-velocity-bucket-buffer ()
+ (or org-velocity-bucket-buffer
+ (find-file-noselect (org-velocity-bucket-file))))
+
+(defsubst org-velocity-match-buffer ()
+ "Return the proper buffer for Org-Velocity to display in."
+ (get-buffer-create org-velocity-match-buffer-name))
+
+(defun org-velocity-beginning-of-headings ()
+ "Goto the start of the first heading."
+ (goto-char (point-min))
+ ;; If we are before the first heading we could still be at the
+ ;; first heading.
+ (or (looking-at org-velocity-heading-regexp)
+ (re-search-forward org-velocity-heading-regexp)))
+
+(defun org-velocity-make-indirect-buffer (heading)
+ "Make or switch to an indirect buffer visiting HEADING."
+
+ (let* ((bucket (org-velocity-heading-buffer heading))
+ (name (org-velocity-heading-name heading))
+ (existing (get-buffer name)))
+ (if (and existing (buffer-base-buffer existing)
+ (equal (buffer-base-buffer existing) bucket))
+ existing
+ (make-indirect-buffer
+ bucket
+ (generate-new-buffer-name (org-velocity-heading-name heading))))))
+
+(defun org-velocity-capture ()
+ "Record a note with `org-capture'."
+ (let ((org-capture-templates
+ org-velocity-capture-templates))
+ (org-capture nil
+ ;; This is no longer automatically selected.
+ (when (org-velocity-singlep org-capture-templates)
+ (caar org-capture-templates)))
+ (if org-capture-mode (rename-buffer org-velocity-search t))))
+
+(defvar org-velocity-saved-winconf nil)
+(make-variable-buffer-local 'org-velocity-saved-winconf)
+
+(defun org-velocity-edit-entry (heading)
+ "Edit entry at HEADING in an indirect buffer."
+ (let ((winconf (current-window-configuration)))
+ (let ((buffer (org-velocity-make-indirect-buffer heading)))
+ (with-current-buffer buffer
+ (let ((org-inhibit-startup t))
+ (org-mode))
+ (setq org-velocity-saved-winconf winconf)
+ (goto-char (org-velocity-heading-position heading))
+ (narrow-to-region (point)
+ (save-excursion
+ (org-end-of-subtree t)
+ (point)))
+ (goto-char (point-min))
+ (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
+ (pop-to-buffer buffer)
+ (set (make-local-variable 'header-line-format)
+ (format "%s Use C-c C-c to finish."
+ (abbreviate-file-name
+ (buffer-file-name
+ (org-velocity-heading-buffer heading))))))))
+
+(defun org-velocity-dismiss ()
+ "Save current entry and close indirect buffer."
+ (let ((winconf org-velocity-saved-winconf))
+ (prog1 t ;Tell hook we're done.
+ (save-buffer)
+ (kill-buffer)
+ (when (window-configuration-p winconf)
+ (set-window-configuration winconf)))))
+
+(defun org-velocity-visit-button (button)
+ (run-hooks 'mouse-leave-buffer-hook)
+ (if org-velocity-use-search-ring
+ (add-to-history 'search-ring
+ (button-get button 'search)
+ search-ring-max))
+ (org-velocity-edit-entry (button-get button 'match)))
+
+(define-button-type 'org-velocity-button
+ 'action #'org-velocity-visit-button)
+
+(defsubst org-velocity-buttonize (heading)
+ "Insert HEADING as a text button with no hints."
+ (insert-text-button
+ (propertize (org-velocity-heading-name heading) 'face 'link)
+ :type 'org-velocity-button
+ 'match heading
+ 'search org-velocity-search))
+
+(defsubst org-velocity-insert-preview (heading)
+ (when org-velocity-show-previews
+ (insert-char ?\ 1)
+ (insert
+ (propertize
+ (org-velocity-heading-preview heading)
+ 'face 'shadow))))
+
+(defsubst* org-velocity-present-match (&key hint match)
+ (with-current-buffer (org-velocity-match-buffer)
+ (when hint (insert "#" hint " "))
+ (org-velocity-buttonize match)
+ (org-velocity-insert-preview match)
+ (newline)))
+
+(defun org-velocity-generic-search (search &optional hide-hints)
+ "Display any entry containing SEARCH."
+ (let ((hints org-velocity-index) matches)
+ (block nil
+ (while (and hints (re-search-forward search nil t))
+ (let ((match (org-velocity-nearest-heading (point))))
+ (org-velocity-present-match
+ :hint (unless hide-hints (car hints))
+ :match match)
+ (push match matches))
+ (setq hints (cdr hints))
+ (unless (re-search-forward org-velocity-heading-regexp nil t)
+ (return))))
+ (nreverse matches)))
+
+(defun* org-velocity-all-search (search &optional hide-hints max)
+ "Display only entries containing every word in SEARCH."
+ (let ((keywords (mapcar 'regexp-quote (split-string search)))
+ (hints org-velocity-index)
+ matches)
+ (org-map-entries
+ (lambda ()
+ ;; Return if we've run out of hints.
+ (when (null hints)
+ (return-from org-velocity-all-search (nreverse matches)))
+ ;; Only search the subtree once.
+ (setq org-map-continue-from
+ (save-excursion
+ (goto-char (line-end-position))
+ (if (re-search-forward org-velocity-heading-regexp nil t)
+ (line-end-position)
+ (point-max))))
+ (when (loop for word in keywords
+ always (save-excursion
+ (re-search-forward
+ (concat "\\<" word "\\>")
+ org-map-continue-from t)))
+ (let ((match (org-velocity-nearest-heading (match-end 0))))
+ (org-velocity-present-match
+ :hint (unless hide-hints (car hints))
+ :match match)
+ (push match matches)
+ (setq hints (cdr hints))))))
+ (nreverse matches)))
+
+(defun* org-velocity-present (search &key hide-hints)
+ "Buttonize matches for SEARCH in `org-velocity-match-buffer'.
+If HIDE-HINTS is non-nil, display entries without indices. SEARCH
+binds `org-velocity-search'.
+
+Return matches."
+ (if (and (stringp search) (not (string= "" search)))
+ ;; Fold case when the search string is all lowercase.
+ (let ((case-fold-search (equal search (downcase search)))
+ (truncate-partial-width-windows t))
+ (with-current-buffer (org-velocity-match-buffer)
+ (erase-buffer)
+ ;; Permanent locals.
+ (setq cursor-type nil
+ truncate-lines t))
+ (prog1
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (save-excursion
+ (org-velocity-beginning-of-headings)
+ (case org-velocity-search-method
+ (all (org-velocity-all-search search hide-hints))
+ (phrase (org-velocity-generic-search
+ (concat "\\<" (regexp-quote search))
+ hide-hints))
+ (any (org-velocity-generic-search
+ (concat "\\<"
+ (regexp-opt (split-string search)))
+ hide-hints))
+ (regexp (condition-case lossage
+ (org-velocity-generic-search
+ search hide-hints)
+ (invalid-regexp
+ (minibuffer-message "%s" lossage))))))))
+ (with-current-buffer (org-velocity-match-buffer)
+ (goto-char (point-min)))))
+ (with-current-buffer (org-velocity-match-buffer)
+ (erase-buffer))))
+
+(defun org-velocity-store-link ()
+ "Function for `org-store-link-functions'."
+ (if org-velocity-search
+ (org-store-link-props
+ :search org-velocity-search)))
+
+(add-hook 'org-store-link-functions 'org-velocity-store-link)
+
+(defun* org-velocity-create (search &key ask)
+ "Create new heading named SEARCH.
+If ASK is non-nil, ask first."
+ (when (or (null ask) (y-or-n-p "No match found, create? "))
+ (let ((org-velocity-search search)
+ (org-default-notes-file (org-velocity-bucket-file))
+ ;; save a stored link
+ org-store-link-plist)
+ (org-velocity-capture))
+ search))
+
+(defun org-velocity-engine (search)
+ "Display a list of headings where SEARCH occurs."
+ (let ((org-velocity-search search))
+ (unless (or
+ (not (stringp search))
+ (string= "" search)) ;exit on empty string
+ (case
+ (if (and org-velocity-force-new (eq last-command-event ?\C-j))
+ :force
+ (let ((matches (org-velocity-present search)))
+ (cond ((null matches) :new)
+ ((org-velocity-singlep matches) :follow)
+ (t :prompt))))
+ (:prompt (progn
+ (pop-to-buffer (org-velocity-match-buffer))
+ (let ((hint (org-velocity-electric-read-hint)))
+ (when hint (case hint
+ (:edit (org-velocity-read nil search))
+ (:force (org-velocity-create search))
+ (otherwise (org-velocity-activate-button hint)))))))
+ (:new (unless (org-velocity-create search :ask t)
+ (org-velocity-read nil search)))
+ (:force (org-velocity-create search))
+ (:follow (if (y-or-n-p "One match, follow? ")
+ (progn
+ (set-buffer (org-velocity-match-buffer))
+ (goto-char (point-min))
+ (button-activate (next-button (point))))
+ (org-velocity-read nil search)))))))
+
+(defun org-velocity-position (item list)
+ "Return first position of ITEM in LIST."
+ (loop for elt in list
+ for i from 0
+ when (equal elt item)
+ return i))
+
+(defun org-velocity-activate-button (char)
+ "Go to button on line number associated with CHAR in `org-velocity-index'."
+ (goto-char (point-min))
+ (forward-line (org-velocity-position char org-velocity-index))
+ (goto-char
+ (button-start
+ (next-button (point))))
+ (message "%s" (button-label (button-at (point))))
+ (button-activate (button-at (point))))
+
+(defun org-velocity-electric-undefined ()
+ "Complain about an undefined key."
+ (interactive)
+ (message "%s"
+ (substitute-command-keys
+ "\\[org-velocity-electric-new] for new entry,
+\\[org-velocity-electric-edit] to edit search,
+\\[scroll-up] to scroll up,
+\\[scroll-down] to scroll down,
+\\[keyboard-quit] to quit."))
+ (sit-for 4))
+
+(defun org-velocity-electric-follow (ev)
+ "Follow a hint indexed by keyboard event EV."
+ (interactive (list last-command-event))
+ (if (not (> (org-velocity-position ev org-velocity-index)
+ (1- (count-lines (point-min) (point-max)))))
+ (throw 'org-velocity-select ev)
+ (call-interactively 'org-velocity-electric-undefined)))
+
+(defun org-velocity-electric-click (ev)
+ "Follow hint indexed by a mouse event EV."
+ (interactive "e")
+ (throw 'org-velocity-select
+ (nth (1- (count-lines
+ (point-min)
+ (posn-point (event-start ev))))
+ org-velocity-index)))
+
+(defun org-velocity-electric-edit ()
+ "Edit the search string."
+ (interactive)
+ (throw 'org-velocity-select :edit))
+
+(defun org-velocity-electric-new ()
+ "Force a new entry."
+ (interactive)
+ (throw 'org-velocity-select :force))
+
+(defvar org-velocity-electric-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [t] 'org-velocity-electric-undefined)
+ (loop for c in org-velocity-index
+ do (define-key map (char-to-string c) 'org-velocity-electric-follow))
+ (define-key map "0" 'org-velocity-electric-new)
+ (define-key map "\C-v" 'scroll-up)
+ (define-key map "\M-v" 'scroll-down)
+ (define-key map (kbd "RET") 'org-velocity-electric-edit)
+ (define-key map [mouse-1] 'org-velocity-electric-click)
+ (define-key map [mouse-2] 'org-velocity-electric-click)
+ (define-key map [escape] 'keyboard-quit)
+ (define-key map "\C-h" 'help-command)
+ map))
+
+(defun org-velocity-electric-read-hint ()
+ "Read index of button electrically."
+ (with-current-buffer (org-velocity-match-buffer)
+ (use-local-map org-velocity-electric-map)
+ (catch 'org-velocity-select
+ (Electric-command-loop 'org-velocity-select "Follow: "))))
+
+(defvar org-velocity-incremental-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-velocity-click-for-incremental)
+ (define-key map [mouse-2] 'org-velocity-click-for-incremental)
+ (define-key map "\C-v" 'scroll-up)
+ (define-key map "\M-v" 'scroll-down)
+ map))
+
+(defun org-velocity-click-for-incremental ()
+ "Jump out of search and select hint clicked on."
+ (interactive)
+ (let ((ev last-command-event))
+ (org-velocity-activate-button
+ (nth (- (count-lines
+ (point-min)
+ (posn-point (event-start ev))) 2)
+ org-velocity-index)))
+ (throw 'click (current-buffer)))
+
+(defun org-velocity-displaying-completions-p ()
+ "Is there a *Completions* buffer showing?"
+ (get-window-with-predicate
+ (lambda (w)
+ (eq (buffer-local-value 'major-mode (window-buffer w))
+ 'completion-list-mode))))
+
+(defun org-velocity-update ()
+ "Display results of search without hinting.
+Stop searching once there are more matches than can be displayed."
+ (unless (org-velocity-displaying-completions-p)
+ (let* ((search (org-velocity-minibuffer-contents))
+ (matches (org-velocity-present search :hide-hints t)))
+ (cond ((null matches)
+ (select-window (active-minibuffer-window))
+ (unless (or (null search) (string= "" search))
+ (minibuffer-message "No match; RET to create")))
+ ((and (org-velocity-singlep matches)
+ org-velocity-exit-on-match)
+ (throw 'click search))
+ (t
+ (with-current-buffer (org-velocity-match-buffer)
+ (use-local-map org-velocity-incremental-keymap)))))))
+
+(defvar dabbrev--last-abbrev)
+
+(defun org-velocity-dabbrev-completion-list (abbrev)
+ "Return all dabbrev completions for ABBREV."
+ ;; This is based on `dabbrev-completion'.
+ (dabbrev--reset-global-variables)
+ (setq dabbrev--last-abbrev abbrev)
+ (dabbrev--find-all-expansions abbrev case-fold-search))
+
+(defvar org-velocity-local-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map " " 'self-insert-command)
+ (define-key map [remap minibuffer-complete] 'minibuffer-complete-word)
+ map)
+ "Keymap for completion with `completing-read'.")
+
+(defun org-velocity-read-with-completion (prompt)
+ "Completing read with PROMPT."
+ (let ((minibuffer-local-completion-map
+ org-velocity-local-completion-map)
+ (completion-no-auto-exit t)
+ (crm-separator " "))
+ (funcall
+ (case org-velocity-search-method
+ (phrase #'completing-read)
+ (any #'completing-read-multiple)
+ (all #'completing-read-multiple))
+ prompt
+ (completion-table-dynamic
+ 'org-velocity-dabbrev-completion-list))))
+
+(defun org-velocity-read-string (prompt &optional initial-input)
+ "Read string with PROMPT followed by INITIAL-INPUT."
+ ;; The use of initial inputs to the minibuffer is deprecated (see
+ ;; `read-from-minibuffer'), but in this case it is the user-friendly
+ ;; thing to do.
+ (minibuffer-with-setup-hook
+ (lexical-let ((initial-input initial-input))
+ (lambda ()
+ (and initial-input (insert initial-input))
+ (goto-char (point-max))))
+ (if (eq org-velocity-search-method 'regexp)
+ (read-regexp prompt)
+ (if org-velocity-use-completion
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt)))))
+
+(defun org-velocity-incremental-read (prompt)
+ "Read string with PROMPT and display results incrementally."
+ (let ((res
+ (unwind-protect
+ (let* ((match-window (display-buffer (org-velocity-match-buffer)))
+ (org-velocity-index
+ ;; Truncate the index to the size of the buffer to be
+ ;; displayed.
+ (with-selected-window match-window
+ (if (> (window-height) (length org-velocity-index))
+ ;; (subseq org-velocity-index 0 (window-height))
+ (let ((hints (copy-sequence org-velocity-index)))
+ (setcdr (nthcdr (window-height) hints) nil)
+ hints)
+ org-velocity-index))))
+ (catch 'click
+ (add-hook 'post-command-hook 'org-velocity-update)
+ (if (eq org-velocity-search-method 'regexp)
+ (read-regexp prompt)
+ (if org-velocity-use-completion
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt)))))
+ (remove-hook 'post-command-hook 'org-velocity-update))))
+ (if (bufferp res) (org-pop-to-buffer-same-window res) res)))
+
+(defun org-velocity (arg &optional search)
+ "Read a search string SEARCH for Org-Velocity interface.
+This means that a buffer will display all headings where SEARCH
+occurs, where one can be selected by a mouse click or by typing
+its index. If SEARCH does not occur, then a new heading may be
+created named SEARCH.
+
+If `org-velocity-bucket' is defined and
+`org-velocity-always-use-bucket' is non-nil, then the bucket file
+will be used; otherwise, this will work when called in any Org
+file. Calling with ARG forces current file."
+ (interactive "P")
+ (let ((org-velocity-always-use-bucket
+ (if arg nil org-velocity-always-use-bucket)))
+ ;; complain if inappropriate
+ (assert (org-velocity-bucket-file))
+ (let ((org-velocity-bucket-buffer
+ (find-file-noselect (org-velocity-bucket-file))))
+ (unwind-protect
+ (let ((dabbrev-search-these-buffers-only
+ (list (org-velocity-bucket-buffer))))
+ (org-velocity-engine
+ (if org-velocity-search-is-incremental
+ (org-velocity-incremental-read "Velocity search: ")
+ (org-velocity-read-string "Velocity search: " search))))
+ (progn
+ (kill-buffer (org-velocity-match-buffer))
+ (delete-other-windows))))))
+
+(defalias 'org-velocity-read 'org-velocity)
+
+(provide 'org-velocity)
+
+;;; org-velocity.el ends here
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
new file mode 100644
index 0000000..bdc3e34
--- /dev/null
+++ b/contrib/lisp/org-wikinodes.el
@@ -0,0 +1,340 @@
+;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 7.01trans
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-wikinodes nil
+ "Wiki-like CamelCase links words to outline nodes in Org mode."
+ :tag "Org WikiNodes"
+ :group 'org)
+
+(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
+ "Regular expression matching CamelCase words.")
+
+(defcustom org-wikinodes-active t
+ "Should CamelCase links be active in the current file?"
+ :group 'org-wikinodes
+ :type 'boolean)
+(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
+
+(defcustom org-wikinodes-scope 'file
+ "The scope of searches for wiki targets.
+Allowed values are:
+
+file Search for targets in the current file only
+directory Search for targets in all org files in the current directory"
+ :group 'org-wikinodes
+ :type '(choice
+ (const :tag "Find targets in current file" file)
+ (const :tag "Find targets in current directory" directory)))
+
+(defcustom org-wikinodes-create-targets 'query
+ "Non-nil means create Wiki target when following a wiki link fails.
+Allowed values are:
+
+nil never create node, just throw an error if the target does not exist
+query ask the user what to do
+t create the node in the current buffer
+\"file.org\" create the node in the file \"file.org\", in the same directory
+
+If you are using wiki links across files, you need to set `org-wikinodes-scope'
+to `directory'."
+ :group 'org-wikinodes
+ :type '(choice
+ (const :tag "Never automatically create node" nil)
+ (const :tag "In current file" t)
+ (file :tag "In one special file\n")
+ (const :tag "Query the user" query)))
+
+;;; Link activation
+
+(defun org-wikinodes-activate-links (limit)
+ "Activate CamelCase words as links to Wiki targets."
+ (when org-wikinodes-active
+ (let (case-fold-search)
+ (if (re-search-forward org-wikinodes-camel-regexp limit t)
+ (if (equal (char-after (point-at-bol)) ?*)
+ (progn
+ ;; in heading - deactivate flyspell
+ (org-remove-flyspell-overlays-in (match-beginning 0)
+ (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-no-flyspell t))
+ t)
+ ;; this is a wiki link
+ (org-remove-flyspell-overlays-in (match-beginning 0)
+ (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'face 'org-link
+ 'keymap org-mouse-map
+ 'help-echo "Wiki Link"))
+ t)))))
+
+;;; Following links and creating non-existing target nodes
+
+(defun org-wikinodes-open-at-point ()
+ "Check if the cursor is on a Wiki link and follow the link.
+
+This function goes into `org-open-at-point-functions'."
+ (and org-wikinodes-active
+ (not (org-at-heading-p))
+ (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
+ (progn (org-wikinodes-follow-link (match-string 0)) t)))
+
+(defun org-wikinodes-follow-link (target)
+ "Follow a wiki link to TARGET.
+
+This need to be found as an exact headline match, either in the current
+buffer, or in any .org file in the current directory, depending on the
+variable `org-wikinodes-scope'.
+
+If a target headline is not found, it may be created according to the
+setting of `org-wikinodes-create-targets'."
+ (if current-prefix-arg (org-wikinodes-clear-directory-targets-cache))
+ (let ((create org-wikinodes-create-targets)
+ visiting buffer m pos file rpl)
+ (setq pos
+ (or (org-find-exact-headline-in-buffer target (current-buffer))
+ (and (eq org-wikinodes-scope 'directory)
+ (setq file (org-wikinodes-which-file
+ target (file-name-directory (buffer-file-name))))
+ (org-find-exact-headline-in-buffer
+ target (or (get-file-buffer file)
+ (find-file-noselect file))))))
+ (if pos
+ (progn
+ (org-mark-ring-push (point))
+ (org-goto-marker-or-bmk pos)
+ (move-marker pos nil))
+ (when (eq create 'query)
+ (if (eq org-wikinodes-scope 'directory)
+ (progn
+ (message "Node \"%s\" does not exist. Should it be created?
+\[RET] in this buffer [TAB] in another file [q]uit" target)
+ (setq rpl (read-char-exclusive))
+ (cond
+ ((member rpl '(?\C-g ?q)) (error "Abort"))
+ ((equal rpl ?\C-m) (setq create t))
+ ((equal rpl ?\C-i)
+ (setq create (file-name-nondirectory
+ (read-file-name "Create in file: "))))
+ (t (error "Invalid selection"))))
+ (if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
+ target))
+ (setq create t)
+ (error "Abort"))))
+
+ (cond
+ ((not create)
+ ;; We are not allowed to create the new node
+ (error "No match for link to \"%s\"" target))
+ ((stringp create)
+ ;; Make new node in another file
+ (org-mark-ring-push (point))
+ (org-pop-to-buffer-same-window (find-file-noselect create))
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (insert "\n* " target "\n")
+ (backward-char 1)
+ (org-wikinodes-add-target-to-cache target)
+ (message "New Wiki target `%s' created in file \"%s\""
+ target create))
+ (t
+ ;; Make new node in current buffer
+ (org-mark-ring-push (point))
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (insert "* " target "\n")
+ (backward-char 1)
+ (org-wikinodes-add-target-to-cache target)
+ (message "New Wiki target `%s' created in current buffer"
+ target))))))
+
+;;; The target cache
+
+(defvar org-wikinodes-directory-targets-cache nil)
+
+(defun org-wikinodes-clear-cache-when-on-target ()
+ "When on a headline that is a Wiki target, clear the cache."
+ (when (and (org-at-heading-p)
+ (org-in-regexp (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp))
+ (org-in-regexp org-wikinodes-camel-regexp))
+ (org-wikinodes-clear-directory-targets-cache)
+ t))
+
+(defun org-wikinodes-clear-directory-targets-cache ()
+ "Clear the cache where to find wiki targets."
+ (interactive)
+ (setq org-wikinodes-directory-targets-cache nil)
+ (message "Wiki target cache cleared, so that it will update when used again"))
+
+(defun org-wikinodes-get-targets ()
+ "Return a list of all wiki targets in the current buffer."
+ (let ((re (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp))
+ (case-fold-search nil)
+ targets)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (push (org-match-string-no-properties 4) targets))))
+ (nreverse targets)))
+
+(defun org-wikinodes-get-links-for-directory (dir)
+ "Return an alist that connects wiki links to files in directory DIR."
+ (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
+ (org-inhibit-startup t)
+ target-file-alist file visiting m buffer)
+ (while (setq file (pop files))
+ (setq visiting (org-find-base-buffer-visiting file))
+ (setq buffer (or visiting (find-file-noselect file)))
+ (with-current-buffer buffer
+ (mapc
+ (lambda (target)
+ (setq target-file-alist (cons (cons target file) target-file-alist)))
+ (org-wikinodes-get-targets)))
+ (or visiting (kill-buffer buffer)))
+ target-file-alist))
+
+(defun org-wikinodes-add-target-to-cache (target &optional file)
+ (setq file (or file buffer-file-name (error "No file for new wiki target")))
+ (set-text-properties 0 (length target) nil target)
+ (let ((dir (file-name-directory (expand-file-name file)))
+ a)
+ (setq a (assoc dir org-wikinodes-directory-targets-cache))
+ (if a
+ ;; Push the new target onto the existing list
+ (push (cons target (expand-file-name file)) (cdr a))
+ ;; Call org-wikinodes-which-file so that the cache will be filled
+ (org-wikinodes-which-file target dir))))
+
+(defun org-wikinodes-which-file (target &optional directory)
+ "Return the file for wiki headline TARGET DIRECTORY.
+If there is no such wiki target, return nil."
+ (let* ((directory (expand-file-name (or directory default-directory)))
+ (founddir (assoc directory org-wikinodes-directory-targets-cache))
+ (foundfile (cdr (assoc target (cdr founddir)))))
+ (or foundfile
+ (and (push (cons directory (org-wikinodes-get-links-for-directory directory))
+ org-wikinodes-directory-targets-cache)
+ (cdr (assoc target (cdr (assoc directory
+ org-wikinodes-directory-targets-cache))))))))
+
+;;; Exporting Wiki links
+
+(defvar target)
+(defvar target-alist)
+(defvar last-section-target)
+(defvar org-export-target-aliases)
+(defun org-wikinodes-set-wiki-targets-during-export ()
+ (let ((line (buffer-substring (point-at-bol) (point-at-eol)))
+ (case-fold-search nil)
+ wtarget a)
+ (when (string-match (format org-complex-heading-regexp-format
+ org-wikinodes-camel-regexp)
+ line)
+ (setq wtarget (match-string 4 line))
+ (push (cons wtarget target) target-alist)
+ (setq a (or (assoc last-section-target org-export-target-aliases)
+ (progn
+ (push (list last-section-target)
+ org-export-target-aliases)
+ (car org-export-target-aliases))))
+ (push (caar target-alist) (cdr a)))))
+
+(defvar org-current-export-file)
+(defun org-wikinodes-process-links-for-export ()
+ "Process Wiki links in the export preprocess buffer.
+
+Try to find target matches in the wiki scope and replace CamelCase words
+with working links."
+ (let ((re org-wikinodes-camel-regexp)
+ (case-fold-search nil)
+ link file)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (org-if-unprotected-at (match-beginning 0)
+ (unless (save-match-data
+ (or (org-at-heading-p)
+ (org-in-regexp org-bracket-link-regexp)
+ (org-in-regexp org-plain-link-re)
+ (org-in-regexp "<<[^<>]+>>")))
+ (setq link (match-string 0))
+ (delete-region (match-beginning 0) (match-end 0))
+ (save-match-data
+ (cond
+ ((org-find-exact-headline-in-buffer link (current-buffer))
+ ;; Found in current buffer
+ (insert (format "[[#%s][%s]]" link link)))
+ ((eq org-wikinodes-scope 'file)
+ ;; No match in file, and other files are not allowed
+ (insert (format "%s" link)))
+ ((setq file
+ (and (org-string-nw-p org-current-export-file)
+ (org-wikinodes-which-file
+ link (file-name-directory org-current-export-file))))
+ ;; Match in another file in the current directory
+ (insert (format "[[file:%s::%s][%s]]" file link link)))
+ (t ;; No match for this link
+ (insert (format "%s" link))))))))))
+
+;;; Hook the WikiNode mechanism into Org
+
+;; `C-c C-o' should follow wiki links
+(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
+
+;; `C-c C-c' should clear the cache
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
+
+;; Make Wiki haeding create additional link names for headlines
+(add-hook 'org-export-define-heading-targets-headline-hook
+ 'org-wikinodes-set-wiki-targets-during-export)
+
+;; Turn Wiki links into links the exporter will treat correctly
+(add-hook 'org-export-preprocess-after-radio-targets-hook
+ 'org-wikinodes-process-links-for-export)
+
+;; Activate CamelCase words as part of Org mode font lock
+
+(defun org-wikinodes-add-to-font-lock-keywords ()
+ "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
+ (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords)))
+ (if m
+ (setcdr m (cons '(org-wikinodes-activate-links) (cdr m)))
+ (message
+ "Failed to add wikinodes to `org-font-lock-extra-keywords'."))))
+
+(add-hook 'org-font-lock-set-keywords-hook
+ 'org-wikinodes-add-to-font-lock-keywords)
+
+(provide 'org-wikinodes)
+
+;;; org-wikinodes.el ends here
diff --git a/contrib/lisp/org2rem.el b/contrib/lisp/org2rem.el
new file mode 100644
index 0000000..3052462
--- /dev/null
+++ b/contrib/lisp/org2rem.el
@@ -0,0 +1,651 @@
+;;; org2rem.el --- Convert org appointments into reminders
+
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+;; Author: Bastien Guerry and Shatad Pratap
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.09a
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; (require 'org2rem)
+;; To export, do
+;;
+;; M-x org2rem-combine-agenda-files
+;;
+;; Then you can use reming like this:
+;;
+;; $ remind ~/org.rem
+;;
+;; If you want to use this regualrly, try in .emacs
+;;
+;; (add-hook 'org-mode-hook
+;; (lambda() (add-hook 'after-save-hook
+;; 'org-export-remind-all-agenda-files t t)))
+
+(require 'org)
+(require 'org-agenda)
+(require 'org-exp)
+(eval-and-compile
+ (require 'cl))
+
+(defgroup org2rem nil
+ "Options specific for Remind export of Org-mode files."
+ :tag "Org Export Remind"
+ :group 'org-export)
+
+(defcustom org-combined-agenda-remind-file "~/org.rem"
+ "The file name for the Remind file covering all agenda files.
+This file is created with the command \\[org2rem-all-agenda-files].
+The file name should be absolute, the file will be overwritten without warning."
+ :group 'org2rem
+ :type 'file)
+
+(defcustom org-remind-combined-name "OrgMode"
+ "Calendar name for the combined Remind representing all agenda files."
+ :group 'org2rem
+ :type 'string)
+
+(defcustom org-remind-use-deadline '(event-if-not-todo todo-due)
+ "Contexts where Remind export should use a deadline time stamp.
+This is a list with several symbols in it. Valid symbol are:
+
+event-if-todo Deadlines in TODO entries become calendar events.
+event-if-not-todo Deadlines in non-TODO entries become calendar events.
+todo-due Use deadlines in TODO entries as due-dates"
+ :group 'org2rem
+ :type '(set :greedy t
+ (const :tag "Deadlines in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "Deadline in TODO entries become events"
+ event-if-todo)
+ (const :tag "Deadlines in TODO entries become due-dates"
+ todo-due)))
+
+(defcustom org-remind-use-scheduled '(todo-start)
+ "Contexts where Remind export should use a scheduling time stamp.
+This is a list with several symbols in it. Valid symbol are:
+
+event-if-todo Scheduling time stamps in TODO entries become an event.
+event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
+todo-start Scheduling time stamps in TODO entries become start date.
+ Some calendar applications show TODO entries only after
+ that date."
+ :group 'org2rem
+ :type '(set :greedy t
+ (const :tag
+ "SCHEDULED timestamps in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "SCHEDULED timestamps in TODO entries become events"
+ event-if-todo)
+ (const :tag "SCHEDULED in TODO entries become start date"
+ todo-start)))
+
+(defcustom org-remind-categories '(local-tags category)
+ "Items that should be entered into the categories field.
+This is a list of symbols, the following are valid:
+
+category The Org-mode category of the current file or tree
+todo-state The todo state, if any
+local-tags The tags, defined in the current line
+all-tags All tags, including inherited ones."
+ :group 'org2rem
+ :type '(repeat
+ (choice
+ (const :tag "The file or tree category" category)
+ (const :tag "The TODO state" todo-state)
+ (const :tag "Tags defined in current line" local-tags)
+ (const :tag "All tags, including inherited ones" all-tags))))
+
+(defcustom org-remind-include-todo nil
+ "Non-nil means export to remind files should also cover TODO items."
+ :group 'org2rem
+ :type '(choice
+ (const :tag "None" nil)
+ (const :tag "Unfinished" t)
+ (const :tag "All" all)))
+
+(defcustom org-remind-include-sexps t
+ "Non-nil means export to Remind files should also cover sexp entries.
+These are entries like in the diary, but directly in an Org-mode file."
+ :group 'org2rem
+ :type 'boolean)
+
+(defcustom org-remind-deadline-over-scheduled t
+ "Non-nil means use deadline as target when both deadline and
+scheduled present, vice-versa. Default is Non-nil."
+ :group 'org2rem
+ :type 'boolean)
+
+(defcustom org-remind-escape-percentage t
+ "Non-nil means % will be escaped, vice-versa. Default is Non-nil."
+ :group 'org2rem
+ :type 'boolean)
+
+(defcustom org-remind-extra-warn-days 3
+ "Extra days Remind keep reminding."
+ :group 'org2rem
+ :type 'number)
+
+(defcustom org-remind-advanced-warn-days 3
+ "Advanced days Remind start reminding."
+ :group 'org2rem
+ :type 'number)
+
+(defcustom org-remind-suppress-last-newline nil
+ "Non-nil means suppress last newline REM body. Default is nil."
+ :group 'org2rem
+ :type 'boolean)
+
+(defcustom org-remind-include-body 100
+ "Amount of text below headline to be included in Remind export.
+This is a number of characters that should maximally be included.
+Properties, scheduling and clocking lines will always be removed.
+The text will be inserted into the DESCRIPTION field."
+ :group 'org2rem
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (const :tag "Everything" t)
+ (integer :tag "Max characters")))
+
+(defcustom org-remind-store-UID nil
+ "Non-nil means store any created UIDs in properties.
+The Remind standard requires that all entries have a unique identifyer.
+Org will create these identifiers as needed. When this variable is non-nil,
+the created UIDs will be stored in the ID property of the entry. Then the
+next time this entry is exported, it will be exported with the same UID,
+superceeding the previous form of it. This is essential for
+synchronization services.
+This variable is not turned on by default because we want to avoid creating
+a property drawer in every entry if people are only playing with this feature,
+or if they are only using it locally."
+ :group 'org2rem
+ :type 'boolean)
+
+;;;; Exporting
+
+;;; Remind export
+
+;;;###autoload
+(defun org2rem-this-file ()
+ "Export current file as an Remind file.
+The Remind file will be located in the same directory as the Org-mode
+file, but with extension `.rem'."
+ (interactive)
+ (org2rem nil buffer-file-name))
+
+;;;###autoload
+(defun org2rem-all-agenda-files ()
+ "Export all files in `org-agenda-files' to Remind .rem files.
+Each Remind file will be located in the same directory as the Org-mode
+file, but with extension `.rem'."
+ (interactive)
+ (apply 'org2rem nil (org-agenda-files t)))
+
+;;;###autoload
+(defun org2rem-combine-agenda-files ()
+ "Export all files in `org-agenda-files' to a single combined Remind file.
+The file is stored under the name `org-combined-agenda-remind-file'."
+ (interactive)
+ (apply 'org2rem t (org-agenda-files t)))
+
+(defun org2rem (combine &rest files)
+ "Create Remind files for all elements of FILES.
+If COMBINE is non-nil, combine all calendar entries into a single large
+file and store it under the name `org-combined-agenda-remind-file'."
+ (save-excursion
+ (org-agenda-prepare-buffers files)
+ (let* ((dir (org-export-directory
+ :ical (list :publishing-directory
+ org-export-publishing-directory)))
+ file rem-file rem-buffer category started org-agenda-new-buffers)
+ (and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*"))
+ (when combine
+ (setq rem-file
+ (if (file-name-absolute-p org-combined-agenda-remind-file)
+ org-combined-agenda-remind-file
+ (expand-file-name org-combined-agenda-remind-file dir))
+ rem-buffer (org-get-agenda-file-buffer rem-file))
+ (set-buffer rem-buffer) (erase-buffer))
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (set-buffer (org-get-agenda-file-buffer file))
+ (unless combine
+ (setq rem-file (concat (file-name-as-directory dir)
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ ".rem"))
+ (setq rem-buffer (org-get-agenda-file-buffer rem-file))
+ (with-current-buffer rem-buffer (erase-buffer)))
+ (setq category (or org-category
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))))
+ (if (symbolp category) (setq category (symbol-name category)))
+ (let ((standard-output rem-buffer))
+ (if combine
+ (and (not started) (setq started t)
+ (org-start-remind-file org-remind-combined-name))
+ (org-start-remind-file category))
+ (org-print-remind-entries combine)
+ (when (or (and combine (not files)) (not combine))
+ (org-finish-remind-file)
+ (set-buffer rem-buffer)
+ (run-hooks 'org-before-save-Remind-file-hook)
+ (save-buffer)
+ (run-hooks 'org-after-save-Remind-file-hook)
+ (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
+ ))))
+ (org-release-buffers org-agenda-new-buffers))))
+
+(defvar org-before-save-Remind-file-hook nil
+ "Hook run before an Remind file has been saved.
+This can be used to modify the result of the export.")
+
+(defvar org-after-save-Remind-file-hook nil
+ "Hook run after an Remind file has been saved.
+The Remind buffer is still current when this hook is run.
+A good way to use this is to tell a desktop calenndar application to re-read
+the Remind file.")
+
+(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
+(defun org-print-remind-entries (&optional combine)
+ "Print Remind entries for the current Org-mode file to `standard-output'.
+When COMBINE is non nil, add the category to each line."
+ (require 'org-agenda)
+ (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
+ (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
+ (dts (org-rem-ts-to-string
+ (format-time-string (cdr org-time-stamp-formats) (current-time))
+ "start time:"))
+ hd ts ts2 state status (inc t) pos b sexp rrule
+ scheduledp deadlinep todo prefix due start
+ tmp pri categories entry location summary desc uid
+ remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days)
+ (org-rem-aw org-remind-advanced-warn-days)
+ trigger diff-days (dos org-remind-deadline-over-scheduled)
+ (suppress-last-newline org-remind-suppress-last-newline)
+ (sexp-buffer (get-buffer-create "*rem-tmp*")))
+ (org-refresh-category-properties)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re1 nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (when (boundp 'org-remind-verify-function)
+ (unless (funcall org-remind-verify-function)
+ (outline-next-heading)
+ (backward-char 1)
+ (throw :skip nil)))
+ (setq pos (match-beginning 0)
+ ts (match-string 0)
+ inc t
+ hd (condition-case nil
+ (org-remind-cleanup-string
+ (org-get-heading))
+ (error (throw :skip nil)))
+ summary (org-remind-cleanup-string
+ (org-entry-get nil "SUMMARY"))
+ desc (org-remind-cleanup-string
+ (or (org-entry-get nil "DESCRIPTION")
+ (and org-remind-include-body (org-get-entry)))
+ t org-remind-include-body)
+ location (org-remind-cleanup-string
+ (org-entry-get nil "LOCATION"))
+ uid (if org-remind-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new)))
+ categories (org-export-get-remind-categories)
+ deadlinep nil scheduledp nil)
+ (if (looking-at re2)
+ (progn
+ (goto-char (match-end 0))
+ (setq ts2 (match-string 1)
+ inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
+ (setq tmp (buffer-substring (max (point-min)
+ (- pos org-ds-keyword-length))
+ pos)
+ ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
+ (progn
+ (setq inc nil)
+ (replace-match "\\1" t nil ts))
+ ts)
+ deadlinep (string-match org-deadline-regexp tmp)
+ scheduledp (string-match org-scheduled-regexp tmp)
+ todo (org-get-todo-state)
+ ;; donep (org-entry-is-done-p)
+ ))
+ (when (and
+ deadlinep
+ (if todo
+ (not (memq 'event-if-todo org-remind-use-deadline))
+ (not (memq 'event-if-not-todo org-remind-use-deadline))))
+ (throw :skip t))
+ (when (and
+ scheduledp
+ (if todo
+ (not (memq 'event-if-todo org-remind-use-scheduled))
+ (not (memq 'event-if-not-todo org-remind-use-scheduled))))
+ (throw :skip t))
+ (setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-")))
+ (if (or (string-match org-tr-regexp hd)
+ (string-match org-ts-regexp hd))
+ (setq hd (replace-match "" t t hd)))
+ (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
+ (setq rrule ;is recurrence value. later give it good name.
+ (* (string-to-number
+ (cdr (assoc
+ (match-string 2 ts)
+ '(("d" . "1")("w" . "7")
+ ("m" . "0")("y" . "0")))))
+ (string-to-number (match-string 1 ts))))
+ (setq rrule nil))
+ (setq summary (or summary hd))
+ (if (string-match org-bracket-link-regexp summary)
+ (setq summary
+ (replace-match (if (match-end 3)
+ (match-string 3 summary)
+ (match-string 1 summary))
+ t t summary)))
+ (if deadlinep (setq summary (concat "DEADLINE: " summary)))
+ (if scheduledp (setq summary (concat "SCHEDULED: " summary)))
+ (if (string-match "\\`<%%" ts)
+ (with-current-buffer sexp-buffer
+ (insert (substring ts 1 -1) " " summary "\n"))
+ (princ (format "\n## BEGIN:EVENT
+## UID: %s
+REM %s %s MSG EVENT:%s%s %s%s%%
+## CATEGORIES:%s
+## END:EVENT\n"
+ (concat prefix uid)
+ (org-rem-ts-to-string ts nil nil rrule)
+ (org-rem-ts-to-string ts2 "UNTIL " inc)
+ summary
+ (if (and desc (string-match "\\S-" desc))
+ (concat "%_\\\n" desc) "")
+ (if (and location (string-match "\\S-" location))
+ (concat "\nLOCATION: " location) "")
+ (if suppress-last-newline "" "%_")
+ categories)))))
+
+ (when (and org-remind-include-sexps
+ (condition-case nil (require 'remind) (error nil))
+ (fboundp 'remind-export-region))
+ ;; Get all the literal sexps
+ (goto-char (point-min))
+ (while (re-search-forward "^&?%%(" nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (setq b (match-beginning 0))
+ (goto-char (1- (match-end 0)))
+ (forward-sexp 1)
+ (end-of-line 1)
+ (setq sexp (buffer-substring b (point)))
+ (with-current-buffer sexp-buffer
+ (insert sexp "\n"))))
+ ;; (princ (org-diary-to-rem-string sexp-buffer))
+ (kill-buffer sexp-buffer))
+
+ (when org-remind-include-todo
+ (setq prefix "TODO-")
+ (goto-char (point-min))
+ (while (re-search-forward org-todo-line-regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (when (boundp 'org-remind-verify-function)
+ (unless (funcall org-remind-verify-function)
+ (outline-next-heading)
+ (backward-char 1)
+ (throw :skip nil)))
+ (setq state (match-string 2))
+ (setq status (if (member state org-done-keywords)
+ "COMPLETED" "NEEDS-ACTION"))
+ (when (and state
+ (or (not (member state org-done-keywords))
+ (eq org-remind-include-todo 'all))
+ (not (member org-archive-tag (org-get-tags-at)))
+ )
+ (setq hd (match-string 3)
+ summary (org-remind-cleanup-string
+ (org-entry-get nil "SUMMARY"))
+ desc (org-remind-cleanup-string
+ (or (org-entry-get nil "DESCRIPTION")
+ (and org-remind-include-body (org-get-entry)))
+ t org-remind-include-body)
+ location (org-remind-cleanup-string
+ (org-entry-get nil "LOCATION"))
+ due (and (member 'todo-due org-remind-use-deadline)
+ (org-entry-get nil "DEADLINE"))
+ start (and (member 'todo-start org-remind-use-scheduled)
+ (org-entry-get nil "SCHEDULED"))
+ categories (org-export-get-remind-categories)
+ uid (if org-remind-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new))))
+
+ (if (and due start)
+ (setq diff-days (org-rem-time-diff-days due start)))
+
+ (setq remind-aw
+ (if due
+ (if diff-days
+ (if (> diff-days 0)
+ (if dos diff-days 0)
+ (if dos 0 diff-days))
+ 1000)))
+
+ (if (and (numberp org-rem-aw) (> org-rem-aw 0))
+ (setq remind-aw (+ (or remind-aw 0) org-rem-aw)))
+
+ (setq remind-ew
+ (if due
+ (if diff-days
+ (if (> diff-days 0) due nil)
+ due)))
+
+ (setq trigger (if dos (if due due start) (if start start due)))
+ ;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw)))
+ (if trigger
+ (setq trigger (concat
+ (format "[trigger('%s')] *%d "
+ (org-rem-ts-to-remind-date-type trigger) 1)
+ (if remind-aw (format "++%d" remind-aw)))))
+ (and due (setq due (org-rem-ts-to-remind-date-type due)))
+ (and start (setq start (org-rem-ts-to-remind-date-type start)))
+ (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew)))
+
+ (if (string-match org-bracket-link-regexp hd)
+ (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
+ (match-string 1 hd))
+ t t hd)))
+ (if (string-match org-priority-regexp hd)
+ (setq pri (string-to-char (match-string 2 hd))
+ hd (concat (substring hd 0 (match-beginning 1))
+ (substring hd (match-end 1))))
+ (setq pri org-default-priority))
+ (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
+ (- org-lowest-priority org-highest-priority))))))
+
+ (princ (format "\n## BEGIN:TODO
+## UID: %s
+REM %s %s %s MSG TODO: %s%s%s%s%s%s%%
+## CATEGORIES:%s
+## SEQUENCE:1
+## STATUS:%s
+## END:TODO\n"
+ (concat prefix uid)
+ (or trigger "") ;; dts)
+ (if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "")
+ (if pri (format "PRIORITY %d" pri) "")
+ (or summary hd)
+ (if (and desc (string-match "\\S-" desc))
+ (concat "%_\\\nDESCRIPTION: " desc) "")
+ (if (and location (string-match "\\S-" location))
+ (concat "LOCATION: " location) "")
+ (if start
+ (concat
+ "%_\\\n['" start "' - today()] "
+ "days over, for scheduled date - "
+ "[trigger('" start "')]") "")
+ (if due
+ (concat
+ "%_\\\n[today() - '" due "'] "
+ "days left, to deadline date - "
+ "[trigger('" due "')]") "")
+ (if suppress-last-newline "" "%_")
+ categories
+ status)))))))))
+
+(defun org-export-get-remind-categories ()
+ "Get categories according to `org-remind-categories'."
+ (let ((cs org-remind-categories) c rtn tmp)
+ (while (setq c (pop cs))
+ (cond
+ ((eq c 'category) (push (org-get-category) rtn))
+ ((eq c 'todo-state)
+ (setq tmp (org-get-todo-state))
+ (and tmp (push tmp rtn)))
+ ((eq c 'local-tags)
+ (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
+ ((eq c 'all-tags)
+ (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
+ (mapconcat 'identity (nreverse rtn) ",")))
+
+(defun org-remind-cleanup-string (s &optional is-body maxlength)
+ "Take out stuff and quote what needs to be quoted.
+When IS-BODY is non-nil, assume that this is the body of an item, clean up
+whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
+characters."
+ (if (or (not s) (string-match "^[ \t\n]*$" s))
+ nil
+ (when is-body
+ (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+ (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+ (while (string-match re s) (setq s (replace-match "" t t s)))
+ (while (string-match re2 s) (setq s (replace-match "" t t s)))))
+ (if org-remind-escape-percentage
+ (let ((start 0))
+ (while (string-match "\\([%]\\)" s start)
+ (setq start (+ (match-beginning 0) 2)
+ s (replace-match "\\1\\1" nil nil s)))))
+
+ (let ((start 0))
+ (while (string-match "\\([\n]\\)" s start)
+ (setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct.
+ s (replace-match "%_\\\\\\1" nil nil s))))
+
+ (let ((start 0))
+ (while (string-match "\\([[]\\)" s start)
+ (setq start (+ (match-beginning 0) 5)
+ s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s))))
+
+;;; (when is-body
+;;; (while (string-match "[ \t]*\n[ \t]*" s)
+;;; (setq s (replace-match "%_" t t s))))
+
+ (setq s (org-trim s))
+ (if is-body
+ (if maxlength
+ (if (and (numberp maxlength)
+ (> (length s) maxlength))
+ (setq s (substring s 0 maxlength)))))
+ s))
+
+(defun org-get-entry ()
+ "Clean-up description string."
+ (save-excursion
+ (org-back-to-heading t)
+ (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+
+(defun org-start-remind-file (name)
+ "Start an Remind file by inserting the header."
+ (let ((user user-full-name)
+ (name (or name "unknown"))
+ (timezone (cadr (current-time-zone))))
+ (princ
+ (format "# -*- Mode: shell-script; auto-fill-mode: nil -*-
+## BEGIN: Reminders
+## VERSION:2.0
+## Emacs with Org-mode
+## Calendar:%s
+## Created by: %s
+## Timezone:%s
+## Calscale:Gregorian\n" name user timezone))))
+
+(defun org-finish-remind-file ()
+ "Finish an Remind file by inserting the END statement."
+ (princ "\n## END:Reminders\n"))
+
+(defun org-rem-ts-to-remind-date-type (s)
+ (format-time-string
+ "%Y-%m-%d"
+ (apply 'encode-time (butlast (org-parse-time-string s) 3))))
+
+;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn)
+;; (if trigger
+;; (setq trigger
+;; (concat
+;; (format "[trigger('%s')] *%d "
+;; (org-rem-ts-to-remind-date-type trigger) day-repeat)
+;; (if day-advance-warn (format "++%d" day-advance-warn))))))
+
+;; (format-time-string "%Y"
+;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3)))
+
+(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn)
+ "Take a time string S and convert it to Remind format.
+KEYWORD is added in front, to make a complete line like DTSTART....
+When INC is non-nil, increase the hour by two (if time string contains
+a time), or the day by one (if it does not contain a time)."
+ (let ((t1 (org-parse-time-string s 'nodefault))
+ t2 fmt have-time time)
+ (if (and (car t1) (nth 1 t1) (nth 2 t1))
+ (setq t2 t1 have-time t)
+ (setq t2 (org-parse-time-string s)))
+ (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
+ (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
+ (when inc
+ (if have-time
+ (if org-agenda-default-appointment-duration
+ (setq mi (+ org-agenda-default-appointment-duration mi))
+ (setq h (+ 2 h)))
+ (setq d (1+ d))))
+ (setq time (encode-time s mi h d m y)))
+ (setq fmt (concat
+ "%d %b %Y"
+ (if day-advance-warn (format " ++%d" day-advance-warn))
+ (if day-repeat (format " *%d" day-repeat))
+ (if have-time " AT %H:%M")))
+ (concat keyword (format-time-string fmt time))))
+
+(defun org-rem-time-diff-days (end start)
+ (floor (/ (apply '- (mapcar
+ (lambda (s)
+ (let*
+ ((t1 (org-parse-time-string s))
+ (s (car t1)) (mi (nth 1 t1))
+ (h (nth 2 t1)) (d (nth 3 t1))
+ (m (nth 4 t1)) (y (nth 5 t1)))
+ (float-time (encode-time s mi h d m y))))
+ (list end start))) (* 24 60 60))))
+
+(provide 'org2rem)
+
+;;; org-exp.el ends here
diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el
new file mode 100644
index 0000000..d2580d8
--- /dev/null
+++ b/contrib/lisp/orgtbl-sqlinsert.el
@@ -0,0 +1,116 @@
+;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
+
+;; Copyright (C) 2008-2012 Free Software Foundation
+
+;; Author: Jason Riedy <jason@acm.org>
+;; Keywords: org, tables, sql
+
+;; 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:
+
+;; Converts an orgtbl to a sequence of SQL insertion commands.
+;; Table cells are quoted and escaped very conservatively.
+
+;;; Code:
+
+(defun orgtbl-to-sqlinsert (table params)
+ "Convert the orgtbl-mode TABLE to SQL insert statements.
+TABLE is a list, each entry either the symbol `hline' for a horizontal
+separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the conversion.
+
+Names and strings are modified slightly by default. Single-ticks
+are doubled as per SQL's standard mechanism. Backslashes and
+dollar signs are deleted. And tildes are changed to spaces.
+These modifications were chosed for use with TeX. See
+ORGTBL-SQL-STRIP-AND-QUOTE.
+
+Supports all parameters from ORGTBL-TO-GENERIC. New to this function
+are:
+
+:sqlname The name of the database table; defaults to the name of the
+ target region.
+
+:nowebname If not nil, used as a wrapping noweb fragment name.
+
+The most important parameters of ORGTBL-TO-GENERIC for SQL are:
+
+:splice When set to t, return only insert statements, don't wrap
+ them in a transaction. Default is nil.
+
+:tstart, :tend
+ The strings used to begin and commit the transaction.
+
+:hfmt A function that gathers the quoted header names into a
+ dynamically scoped variable HDRLIST. Probably should
+ not be changed by the user.
+
+The general parameters :skip and :skipcols have already been applied when
+this function is called."
+ (let* (hdrlist
+ (alignment (mapconcat (lambda (x) (if x "r" "l"))
+ org-table-last-alignment ""))
+ (nowebname (plist-get params :nowebname))
+ (breakvals (plist-get params :breakvals))
+ (firstheader t)
+ (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
+ (params2
+ (list
+ :sqlname name
+ :tstart (lambda () (concat (if nowebname
+ (format "<<%s>>= \n" nowebname)
+ "")
+ "BEGIN TRANSACTION;"))
+ :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
+ :hfmt (lambda (f) (progn (if firstheader (push f hdrlist)) ""))
+ :hlfmt (lambda (lst) (setq firstheader nil))
+ :lstart (lambda () (concat "INSERT INTO "
+ sqlname "( "
+ (mapconcat 'identity (reverse hdrlist)
+ ", ")
+ " )" (if breakvals "\n" " ")
+ "VALUES ( "))
+ :lend " );"
+ :sep " , "
+ :hline nil
+ :remove-nil-lines t))
+ (params (org-combine-plists params2 params))
+ (sqlname (plist-get params :sqlname)))
+ (orgtbl-to-generic table params)))
+
+(defun orgtbl-sql-quote (str)
+ "Convert single ticks to doubled single ticks and wrap in single ticks."
+ (concat "'" (mapconcat 'identity (split-string str "'") "''") "'"))
+
+(defun orgtbl-sql-strip-dollars-escapes-tildes (str)
+ "Strip dollarsigns and backslash escapes, replace tildes with spaces."
+ (mapconcat 'identity
+ (split-string (mapconcat 'identity
+ (split-string str "\\$\\|\\\\")
+ "")
+ "~")
+ " "))
+
+(defun orgtbl-sql-strip-and-quote (str)
+ "Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES
+to sanitize STR for use in SQL statements."
+ (cond ((stringp str)
+ (orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str)))
+ ((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str))
+ (t nil)))
+
+(provide 'orgtbl-sqlinsert)
+
+;;; orgtbl-sqlinsert.el ends here
diff --git a/contrib/scripts/.gitignore b/contrib/scripts/.gitignore
new file mode 100644
index 0000000..20d5925
--- /dev/null
+++ b/contrib/scripts/.gitignore
@@ -0,0 +1 @@
+plantuml.jar
diff --git a/contrib/scripts/StartOzServer.oz b/contrib/scripts/StartOzServer.oz
new file mode 100644
index 0000000..db12dec
--- /dev/null
+++ b/contrib/scripts/StartOzServer.oz
@@ -0,0 +1,231 @@
+%%% *************************************************************
+%%% Copyright (C) 2009-2012 Torsten Anders (www.torsten-anders.de)
+%%% 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.
+%%% *************************************************************
+
+%%
+%% This code implements the Oz-side of the Org-babel Oz interface. It
+%% creates a socket server (to which org-babel-oz.el then
+%% connects). Any input to this socket must be an Oz expression. The
+%% input is fed to the OPI oz compiler, and the results are send back
+%% via the socket.
+%%
+
+
+declare
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Accessing the OPI compiler
+%%
+
+MyCompiler = Emacs.condSend.compiler
+
+
+/* % testing
+
+%% Feed an expression (result browsed)
+{MyCompiler enqueue(setSwitch(expression true))}
+{Browse
+ {MyCompiler enqueue(feedVirtualString("1 + 2" return(result: $)))}}
+{MyCompiler enqueue(setSwitch(expression false))}
+
+%% It is really the OPI: I can use declare!
+{MyCompiler enqueue(setSwitch(expression false))}
+{MyCompiler enqueue(feedVirtualString("declare X=3\n{Browse X*X}"))}
+
+%% Note: expressions starting with keyword declare need keyword in
+{MyCompiler enqueue(setSwitch(expression true))}
+{Browse
+ {MyCompiler enqueue(feedVirtualString("declare X=3\nin X*X" return(result: $)))}}
+{MyCompiler enqueue(setSwitch(expression false))}
+
+%% Alternatively you use a session with multiple feeds: first declare (statement), and then feed an expression
+{MyCompiler enqueue(setSwitch(expression false))}
+{MyCompiler enqueue(feedVirtualString("declare X=7" return))}
+{MyCompiler enqueue(setSwitch(expression true))}
+{Browse
+ {MyCompiler enqueue(feedVirtualString("X*X" return(result: $)))}}
+{MyCompiler enqueue(setSwitch(expression false))}
+
+%% !!?? does not work?
+%% return nil in case of any error (division by 0)
+{MyCompiler enqueue(setSwitch(expression true))}
+{Browse
+ {MyCompiler enqueue(feedVirtualString(
+ {Accum ["try\n"
+% "skip\n" % do something in any case..
+ "1 div 0" % my code
+% "1" % my code
+ "\ncatch E then {Error.printException E}\n"
+ "error\n" % always return nil
+ "end\n"]
+ List.append}
+ return(result: $)))}}
+{MyCompiler enqueue(setSwitch(expression false))}
+
+
+%% !! catching some exceptions does not work??
+
+%% exception is not catched
+try {Bla} catch E then {Error.printException E} {Browse nil} end
+
+%% exception is catched
+try {Browse 1 div 0} catch E then {Error.printException E} {Browse nil} end
+{Browse ok}
+
+
+*/
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Socket interface
+%%
+
+
+%%
+%% Create socket
+%%
+
+MyPort = 6001
+
+/** %% Creates a TCP socket server. Expects a Host (e.g., 'localhost') and a PortNo and returns a server plus its corresponding client. This client is an instance of Open.socket, and is the interface for reading and writing into the socket.
+%% MakeServer blocks until the server listens. However, waiting until a connection has been accepted happens in its own thread (i.e. MakeServer does only block until the server listens).
+%% NB: A port can be used only once, so assign it carefully. In case this postnnumber was shortly used before, you may need to wait a bit before reusing it.
+%% */
+%% !! Alternatively, let it assign automatically and output the port number..
+%%
+%% NOTE: for supporting multiple connections see http://www.mozart-oz.org/documentation/op/node13.html#section.sockets.accept
+proc {MakeServer Host PortNo ?MyServer ?MyClient}
+ proc {Accept MyClient}
+ thread H in % P
+ %% suspends until a connection has been accepted
+ {MyServer accept(host:H
+ acceptClass:Open.socket
+ accepted:?MyClient)}
+% {Myserver accept(host:H port:P)} % suspends until a connection has been accepted
+ %% !!?? port number of client is usually created randomly..
+ {System.showInfo "% connection accepted from host "#H}
+ end
+ %% !!???
+ %% If Accept is called recursively, then server accepts multiple connections. These share the same compiler instance (e.g. variable bindings are shared). For multiple independent compiler instances call the OzServer application multiple times.
+ %% However, how shall the output for multiple connections be sorted?? Would using the different client sockets created with the Server accept method work?
+ %% NB: The number of clients accepted concurrently must be limited to the number set by {MyServer listen}
+ % {Accept}
+ end
+in
+ MyServer = {New Open.socket init}
+ %% To avoid problems with portnumbers, the port could be assigned automatically and then output..
+ %%{MyServer bind(port:PortNo)}
+ {MyServer bind(host:Host takePort:PortNo)}
+ {MyServer listen}
+ {System.showInfo "% OzServer started at host "#Host#" and port "#PortNo}
+ MyClient = {Accept}
+end
+%%
+MySocket = {MakeServer localhost MyPort _/*MyServer*/}
+
+
+%%
+%% Read socket input
+%%
+
+declare
+%% Copied from OzServer/source/Socket.oz
+local
+ proc {Aux Socket Size Stream}
+ In = {Socket read(list:$
+ size:Size)}
+ in
+ {Wait In}
+ %% !! Is this the right way to stop the processing??
+ %%
+ %% abort condition when client stream ended (i.e. nothing was sent)
+ if In == nil
+ then {System.showInfo "socket stream ended"}
+ Stream = nil
+ else Stream = In | {Aux Socket Size}
+ end
+ end
+in
+ /** %% The socket Server returns a stream of the strings it receives. The Server always waits until someone writes something into the socket, then the input is immediately written to a stream and the Server waits again.
+ %% */
+ proc {ReadToStream Socket Size Xs}
+ thread {Aux Socket Size Xs} end
+ end
+end
+
+/* % test
+
+MyStream = {ReadToStream MySocket 1024}
+
+*/
+
+/* % test
+
+%% writing
+{MySocket write(vs:"this is a test")}
+
+*/
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Send socket input to compiler and send results back to socket
+%%
+
+%% NOTE: Input code must be expression
+thread
+ {ForAll {ReadToStream MySocket 1024}
+ proc {$ Code}
+ Result
+ %% Catch any exception (so the will not cause blocking) and return nil in that case
+ FullCode = {Accum ["try\n"
+% "skip\n" % do something in any case..
+ Code
+ "\ncatch E then {Error.printException E}\n"
+ "error\n" % in case of an error, return 'error'
+ "end\n"]
+ List.append}
+ in
+ %% ?? Should I make setting switches etc atomic?
+ {MyCompiler enqueue(setSwitch(expression true))}
+ {MyCompiler enqueue(feedVirtualString(FullCode return(result: ?Result)))}
+ {MyCompiler enqueue(setSwitch(expression false))}
+ %%
+ {Wait Result}
+ {MySocket write(vs: if {VirtualString.is Result}
+ then Result
+ else {Value.toVirtualString Result 1000 1000}
+ end)}
+ {Show 'Org-babel result: '#Result}
+ end}
+end
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Aux defs
+%%
+
+/** %% Binds the accumulation of the binary function Fn on all neighbors in Xs to Y. E.g., Accum returns the sum in Xs if Fn is Number.'+'.
+%% */
+proc {Accum Xs Fn Y}
+ {List.foldL Xs.2 Fn Xs.1 Y}
+end
+
+
+
+
+
+
+
diff --git a/contrib/scripts/dir2org.zsh b/contrib/scripts/dir2org.zsh
new file mode 100755
index 0000000..1ea8be4
--- /dev/null
+++ b/contrib/scripts/dir2org.zsh
@@ -0,0 +1,54 @@
+# desc:
+#
+# Output an org compatible structure representing the filesystem from
+# the point passed on the command line (or . by default).
+#
+# options:
+# none
+#
+# usage:
+# dir2org.zsh [DIR]...
+#
+# author:
+# Phil Jackson (phil@shellarchive.co.uk)
+
+set -e
+
+function headline {
+ local depth="${1}"
+ local text="${2}"
+
+ printf "%${depth}s %s" "" | tr ' ' '*'
+ echo " ${text}"
+}
+
+function scan_and_populate {
+ local depth="${1}"
+ local dir="${2}"
+
+ headline ${depth} "${dir}"
+
+ # if there is no files in dir then just move on
+ [[ $(ls "${dir}" | wc -l) -eq 0 ]] && return
+
+ (( depth += 1 ))
+
+ for f in $(ls -d "${dir}"/*); do
+ if [ -d "${f}" ]; then
+ scan_and_populate ${depth} "${f}"
+ else
+ headline ${depth} "[[file://${f}][${${f##*/}%.*}]]"
+ fi
+ done
+
+ (( depth -= 1 ))
+}
+
+function main {
+ local scan_dir="${1:-$(pwd)}"
+ local depth=0
+
+ scan_and_populate ${depth} "${scan_dir}"
+}
+
+main "${@}"
diff --git a/contrib/scripts/docco.css b/contrib/scripts/docco.css
new file mode 100644
index 0000000..9030b6c
--- /dev/null
+++ b/contrib/scripts/docco.css
@@ -0,0 +1,185 @@
+/*--------------------- Layout and Typography ----------------------------*/
+body {
+ font-family: 'Palatino Linotype', 'Book Antiqua', Palatino, FreeSerif, serif;
+ font-size: 15px;
+ line-height: 22px;
+ color: #252519;
+ margin: 0; padding: 0;
+}
+a {
+ color: #261a3b;
+}
+ a:visited {
+ color: #261a3b;
+ }
+p {
+ margin: 0 0 15px 0;
+}
+h1, h2, h3, h4, h5, h6 {
+ margin: 0px 0 15px 0;
+}
+ h1 {
+ margin-top: 40px;
+ }
+#container {
+ position: relative;
+}
+#background {
+ position: fixed;
+ top: 0; left: 525px; right: 0; bottom: 0;
+ background: #f5f5ff;
+ border-left: 1px solid #e5e5ee;
+ z-index: -1;
+}
+#jump_to, #jump_page {
+ background: white;
+ -webkit-box-shadow: 0 0 25px #777; -moz-box-shadow: 0 0 25px #777;
+ -webkit-border-bottom-left-radius: 5px; -moz-border-radius-bottomleft: 5px;
+ font: 10px Arial;
+ text-transform: uppercase;
+ cursor: pointer;
+ text-align: right;
+}
+#jump_to, #jump_wrapper {
+ position: fixed;
+ right: 0; top: 0;
+ padding: 5px 10px;
+}
+ #jump_wrapper {
+ padding: 0;
+ display: none;
+ }
+ #jump_to:hover #jump_wrapper {
+ display: block;
+ }
+ #jump_page {
+ padding: 5px 0 3px;
+ margin: 0 0 25px 25px;
+ }
+ #jump_page .source {
+ display: block;
+ padding: 5px 10px;
+ text-decoration: none;
+ border-top: 1px solid #eee;
+ }
+ #jump_page .source:hover {
+ background: #f5f5ff;
+ }
+ #jump_page .source:first-child {
+ }
+table td {
+ border: 0;
+ outline: 0;
+}
+ td.docs, th.docs {
+ max-width: 450px;
+ min-width: 450px;
+ min-height: 5px;
+ padding: 10px 25px 1px 50px;
+ overflow-x: hidden;
+ vertical-align: top;
+ text-align: left;
+ }
+ .docs pre {
+ margin: 15px 0 15px;
+ padding-left: 15px;
+ }
+ .docs p tt, .docs p code {
+ background: #f8f8ff;
+ border: 1px solid #dedede;
+ font-size: 12px;
+ padding: 0 0.2em;
+ }
+ .pilwrap {
+ position: relative;
+ }
+ .pilcrow {
+ font: 12px Arial;
+ text-decoration: none;
+ color: #454545;
+ position: absolute;
+ top: 3px; left: -20px;
+ padding: 1px 2px;
+ opacity: 0;
+ -webkit-transition: opacity 0.2s linear;
+ }
+ td.docs:hover .pilcrow {
+ opacity: 1;
+ }
+ td.code, th.code {
+ padding: 14px 15px 16px 25px;
+ width: 100%;
+ vertical-align: top;
+ border-left: 1px solid #e5e5ee;
+ }
+ pre, tt, code {
+ font-size: 12px; line-height: 18px;
+ font-family: Menlo, Monaco, Consolas, "Lucida Console", monospace;
+ margin: 0; padding: 0;
+ }
+
+
+/*---------------------- Syntax Highlighting -----------------------------*/
+td.linenos { background-color: #f0f0f0; padding-right: 10px; }
+span.lineno { background-color: #f0f0f0; padding: 0 5px 0 5px; }
+body .hll { background-color: #ffffcc }
+body .c { color: #408080; font-style: italic } /* Comment */
+body .err { border: 1px solid #FF0000 } /* Error */
+body .k { color: #954121 } /* Keyword */
+body .o { color: #666666 } /* Operator */
+body .cm { color: #408080; font-style: italic } /* Comment.Multiline */
+body .cp { color: #BC7A00 } /* Comment.Preproc */
+body .c1 { color: #408080; font-style: italic } /* Comment.Single */
+body .cs { color: #408080; font-style: italic } /* Comment.Special */
+body .gd { color: #A00000 } /* Generic.Deleted */
+body .ge { font-style: italic } /* Generic.Emph */
+body .gr { color: #FF0000 } /* Generic.Error */
+body .gh { color: #000080; font-weight: bold } /* Generic.Heading */
+body .gi { color: #00A000 } /* Generic.Inserted */
+body .go { color: #808080 } /* Generic.Output */
+body .gp { color: #000080; font-weight: bold } /* Generic.Prompt */
+body .gs { font-weight: bold } /* Generic.Strong */
+body .gu { color: #800080; font-weight: bold } /* Generic.Subheading */
+body .gt { color: #0040D0 } /* Generic.Traceback */
+body .kc { color: #954121 } /* Keyword.Constant */
+body .kd { color: #954121; font-weight: bold } /* Keyword.Declaration */
+body .kn { color: #954121; font-weight: bold } /* Keyword.Namespace */
+body .kp { color: #954121 } /* Keyword.Pseudo */
+body .kr { color: #954121; font-weight: bold } /* Keyword.Reserved */
+body .kt { color: #B00040 } /* Keyword.Type */
+body .m { color: #666666 } /* Literal.Number */
+body .s { color: #219161 } /* Literal.String */
+body .na { color: #7D9029 } /* Name.Attribute */
+body .nb { color: #954121 } /* Name.Builtin */
+body .nc { color: #0000FF; font-weight: bold } /* Name.Class */
+body .no { color: #880000 } /* Name.Constant */
+body .nd { color: #AA22FF } /* Name.Decorator */
+body .ni { color: #999999; font-weight: bold } /* Name.Entity */
+body .ne { color: #D2413A; font-weight: bold } /* Name.Exception */
+body .nf { color: #0000FF } /* Name.Function */
+body .nl { color: #A0A000 } /* Name.Label */
+body .nn { color: #0000FF; font-weight: bold } /* Name.Namespace */
+body .nt { color: #954121; font-weight: bold } /* Name.Tag */
+body .nv { color: #19469D } /* Name.Variable */
+body .ow { color: #AA22FF; font-weight: bold } /* Operator.Word */
+body .w { color: #bbbbbb } /* Text.Whitespace */
+body .mf { color: #666666 } /* Literal.Number.Float */
+body .mh { color: #666666 } /* Literal.Number.Hex */
+body .mi { color: #666666 } /* Literal.Number.Integer */
+body .mo { color: #666666 } /* Literal.Number.Oct */
+body .sb { color: #219161 } /* Literal.String.Backtick */
+body .sc { color: #219161 } /* Literal.String.Char */
+body .sd { color: #219161; font-style: italic } /* Literal.String.Doc */
+body .s2 { color: #219161 } /* Literal.String.Double */
+body .se { color: #BB6622; font-weight: bold } /* Literal.String.Escape */
+body .sh { color: #219161 } /* Literal.String.Heredoc */
+body .si { color: #BB6688; font-weight: bold } /* Literal.String.Interpol */
+body .sx { color: #954121 } /* Literal.String.Other */
+body .sr { color: #BB6688 } /* Literal.String.Regex */
+body .s1 { color: #219161 } /* Literal.String.Single */
+body .ss { color: #19469D } /* Literal.String.Symbol */
+body .bp { color: #954121 } /* Name.Builtin.Pseudo */
+body .vc { color: #19469D } /* Name.Variable.Class */
+body .vg { color: #19469D } /* Name.Variable.Global */
+body .vi { color: #19469D } /* Name.Variable.Instance */
+body .il { color: #666666 } /* Literal.Number.Integer.Long */ \ No newline at end of file
diff --git a/contrib/scripts/org-docco.org b/contrib/scripts/org-docco.org
new file mode 100644
index 0000000..d846aa3
--- /dev/null
+++ b/contrib/scripts/org-docco.org
@@ -0,0 +1,206 @@
+#+Title: Org-Docco
+#+Author: Eric Schulte
+#+Style: <link rel="stylesheet" href="docco.css" type="text/css">
+#+Property: tangle yes
+
+The =docco= tool (see http://jashkenas.github.com/docco/) generates
+HTML from JavaScript source code providing an attractive side-by-side
+display of source code and comments. This file (see [[http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/scripts/org-docco.org;hb=HEAD][org-docco.org]])
+generates the same type of output from Org-mode documents with code
+embedded in code blocks.
+
+The way this works is an Org-mode document with embedded code blocks
+is exported to html using the standard Org-mode export functions.
+This file defines a new function named =org-docco-buffer= which, when
+added to the =org-export-html-final-hook=, will be run automatically
+as part of the Org-mod export process doccoizing your Org-mode
+document.
+
+A pure source code file can be extracted (or "/tangled/") from the
+Org-mode document using the normal =org-babel-tangle= function. See
+[[http://orgmode.org/manual/Working-With-Source-Code.html][Working With Source Code]] chapter of the Org-mode manual for more
+information on using code blocks in Org-mode files.
+
+*Disclaimer*: this currently only works on /very/ simple Org-mode
+files which have no headings but rather are just a collection of
+alternating text and code blocks. It wouldn't be difficult to
+generalize the following code so that it could be run in particular
+sub-trees but I simply don't have the time to do so myself, and this
+version perfectly satisfies my own limit needs. I make no promises to
+support this code moving forward. /Caveat Emptor/
+
+#+begin_src emacs-lisp :padline no
+;;; org-docco.el --- docco type html generation from Org-mode
+
+;; Copyright (C) 2012 Eric Schulte
+
+;; Author: Eric Schulte
+;; Keywords: org-mode, literate programming, html
+;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php
+;; Version: 0.01
+
+;; This file is not part of GNU Emacs.
+
+;;; License:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; <- look over there
+#+end_src
+
+The =cl= package provides all of the state-changing functions used
+below e.g., =push= and =incf=. It looks like a namespace-safe version
+of =cl= may soon be permissible for use in official Emacs packages.
+#+begin_src emacs-lisp
+;;; Code:
+(require 'cl)
+#+end_src
+
+This is a function which returns the buffer positions of matching
+regular expressions. It has two special features...
+1. It only counts matched instances of =beg-re= and =end-re= which are
+ properly nested, so for example if =beg-re= and =end-re= are set to
+ =(= and =)= respectively and we run this against the following,
+ : 1 2 3 4 5 6
+ : | | | | | |
+ : v v v v v v
+ : (foo (bar baz) (qux) quux)
+ it will return 1 and 6 rather than 1 and 3.
+2. It uses [[www.gnu.org/s/emacs/manual/html_node/elisp/Markers.html][markers]] which save their position in a buffer even as the
+ buffer is changed (e.g., by me adding in extra HTML text).
+#+begin_src emacs-lisp
+(defun org-docco-balanced-re (beg-re end-re)
+ "Return the beginning and of a balanced regexp."
+ (save-excursion
+ (save-match-data
+ (let ((both-re (concat "\\(" beg-re "\\|" end-re "\\)"))
+ (beg-count 0) (end-count 0)
+ beg end)
+ (when (re-search-forward beg-re nil t)
+ (goto-char (match-beginning 0))
+ (setq beg (point-marker))
+ (incf beg-count)
+ (goto-char (match-end 0))
+ (while (and (not end) (re-search-forward both-re nil t))
+ (goto-char (match-beginning 0))
+ (cond ((looking-at beg-re) (incf beg-count))
+ ((looking-at end-re) (incf end-count))
+ (:otherwise (error "miss-matched")))
+ (goto-char (match-end 0))
+ (when (= beg-count end-count) (setq end (point-marker))))
+ (when end (cons beg end)))))))
+#+end_src
+
+This ugly large function does the actual conversion. It wraps the
+entire main content =div= of the exported Org-mode html into a single
+large table. Each row of the table has documentation on the left side
+and code on the right side. This function has two parts.
+1. We use =(org-docco-balanced-re "<div" "</div>")= to find the
+ beginning and end of the main content div. We then break up this
+ div at =<pre></pre>= boundaries with multiple calls to
+ =(org-docco-balanced-re "<pre class\"src" "</pre>")=.
+2. With all documentation/code boundaries in hand we step through the
+ buffer inserting the table html code at boundary locations.
+#+begin_src emacs-lisp
+(defun org-docco-buffer ()
+ "Call from within an HTML buffer to doccoize it."
+ (interactive)
+ (let ((table-start "<table>\n")
+ (doc-row-start "<tr><th class=\"docs\">\n") (doc-row-end "</th>\n")
+ (code-row-start " <td class=\"code\">\n") (code-row-end "</td></tr>\n")
+ (table-end "</table>" )
+ pair transition-points next)
+ (save-excursion
+ (save-match-data
+ (goto-char (point-min))
+ (when (re-search-forward "<div id=\"content\">" nil t)
+ (goto-char (match-end 0))
+ (push (point-marker) transition-points)
+ (goto-char (match-beginning 0))
+ (setq pair (org-docco-balanced-re "<div" "</div>"))
+ (while (setq next (org-docco-balanced-re "<pre class=\"src" "</pre>"))
+ (goto-char (cdr next))
+ (push (car next) transition-points)
+ (push (cdr next) transition-points))
+ (goto-char (cdr pair))
+ (push (and (re-search-backward "</div>" nil t) (point-marker))
+ transition-points)
+ ;; collected transitions, so build the table
+ (setq transition-points (nreverse transition-points))
+ (goto-char (pop transition-points))
+ (insert table-start doc-row-start)
+ (while (> (length transition-points) 1)
+ (goto-char (pop transition-points))
+ (insert doc-row-end code-row-start)
+ (goto-char (pop transition-points))
+ (insert code-row-end doc-row-start))
+ (goto-char (pop transition-points))
+ (insert code-row-end table-end)
+ (unless (null transition-points)
+ (error "leftover points")))))))
+#+end_src
+
+We'll use Emacs [[http://www.gnu.org/software/emacs/manual/html_node/emacs/Specifying-File-Variables.html][File Local Variables]] and the
+=org-export-html-final-hook= to control which buffers have
+=org-docco-buffer= run as part of their export process.
+#+begin_src emacs-lisp
+ (defvar org-docco-doccoize-me nil
+ "File local variable controlling if html export should be doccoized.")
+ (make-local-variable 'org-docco-doccoize-me)
+#+end_src
+
+A simple function will conditionally process HTML output based on the
+value of this variable.
+#+begin_src emacs-lisp
+ (defun org-docco-buffer-maybe ()
+ (when org-docco-doccoize-me (org-docco-buffer)))
+#+end_src
+
+Finally this function is added to the =org-export-html-final-hook=.
+#+begin_src emacs-lisp
+ (add-hook 'org-export-html-final-hook #'org-docco-buffer-maybe)
+#+end_src
+
+That's it. To use this simply;
+1. Checkout this file from https://github.com/eschulte/org-docco,
+ : git clone git://github.com/eschulte/org-docco.git
+ and open it using Emacs.
+2. Tangle =org-docco.el= out of this file by calling
+ =org-babel-tangle= or =C-c C-v t=.
+3. Load the resulting Emacs Lisp file.
+4. Execute the following in any Org-mode buffer to add file local
+ variable declarations which will enable post-processed with
+ =org-docco-buffer=.
+ : (add-file-local-variable 'org-export-html-postamble nil)
+ : (add-file-local-variable 'org-export-html-style-include-default nil)
+ : (add-file-local-variable 'org-docco-doccoize-me t)
+ And add the following style declaration to make use of the
+ =docco.css= style sheet taken directly from
+ https://github.com/jashkenas/docco.
+ : #+Style: <link rel="stylesheet" href="docco.css" type="text/css">
+
+#+begin_src emacs-lisp
+(provide 'org-docco)
+;;; org-docco.el ends here
+#+end_src
+
+# Local Variables:
+# org-export-html-postamble: nil
+# org-export-html-style-include-default: nil
+# org-docco-doccoize-me: t
+# End:
diff --git a/contrib/scripts/org2hpda b/contrib/scripts/org2hpda
new file mode 100755
index 0000000..de0b573
--- /dev/null
+++ b/contrib/scripts/org2hpda
@@ -0,0 +1,106 @@
+# org2hpda - a small utility to generate hipster pda style printouts from org mode
+# Copyright (C) 2007-2012 Christian Egli
+#
+# Version: 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:
+# ===========
+#
+# set cal-tex-diary to true so that diary entries show up in the calendar
+#
+# Usage:
+# ======
+#
+# run this makefile with
+#
+# make -f org2hpda
+#
+# The makfile will take the entries from your diary file and generate
+# two PDFs containing nicely printed weekly and monthly calendars. One
+# is done in the style of a pocketMod (http://www.pocketmod.com/) and
+# the other is done in the style of the Hipster PDA
+# (http://en.wikipedia.org/wiki/Hipster_PDA).
+#
+# Requirements:
+# =============
+#
+# the pdf* commands are part of the pdfjam package which can be found
+# at http://www.warwick.ac.uk/go/pdfjam
+
+EMACS = emacs -batch -l ~/.emacs
+LATEX = latex
+DIARY = $($(EMACS) -eval "diary-file")
+
+# Number of weeks to be printed. Should be a multiple of 4, because 4
+# of them are merged on one page. Can be set when invoking the script
+# as follows: make NUMBER_OF_WEEKS=8 -f org2hpda
+NUMBER_OF_WEEKS = 4
+
+hipsterFiles = weekCalendar.pdf yearCalendar.pdf monthCalendar3.pdf monthCalendar2.pdf monthCalendar1.pdf
+pocketModFiles = weekCalendar.pdf yearCalendar-rotated.pdf \
+ monthCalendar3-rotated.pdf monthCalendar2-rotated.pdf monthCalendar1-rotated.pdf
+
+all: pocketMod.pdf hipsterPDA.pdf
+
+%.dvi: %.tex
+ # Quick hack to massage the LaTeX produced by cal-tex
+ # quote '@', then increase font size of week calendars,
+ # increase font of diary entries in moth calendar and
+ # finally reduce links to their destination, i.e.
+ # change '[[http://foo][bar]]' to 'bar'
+ sed -e 's/\\verb|@|/\@/g' \
+ -e 's/documentclass\[11pt\]/documentclass[12pt]/g' \
+ -e 's/{\\tiny \\raggedright #3}/{\\small \\raggedright #3}/g' \
+ -e 's/\[\[[^]]\+\]\[\([^]]\+\)\]\]/\1/g' \
+ < $< > /tmp/temp-org-file.$$$$; mv /tmp/temp-org-file.$$$$ $<
+ $(LATEX) $^
+
+%.pdf: %.dvi
+ dvipdf $^
+
+%-rotated.pdf: %.pdf
+ cp $^ $@
+ for n in 1 2 3; do \
+ pdf90 --quiet --outfile tmp.pdf $@; mv tmp.pdf $@; \
+ done
+
+weekCalendar.tex: $(DIARY)
+ $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-week-iso $(NUMBER_OF_WEEKS)) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
+
+monthCalendar1.tex: $(DIARY)
+ $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
+
+monthCalendar2.tex: $(DIARY)
+ $(EMACS) -eval "(progn (calendar) (calendar-forward-month 1) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
+
+monthCalendar3.tex: $(DIARY)
+ $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
+
+yearCalendar.tex: $(DIARY)
+ $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2) (cal-tex-cursor-year-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
+
+pocketMod.pdf: $(pocketModFiles)
+ pdfjoin --quiet --outfile tmp.pdf $^
+ pdfnup tmp.pdf --quiet --outfile $@ --nup 4x2 --frame true
+
+hipsterPDA.pdf: $(hipsterFiles)
+ pdfnup weekCalendar.pdf --quiet --outfile page1.pdf --batch --nup 2x2 --frame true --no-landscape
+ pdfjoin --quiet --outfile tmp.pdf monthCalendar[1-3]-rotated.pdf yearCalendar-rotated.pdf
+ pdfnup tmp.pdf --quiet --outfile page2.pdf --batch --nup 2x2 --frame true --no-landscape
+ pdfjoin --quiet --outfile $@ page1.pdf page2.pdf
+
+clean:
+ rm -rf *.aux *.dvi *.tex *.log *.pdf
diff --git a/contrib/scripts/staticmathjax/.gitignore b/contrib/scripts/staticmathjax/.gitignore
new file mode 100644
index 0000000..b25c15b
--- /dev/null
+++ b/contrib/scripts/staticmathjax/.gitignore
@@ -0,0 +1 @@
+*~
diff --git a/contrib/scripts/staticmathjax/README.org b/contrib/scripts/staticmathjax/README.org
new file mode 100644
index 0000000..d28fc90
--- /dev/null
+++ b/contrib/scripts/staticmathjax/README.org
@@ -0,0 +1,79 @@
+Static MathJax v0.1 README
+#+AUTHOR: Jan Böcker <jan.boecker@jboecker.de>
+
+Static MathJax is a XULRunner application which loads a HTML input
+file that uses MathJax into a browser, waits until MathJax is done
+processing, and then writes the formatted result to an output HTML
+file.
+
+I have only tested exports from Emacs Org-mode as input files. (As of
+2010-08-14, MathJax is used by default with HTML exports in the
+current Org development version.)
+
+Optionally, references to the math fonts used will be converted to
+"data:" URIs, thus embedding the font data into the HTML file itself.
+(see [[http://en.wikipedia.org/wiki/Data_URI_scheme]])
+
+The code is licensed under the GNU General Public License version
+2, or, at your option, any later version.
+
+
+* Usage
+ To run Static MathJax, an existing XULRunner installation is
+ required. From the directory to which you unpacked Static MathJax,
+ run:
+
+ xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>>
+ <input file> <output file>
+
+ If you prefer to call "staticmathjax" instead of "xulrunner
+ application.ini", link xulrunner-stub into the directory:
+ ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax
+
+ - input file ::
+ name of the input file (the result of a HTML export
+ from Org-mode). It is assumed that this file uses the
+ UTF-8 character encoding.
+
+ - output file ::
+ name of the output file.
+
+ - --embed-fonts ::
+ if specified, the math fonts will be embedded into
+ the output file using data: URIs
+
+ - --final-mathjax-url <URL> ::
+ if --embed-fonts is not specified, this
+ must be the URL to a MathJax installation folder (e.g. "MathJax"
+ if MathJax is installed in a subdirectory, or
+ "http://orgmode.org/mathjax" to use the version hosted on the Org
+ website.
+
+ All references to math fonts in the output file will point to
+ this directory.
+
+* Caveats
+
+ The input file must not use a MathJax installation on the
+ web. Otherwise, due to a security feature of Firefox, MathJax will
+ fallback to image fonts. If you have unpacked MathJax to a
+ subdirectory "MathJax", specify the following in your Org file:
+
+ #+MathJax: path:"MathJax"
+
+ The math is rendered in Firefox, so MathJax applies its
+ Firefox-specific settings. When viewing the output files in other
+ browsers, it will look slightly different than the result that
+ running MathJax in that browser would produce.
+
+ Internet Explorer does not use the correct font, because it only
+ supports the EOT font format. For all other browsers (including
+ Firefox), MathJax uses the OTF font format.
+
+ Embedding fonts into the HTML file wastes some space due to the
+ base64 encoding used in data: URIs.
+
+ I have found no way to access stdout or set an exit code in an
+ XULRunner app, so any code which calls Static MathJax has no idea if
+ processing was successful and when an error occurs, graphical
+ message boxes are displayed.
diff --git a/contrib/scripts/staticmathjax/application.ini b/contrib/scripts/staticmathjax/application.ini
new file mode 100644
index 0000000..d7957b0
--- /dev/null
+++ b/contrib/scripts/staticmathjax/application.ini
@@ -0,0 +1,11 @@
+[App]
+Vendor=Jan Boecker
+Name=StaticMathJax
+Version=0.2
+BuildID=2
+Copyright=Copyright (c) 2010 Jan Boecker
+ID=xulapp@jboecker.de
+
+[Gecko]
+MinVersion=1.8
+
diff --git a/contrib/scripts/staticmathjax/chrome/chrome.manifest b/contrib/scripts/staticmathjax/chrome/chrome.manifest
new file mode 100644
index 0000000..a05d8c8
--- /dev/null
+++ b/contrib/scripts/staticmathjax/chrome/chrome.manifest
@@ -0,0 +1 @@
+content staticmathjax file:content/
diff --git a/contrib/scripts/staticmathjax/chrome/content/main.js b/contrib/scripts/staticmathjax/chrome/content/main.js
new file mode 100644
index 0000000..2e71f3b
--- /dev/null
+++ b/contrib/scripts/staticmathjax/chrome/content/main.js
@@ -0,0 +1,198 @@
+var docFrame;
+var logtextbox;
+var destFile;
+var embedFonts = false;
+var finalMathJaxURL = null;
+
+function log(text)
+{
+ logtextbox.setAttribute("value", logtextbox.getAttribute("value") + "\n" + text);
+}
+
+function init()
+{
+ try {
+ docFrame = document.getElementById("docFrame");
+ logtextbox = document.getElementById("logtextbox");
+
+ // parse command line arguments
+ var cmdLine = window.arguments[0];
+ cmdLine = cmdLine.QueryInterface(Components.interfaces.nsICommandLine);
+
+ embedFonts = cmdLine.handleFlag("embed-fonts", false);
+ finalMathJaxURL = cmdLine.handleFlagWithParam("final-mathjax-url", false);
+
+ if (!embedFonts && !finalMathJaxURL) {
+ alert("You must eiher specify --embed-fonts or --final-mathjax-url");
+ window.close();
+ return;
+ }
+
+ sourceFilePath = cmdLine.getArgument(0);
+ destFilePath = cmdLine.getArgument(1);
+ if ( !sourceFilePath || !destFilePath ) {
+ alert("Not enough parameters, expecting two arguments:\nInput file, output file");
+ window.close();
+ return;
+ }
+
+ sourceFile = cmdLine.resolveFile(sourceFilePath);
+ if (! (sourceFile.exists() && sourceFile.isFile()) ) {
+ alert("Invalid source file path.");
+ window.close();
+ return;
+ }
+ sourceURI = cmdLine.resolveURI(sourceFilePath);
+
+ // create a nsIFile object for the output file
+ try{
+ destFile = cmdLine.resolveURI(destFilePath).QueryInterface(Components.interfaces.nsIFileURL).file;
+ }catch(e){
+ alert("Invalid destination file.\n\nException:\n" + e);
+ window.close();
+ return;
+ }
+
+ // add iframeLoaded() as an onload event handler, then navigate to the source file
+ docFrame.addEventListener("DOMContentLoaded", iframeLoaded, true);
+ docFrame.setAttribute("src", sourceURI.spec);
+
+ } catch (e) {
+ alert("Error in init():\n\n" + e);
+ window.close();
+ return;
+ }
+}
+
+function iframeLoaded()
+{
+ /*
+ // print every MathJax signal to the log
+ docFrame.contentWindow.MathJax.Hub.Startup.signal.Interest(
+ function (message) {log("Startup: "+message)}
+ );
+ docFrame.contentWindow.MathJax.Hub.signal.Interest(
+ function (message) {log("Hub: "+message)}
+ );
+ */
+
+ // tell MathJax to call serialize() when finished
+ docFrame.contentWindow.MathJax.Hub.Register.StartupHook("End", function() {serialize();});
+}
+
+function fileURLtoDataURI(url)
+{
+ var ios = Components.classes["@mozilla.org/network/io-service;1"]
+ .getService(Components.interfaces.nsIIOService);
+ var url_object = ios.newURI(url, "", null);
+ var file = url_object.QueryInterface(Components.interfaces.nsIFileURL).file;
+
+ var data = "";
+ var fstream = Components.classes["@mozilla.org/network/file-input-stream;1"].
+ createInstance(Components.interfaces.nsIFileInputStream);
+ fstream.init(file, -1, -1, false);
+ var bstream = Components.classes["@mozilla.org/binaryinputstream;1"].
+ createInstance(Components.interfaces.nsIBinaryInputStream);
+ bstream.setInputStream(fstream);
+
+ var bytes = bstream.readBytes(bstream.available());
+ b64bytes = btoa(bytes);
+
+ return "data:;base64," + b64bytes;
+
+}
+
+function serialize()
+{
+ var MathJaxURL = docFrame.contentWindow.MathJax.Hub.config.root;
+
+ var searchURIList = new Array();
+ var replacementURIList = new Array();
+
+ log("serialize: preprocessing");
+
+ // remove the MathJax status message window
+ msgdiv = docFrame.contentDocument.getElementById("MathJax_Message");
+ msgdiv.parentNode.removeChild(msgdiv);
+
+ /* Loop through all CSS rules to find all @font-face rules.
+ At this point, they refer to local absolute paths using file:// URLs.
+ Replace them either with appropriate URLs relative to finalMathJaxURL
+ or with data URIs. */
+
+ for (var i = 0; i<docFrame.contentDocument.styleSheets.length; i++) {
+ var stylesheet = docFrame.contentDocument.styleSheets[i];
+
+ for (var j=0; j< stylesheet.cssRules.length; j++) {
+ var rule = stylesheet.cssRules[j];
+ if (rule.cssText.match("font-face")) {
+
+ url = rule.style.getPropertyValue("src");
+ url = url.match(/url\(\"(.+)\"\)/)[1];
+
+ // Since the properties seem read-only here, we populate
+ // searchURIList and replacementURIList to do text substitution
+ // after serialization
+ searchURIList.push(url);
+ if (embedFonts) {
+ replacementURIList.push(fileURLtoDataURI(url));
+ } else {
+ replacementURIList.push(url.replace(MathJaxURL, finalMathJaxURL));
+ }
+ }
+ }
+ }
+
+
+ // find and remove the MathJax <script> tag
+ try{
+ var scriptTags = docFrame.contentDocument.getElementsByTagName("script");
+ for (var i=0; i<scriptTags.length; i++) {
+ if (scriptTags[i].getAttribute("src") && scriptTags[i].getAttribute("src").match(/MathJax.js/i))
+ scriptTags[i].parentNode.removeChild(scriptTags[i]);
+ }
+ }catch(e){alert(e);}
+
+ log("serialize: serializing");
+
+ var serializer = new XMLSerializer();
+ var xhtml = serializer.serializeToString(docFrame.contentDocument);
+
+ log("serialize: postprocessing");
+ // make the MathJax URL relative again
+ // xhtml = xhtml.replace(findMathJaxURL, "MathJax");
+
+ try{
+ r1 = RegExp("&lt;!--/\\*--&gt;&lt;!\\[CDATA\\[/\\*&gt;&lt;!--\\*/", "g");
+ xhtml = xhtml.replace(r1, "");
+ r2 = RegExp("/\\*\\]\\]&gt;\\*/--&gt;", "g");
+ xhtml = xhtml.replace(r2, "");
+ r3 = RegExp("/\\*\\]\\]&gt;\\*///--&gt;", "g");
+ xhtml = xhtml.replace(r3, "");
+ }catch(e){alert(e);}
+ for (var i=0; i<searchURIList.length; i++)
+ xhtml = xhtml.replace(searchURIList[i], replacementURIList[i]);
+
+ save(xhtml);
+ window.close();
+}
+
+function save(xhtml)
+{
+ try {
+ var foStream = Components.classes["@mozilla.org/network/file-output-stream;1"].
+ createInstance(Components.interfaces.nsIFileOutputStream);
+
+ foStream.init(destFile, 0x02 | 0x08 | 0x20, 0666, 0);
+ // write, create, truncate
+
+ // write in UTF-8 encoding
+ var converter = Components.classes["@mozilla.org/intl/converter-output-stream;1"].
+ createInstance(Components.interfaces.nsIConverterOutputStream);
+ converter.init(foStream, "UTF-8", 0, 0);
+ converter.writeString(xhtml);
+ converter.close(); // this closes foStream
+ } catch (e) {
+ alert("Error in save():\n\n" + e);
+ }
+}
diff --git a/contrib/scripts/staticmathjax/chrome/content/main.xul b/contrib/scripts/staticmathjax/chrome/content/main.xul
new file mode 100644
index 0000000..35a00f2
--- /dev/null
+++ b/contrib/scripts/staticmathjax/chrome/content/main.xul
@@ -0,0 +1,11 @@
+<?xml version="1.0"?>
+<?xml-stylesheet href="chrome://global/skin/" type="text/css"?>
+
+<window onload="init();" id="main" title="Static MathJax" width="300" height="300"
+xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul">
+
+<script language="JavaScript" src="chrome://staticmathjax/content/main.js"/>
+
+ <browser flex="1" id="docFrame" src="" style="background-color:white;"/>
+ <textbox flex="1" id="logtextbox" multiline="true" style="display:none;"/>
+</window>
diff --git a/contrib/scripts/staticmathjax/defaults/preferences/prefs.js b/contrib/scripts/staticmathjax/defaults/preferences/prefs.js
new file mode 100644
index 0000000..0532ce0
--- /dev/null
+++ b/contrib/scripts/staticmathjax/defaults/preferences/prefs.js
@@ -0,0 +1 @@
+pref("toolkit.defaultChromeURI", "chrome://staticmathjax/content/main.xul");
diff --git a/debian/README.Debian b/debian/README.Debian
new file mode 100644
index 0000000..8389f2d
--- /dev/null
+++ b/debian/README.Debian
@@ -0,0 +1,7 @@
+To enable contributed extensions to org-mode, simply add
+"/usr/share/org-mode/lisp" to your load-path, for instance in your
+.emacs with:
+
+ (setq load-path (cons "/usr/share/org-mode/lisp" load-path))
+
+ -- Sebastien Delafond <seb@debian.org>, Thu, 1 Oct 2009 11:11:26 +0200
diff --git a/debian/changelog b/debian/changelog
new file mode 100644
index 0000000..8282ac5
--- /dev/null
+++ b/debian/changelog
@@ -0,0 +1,416 @@
+org-mode (7.9.2-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 30 Oct 2012 08:45:52 +0100
+
+org-mode (7.9.1-3) unstable; urgency=low
+
+ * Fix FTBFS since org-mode now requires emacs to be built (Closes:
+ #691768)
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 29 Oct 2012 16:19:40 +0100
+
+org-mode (7.9.1-2) unstable; urgency=low
+
+ * Also generate the PDF reference card (Closes: #690030)
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 09 Oct 2012 10:55:13 +0200
+
+org-mode (7.9.1-1) unstable; urgency=low
+
+ * New upstream release (Closes: #685154, #668496, #688673)
+ * Updated watch file again
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 13 Sep 2012 14:53:00 +0200
+
+org-mode (7.8.11-2) unstable; urgency=low
+
+ * Fix dependencies to include current versions of emacs in unstable
+ (Closes: #682713)
+ * Proper watch file
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 13 Aug 2012 12:32:11 +0200
+
+org-mode (7.8.11-1) unstable; urgency=low
+
+ * New upstream release
+ * Simpler debian/watch file
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 20 Jun 2012 11:36:07 +0200
+
+org-mode (7.8.09-1) unstable; urgency=low
+
+ * New upstream release (Closes: #670270)
+ * Updated debian/watch file
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 25 Apr 2012 15:20:15 +0200
+
+org-mode (7.8.06-2) unstable; urgency=low
+
+ * Really fix the style files (Closes: #655652)
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 26 Mar 2012 10:56:00 +0200
+
+org-mode (7.8.06-1) unstable; urgency=low
+
+ * New upstream release (Closes: #655652)
+ * Bumped up Standards-Version.
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 25 Mar 2012 17:10:16 +0200
+
+org-mode (7.7-3) unstable; urgency=low
+
+ * More conventional debian/rules, not requiring root; thanks Colin
+ Watson <cjwatson@ubuntu.com> for the patch (Closes: #648425)
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 11 Nov 2011 15:09:35 +0100
+
+org-mode (7.7-2) unstable; urgency=low
+
+ * Fix FTBFS (Closes: #643235)
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 27 Sep 2011 11:27:02 +0200
+
+org-mode (7.7-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Sat, 10 Sep 2011 15:30:43 +0200
+
+org-mode (7.6-1) unstable; urgency=low
+
+ * New upstream release (Closes: #632158).
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 07 Jul 2011 15:45:26 +0200
+
+org-mode (7.5-2) unstable; urgency=low
+
+ * Also install .el files (Closes: #623376).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 09 May 2011 12:18:52 +0200
+
+org-mode (7.5-1) unstable; urgency=low
+
+ * New upstream release (Closes: #623208).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 18 Apr 2011 14:52:41 +0200
+
+org-mode (7.4-1) unstable; urgency=low
+
+ * New upstream release
+ * Handle ditaa more nicely (Closes: #607258).
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 22 Dec 2010 14:13:18 +0100
+
+org-mode (7.3-3) unstable; urgency=low
+
+ * Explicitly exclude xemacs from byte-compilation (Closes: #602803).
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 12 Nov 2010 11:35:10 +0100
+
+org-mode (7.3-2) unstable; urgency=low
+
+ * Do not support xemacs21 anymore; the upstream changelog clearly mentions
+ that "XEmacs support requires the XEmacs development version", which
+ is not packaged for Debian (Closes: #602803).
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 10 Nov 2010 16:23:30 +0100
+
+org-mode (7.3-1) unstable; urgency=low
+
+ * New upstream release (Closes: #602196).
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 07 Nov 2010 18:17:47 +0100
+
+org-mode (7.01h-1) unstable; urgency=low
+
+ * New upstream release.
+ * Bumped up Standards-Version.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 07 Sep 2010 14:46:10 +0200
+
+org-mode (7.01g-1) unstable; urgency=low
+
+ * New upstream release (Closes: #589853).
+ * Bumped up Standards-Version.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 22 Jul 2010 14:14:51 +0200
+
+org-mode (6.36c-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 19 May 2010 13:31:31 +0200
+
+org-mode (6.35i-1) unstable; urgency=low
+
+ * New upstream release.
+ * Do not include org-freemind for xemacs (Closes: #577496).
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 13 Apr 2010 15:09:27 +0200
+
+org-mode (6.35h-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 12 Apr 2010 10:33:56 +0200
+
+org-mode (6.35g-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Sat, 10 Apr 2010 12:15:35 +0200
+
+org-mode (6.35f-1) unstable; urgency=low
+
+ * New upstream release.
+ * Removed incorrect Vcs-* info.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 08 Apr 2010 12:48:18 +0200
+
+org-mode (6.34c-4) unstable; urgency=low
+
+ * Proper unescaping in links (Closes: #572404.)
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 05 Mar 2010 10:45:05 +0100
+
+org-mode (6.34c-3) unstable; urgency=low
+
+ * Swith to 3.0(quilt) source format.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 02 Mar 2010 08:29:45 +0100
+
+org-mode (6.34c-2) unstable; urgency=low
+
+ * Add easypg as a Suggest, to enable org-crypt functionalities.
+ * Bumped up Standards-Version.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 16 Feb 2010 16:25:35 +0100
+
+org-mode (6.34c-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 29 Jan 2010 15:48:44 +0100
+
+org-mode (6.33f-2) unstable; urgency=low
+
+ * New upstream release.
+ * Remove ditaa.jar from both the source and binary packages, as its
+ source code is not available (Closes: #565250). Seems 528117 crept
+ back somehow.
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 29 Jan 2010 15:41:21 +0100
+
+org-mode (6.32b-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 29 Oct 2009 10:22:45 +0100
+
+org-mode (6.31a-3) unstable; urgency=low
+
+ * Add ORed dependency on emacs-snapshot (Closes: #551729).
+ * Removed explicit version-depend on dpkg.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 22 Oct 2009 21:15:59 +0200
+
+org-mode (6.31a-2) unstable; urgency=low
+
+ * New Vcs-Git and Homepage fields in debian/control.
+ * Lintian cleanups.
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 19 Oct 2009 16:13:16 +0200
+
+org-mode (6.31a-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 08 Oct 2009 14:45:55 +0200
+
+org-mode (6.31-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Wed, 30 Sep 2009 21:05:03 +0200
+
+org-mode (6.30e-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 28 Sep 2009 16:57:29 +0200
+
+org-mode (6.29c+1-3) unstable; urgency=low
+
+ * Doh: emacs 23, not emacs-23 (Closes: #541651).
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 16 Aug 2009 17:34:50 +0200
+
+org-mode (6.29c+1-2) unstable; urgency=low
+
+ * OR'ed depend on emacs23 as well (Closes: #541651).
+
+ -- Sebastien Delafond <seb@debian.org> Sat, 15 Aug 2009 11:44:49 +0200
+
+org-mode (6.29c+1-1) unstable; urgency=low
+
+ * Clarify licensing of org-mode's documentation in debian/copyright, and
+ correct packaging bug in 6.27a-1 and 6.29c-1 where the wrong,
+ GFDL-only version of the manual was accidentally included (Closes:
+ #540736).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 10 Aug 2009 12:38:39 +0200
+
+org-mode (6.29c-1) unstable; urgency=low
+
+ * New upstream release
+ * Bumped up standards revision.
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 10 Aug 2009 09:02:41 +0200
+
+org-mode (6.27a-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 16 Jun 2009 12:47:51 +0200
+
+org-mode (6.26d-1) unstable; urgency=low
+
+ * New upstream release.
+ * Remove ditaa.jar from both the source and binary packages, as its
+ source code is not available (Closes: #528117).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 11 May 2009 02:16:35 -0700
+
+org-mode (6.26a-4) unstable; urgency=low
+
+ * xemacs21 is fine, as it has url.el.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 21 Apr 2009 05:35:05 -0700
+
+org-mode (6.26a-3) unstable; urgency=low
+
+ * Do not support emacs21 and xemacs21 anymore; upstream author mentioned
+ he will "not willingly break Emacs 21 support, but no longer will make
+ any effort to adapt code for it" (Closes: #524951).
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 21 Apr 2009 05:25:46 -0700
+
+org-mode (6.26a-2) unstable; urgency=low
+
+ * Fix void symbol in startup file; thanks Antonio P. P. Almeida for the
+ patch (Closes: #524941).
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 21 Apr 2009 02:10:47 -0700
+
+org-mode (6.26a-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 20 Apr 2009 00:08:53 -0700
+
+org-mode (6.25e-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 09 Apr 2009 11:23:38 -0700
+
+org-mode (6.24b-1) unstable; urgency=low
+
+ * New upstream release (Closes: #519559).
+ * Update watch file so it doesn't match the snapshot release.
+ * Remove .DS_Store accidentally included in upstream tarball.
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 13 Mar 2009 06:53:16 -0700
+
+org-mode (6.21b-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 02 Feb 2009 14:10:42 -0800
+
+org-mode (6.19b-1) unstable; urgency=low
+
+ * New upstream release.
+ * Do not byte-compile *.el file more than once, and log said compilation
+ to a temp file (inspired from emacs-goodies-el's install script).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 26 Jan 2009 08:41:17 -0800
+
+org-mode (6.17c-1) unstable; urgency=low
+
+ * New upstream release.
+ * Updated debian/watch to account for index.html renaming to index.html.
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 18 Jan 2009 19:01:30 -0800
+
+org-mode (6.16c-1) unstable; urgency=low
+
+ * New upstream release
+ * Ship up-to-date version of the manual (Closes: #508758).
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 28 Dec 2008 06:24:35 -0800
+
+org-mode (6.14-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 14 Dec 2008 13:15:23 -0800
+
+org-mode (6.12b-1) unstable; urgency=low
+
+ * New upstream version (Closes: #506368).
+
+ -- Sebastien Delafond <seb@debian.org> Thu, 20 Nov 2008 15:17:51 -0800
+
+org-mode (6.10-1) unstable; urgency=low
+
+ * New upstream version.
+ * Updated debian/watch so it doesn't break uscan from latest devscripts
+ (Closes: #503235).
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 24 Oct 2008 12:12:44 -0700
+
+org-mode (6.09a-1) unstable; urgency=low
+
+ * New upstream version.
+ * Alternate dependency on emacs-snapshot (Closes: #502137).
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 14 Oct 2008 09:51:48 -0700
+
+org-mode (6.06b-1) unstable; urgency=low
+
+ * New upstream version (Closes: #490096).
+ * Added debian/watch file.
+ * Better autoload mechanism through "(require 'org-install)".
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 15 Aug 2008 11:44:09 -0700
+
+org-mode (6.05-2) unstable; urgency=low
+
+ * List all copyright holders for the contributions in a separate stanza
+ in debian/copyright.
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 17 Jun 2008 12:36:30 -0700
+
+org-mode (6.05-1) unstable; urgency=low
+
+ * Package the dual-licensed (GPL+GFDL) version of the manual (many
+ thanks to Carsten Dominik for providing this).
+
+ -- Sebastien Delafond <seb@debian.org> Tue, 17 Jun 2008 08:55:36 -0700
+
+org-mode (6.02b-2) unstable; urgency=low
+
+ * Explicitely mention that org's documentation is licensed under the
+ GFDL with no Invariant Sections.
+
+ -- Sebastien Delafond <seb@debian.org> Fri, 23 May 2008 08:05:26 -0700
+
+org-mode (6.02b-1) unstable; urgency=low
+
+ * Initial Release (Closes: #477504, #445329).
+
+ -- Sebastien Delafond <seb@debian.org> Mon, 12 May 2008 17:02:07 -0700
+
diff --git a/debian/compat b/debian/compat
new file mode 100644
index 0000000..1e8b314
--- /dev/null
+++ b/debian/compat
@@ -0,0 +1 @@
+6
diff --git a/debian/control b/debian/control
new file mode 100644
index 0000000..16b2545
--- /dev/null
+++ b/debian/control
@@ -0,0 +1,28 @@
+Source: org-mode
+Section: misc
+Priority: optional
+Maintainer: Sebastien Delafond <seb@debian.org>
+Build-Depends: debhelper (>= 6)
+Build-Depends-Indep: texinfo, texlive-latex-base, emacs | emacs24 | emacs23
+Standards-Version: 3.9.3
+Homepage: http://orgmode.org
+
+Package: org-mode
+Architecture: all
+Depends: ${misc:Depends}, emacs24 | emacs23
+Suggests: remember-el, easypg, ditaa
+Description: keep notes, maintain ToDo lists, and do project planning in emacs
+ Org-mode is a mode for keeping notes, maintaining ToDo lists, and
+ doing project planning with a fast and effective plain-text system.
+ .
+ Org-mode develops organizational tasks around NOTES files that contain
+ information about projects as plain text. Org-mode is implemented on
+ top of outline-mode, which makes it possible to keep the content of
+ large files well structured. Visibility cycling and structure editing
+ help to work with the tree. Tables are easily created with a built-in
+ table editor. Org-mode supports ToDo items, deadlines, time stamps,
+ and scheduling. It dynamically compiles entries into an agenda. Plain
+ text URL-like links connect to websites, emails, Usenet messages,
+ BBDB entries, and any files related to the projects. For printing and
+ sharing of notes, an Org-mode file can be exported as a structured
+ ASCII file, HTML, and LaTeX.
diff --git a/debian/copyright b/debian/copyright
new file mode 100644
index 0000000..ea8771b
--- /dev/null
+++ b/debian/copyright
@@ -0,0 +1,92 @@
+This package was debianized by Sebastien Delafond <seb@debian.org> on
+Mon, 12 May 2008 16:57:37 -0700
+
+It was downloaded from http://orgmode.org
+
+Upstream author: Carsten Dominik <carsten@orgmode.org>
+
+Copyright:
+
+ org-mode:
+ =========
+ org-mode is Copyright (C) 2004, 2005, 2006, 2007, 2008 Free
+ Software Foundation, Inc.
+
+ 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; version 2 dated June, 1991.
+
+ 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 this package; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+ 02110-1301, USA.
+
+ contributions:
+ ==============
+ org-annotate.el is Copyright (C) 2008 Philip Jackson
+
+ lisp/org-elisp-symbol.el, lisp/org-toc.el, lisp/org2rem.el and
+ lisp/org-registry.el are Copyright 2007 Bastien Guerry
+
+ lisp/org-mairix.el is Copyright (C) 2007 Georg C. F. Greve
+
+ lisp/org-screen.el is Copyright (c) 2008 Andrew Hyatt
+
+ packages/org-export-freemind-0.1.0/org-export-freemind.el is
+ Copyright (C) 2007 Marco Vezzoli
+
+ scripts/org2hpda is Copyright (C) 2007 Christian Egli
+
+ All the contributions are licensed under the GPL:
+
+ 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; version 2 dated June, 1991.
+
+ 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 this package; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+ 02110-1301, USA.
+
+ org-mode's documentation:
+ =========================
+
+ orgcard.tex
+ -----------
+
+ % Copyright (C) 1987, 1993, 1996, 1997, 2001, 2002, 2003, 2004, 2005,
+ % 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+ % This file is part of GNU Emacs.
+
+ % GNU Emacs is free software: you can redistribute it and/or modify
+ % it under the terms of the GNU General Public License as published by
+ % the Free Software Foundation, either version 3 of the License, or
+ % (at your option) any later version.
+
+
+ The Org Manual
+ --------------
+
+ Debian exercises the following copyright license grant from the
+ file ‘org_dual_license.texi’ in the source:
+
+ Copyright © 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation
+
+ Permission is also granted to copy, distribute and/or modify this document
+ under the terms of the GNU General Public License (GPL).
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
+
+On Debian systems, the complete text of version 3 of the GNU General
+Public License can be found in ‘/usr/share/common-licenses/GPL-3’.
diff --git a/debian/dirs b/debian/dirs
new file mode 100644
index 0000000..18601bf
--- /dev/null
+++ b/debian/dirs
@@ -0,0 +1 @@
+usr/share/emacs/site-lisp/org-mode
diff --git a/debian/doc-base b/debian/doc-base
new file mode 100644
index 0000000..0ea41f0
--- /dev/null
+++ b/debian/doc-base
@@ -0,0 +1,11 @@
+Document: org-mode
+Title: Org Manual
+Abstract: This manual describes what org-mode is, and how to use it
+Section: Editors
+
+Format: PDF
+Files: /usr/share/doc/org-mode/*.pdf.gz
+
+Format: info
+Index: /usr/share/info/org.gz
+Files: /usr/share/info/org.gz
diff --git a/debian/emacsen-install b/debian/emacsen-install
new file mode 100644
index 0000000..34eb5fc
--- /dev/null
+++ b/debian/emacsen-install
@@ -0,0 +1,56 @@
+#! /bin/sh -e
+# /usr/lib/emacsen-common/packages/install/org-mode
+
+# Written by Jim Van Zandt <jrv@debian.org>, borrowing heavily
+# from the install scripts for gettext by Santiago Vila
+# <sanvila@ctv.es> and octave by Dirk Eddelbuettel <edd@debian.org>.
+
+FLAVOR=$1
+PACKAGE=org-mode
+STAMPFILE=org-wl.elc
+LOG=$(tempfile -pelc_ -s.log -m644)
+
+case ${FLAVOR} in
+ emacs) exit 0 ;; # generic emacs package
+ emacs21) exit 0 ;; # not supported anymore as of 6.26a-3
+ xemacs*) exit 0 ;; # not supported anymore as of 7.x
+esac
+
+echo "install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR}, logged in ${LOG}"
+
+FLAVORTEST=$(echo $FLAVOR | cut -c-6)
+SITEFLAG="--no-site-file"
+FILES="/usr/share/emacs/site-lisp/${PACKAGE}/*.el"
+DATAFILES="/usr/share/emacs/site-lisp/${PACKAGE}/etc/styles/*.xml"
+DATADIR="/usr/share/${FLAVOR}/site-lisp/${PACKAGE}/etc/styles"
+
+mkdir -p ${DATADIR}
+cd ${DATADIR}
+for i in ${DATAFILES}; do
+ ln -fs $i
+done
+
+ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE}
+install -m 755 -d ${ELCDIR}
+cd ${ELCDIR}
+for i in ${FILES}; do
+ ln -fs $i
+done
+if [ -n "$EXCLUDE_FILES" ] ; then
+ rm -f ${ELCDIR}/${EXCLUDE_FILES}
+fi
+
+FLAGS="${SITEFLAG} -q -batch -l path.el -f batch-byte-compile"
+
+cat << EOF > path.el
+(setq load-path (cons "." load-path))
+(setq byte-compile-warnings nil)
+EOF
+
+echo ${FLAVOR} ${FLAGS} *.el > ${LOG}
+${FLAVOR} ${FLAGS} *.el >> ${LOG} 2>& 1
+egrep -s -e "While compiling|\*\*" ${LOG} || /bin/true
+echo install/${PACKAGE}: Deleting ${LOG}
+rm -f path.el*
+
+exit 0
diff --git a/debian/emacsen-remove b/debian/emacsen-remove
new file mode 100644
index 0000000..d5a208c
--- /dev/null
+++ b/debian/emacsen-remove
@@ -0,0 +1,13 @@
+#!/bin/sh -e
+# /usr/lib/emacsen-common/packages/remove/org-mode
+
+FLAVOR=$1
+PACKAGE=org-mode
+
+case ${FLAVOR} in
+ emacs) exit 0 ;; # generic emacs package
+ emacs21) exit 0 ;; # not supported anymore as of 6.26a-3
+esac
+
+echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR}
+rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE}
diff --git a/debian/emacsen-startup b/debian/emacsen-startup
new file mode 100644
index 0000000..d6e2d23
--- /dev/null
+++ b/debian/emacsen-startup
@@ -0,0 +1,25 @@
+;; -*-emacs-lisp-*-
+;;
+;; Emacs startup file, e.g. /etc/emacs/site-start.d/50org-mode.el
+;; for the Debian org-mode package
+;;
+;; Originally contributed by Nils Naumann <naumann@unileoben.ac.at>
+;; Modified by Dirk Eddelbuettel <edd@debian.org>
+;; Adapted for dh-make by Jim Van Zandt <jrv@debian.org>
+
+;; The org-mode package follows the Debian/GNU Linux 'emacsen' policy and
+;; byte-compiles its elisp files for each 'emacs flavor' (emacs19,
+;; xemacs19, emacs20, xemacs20...). The compiled code is then
+;; installed in a subdirectory of the respective site-lisp directory.
+;; We have to add this to the load-path:
+(let ((package-dir (concat "/usr/share/"
+ (symbol-name debian-emacs-flavor)
+ "/site-lisp/org-mode")))
+
+;; If package-dir does not exist, the org-mode package must have
+;; removed but not purged, and we should skip the setup.
+ (when (file-directory-p package-dir)
+ (debian-pkg-add-load-path-item package-dir)
+ (require 'org-install)
+ (add-to-list 'auto-mode-alist '("\\.org\\(-mode\\)?$" . org-mode))
+ (setq org-ditaa-jar-path "/usr/bin/ditaa")))
diff --git a/debian/patches/10-shebang.patch b/debian/patches/10-shebang.patch
new file mode 100644
index 0000000..fd75790
--- /dev/null
+++ b/debian/patches/10-shebang.patch
@@ -0,0 +1,12 @@
+Description: Make lintian happy
+Forwarded: not-needed
+Author: Sebastien Delafond <seb@debian.org>
+
+--- a/contrib/scripts/dir2org.zsh
++++ b/contrib/scripts/dir2org.zsh
+@@ -1,5 +1,3 @@
+-#!/usr/bin/env zsh
+-
+ # desc:
+ #
+ # Output an org compatible structure representing the filesystem from
diff --git a/debian/patches/20-links-unescaping.patch b/debian/patches/20-links-unescaping.patch
new file mode 100644
index 0000000..1a69118
--- /dev/null
+++ b/debian/patches/20-links-unescaping.patch
@@ -0,0 +1,26 @@
+Description: Proper unescaping in links
+Author: Carsten Dominik <carsten.dominik@gmail.com>
+Origin: upstream
+Bug-Debian: http://bugs.debian.org/572404
+
+Index: org-mode-6.34c/lisp/org.el
+===================================================================
+--- org-mode-6.34c.orig/lisp/org.el 2010-01-18 00:10:45.000000000 +0100
++++ org-mode-6.34c/lisp/org.el 2010-03-05 11:27:52.000000000 +0100
+@@ -7914,12 +7914,14 @@
+ (url-unhex-string text)
+ (setq table (or table org-link-escape-chars))
+ (when text
+- (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x)))
++ (let ((case-fold-search t)
++ (re (mapconcat (lambda (x) (regexp-quote (downcase (cdr x))))
+ table "\\|")))
+ (while (string-match re text)
+ (setq text
+ (replace-match
+- (char-to-string (car (rassoc (match-string 0 text) table)))
++ (char-to-string (car (rassoc (upcase (match-string 0 text))
++ table)))
+ t t text)))
+ text))))
+
diff --git a/debian/patches/30-local-mk.patch b/debian/patches/30-local-mk.patch
new file mode 100644
index 0000000..087eff0
--- /dev/null
+++ b/debian/patches/30-local-mk.patch
@@ -0,0 +1,8 @@
+Description: Generate all the doc. including the refcard
+Forwarded: not-needed
+Author: Sebastien Delafond <seb@debian.org>
+
+--- /dev/null
++++ b/local.mk
+@@ -0,0 +1 @@
++ORG_MAKE_DOC = info html pdf card
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..867893a
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1,3 @@
+10-shebang.patch
+#20-links-unescaping.patch
+30-local-mk.patch
diff --git a/debian/rules b/debian/rules
new file mode 100755
index 0000000..e136dd6
--- /dev/null
+++ b/debian/rules
@@ -0,0 +1,52 @@
+#! /usr/bin/make -f
+
+DOC_TMP_FILES := doc/org.aux doc/org.cp doc/org.cps doc/org.fn \
+ doc/org.fns doc/org.ky doc/org.kys \
+ doc/org.log doc/org.pg doc/org.toc doc/org.tp \
+
+DOC_FILES := doc/*pdf
+
+clean:
+ dh_testdir
+ dh_testroot
+ dh_clean
+ rm -f $(DOC_FILES) $(DOC_TMP_FILES)
+
+build build-indep build-arch:
+
+install: build
+ dh_testdir
+ dh_testroot
+ dh_clean -k
+ dh_installdirs
+ cp lisp/* $(CURDIR)/debian/org-mode/usr/share/emacs/site-lisp/org-mode
+ cp -r etc $(CURDIR)/debian/org-mode/usr/share/emacs/site-lisp/org-mode
+# cp xemacs/*.el $(CURDIR)/debian/org-mode/usr/share/xemacs/site-lisp/org-mode
+ cp -r contrib $(CURDIR)/debian/org-mode/usr/share/org-mode/
+ make doc
+ rm -f $(DOC_TMP_FILES)
+ find $(CURDIR)/debian/org-mode/usr/share/org-mode/ -type f -exec chmod 644 "{}" \;
+ find $(CURDIR)/debian/org-mode/usr/share/emacs/site-lisp/org-mode -type f -exec chmod 644 "{}" \;
+ find $(CURDIR)/debian/org-mode/usr/share/org-mode/ -name .DS_Store -exec rm -f "{}" \;
+ find $(CURDIR)/debian/org-mode/usr/share/org-mode/ -name .gitignore -exec rm -f "{}" \;
+
+binary-indep: install
+ dh_testdir
+ dh_testroot
+ dh_installchangelogs
+ dh_installdocs doc/*
+ rm -f $(CURDIR)/debian/org-mode/usr/share/doc/org-mode/*texi*
+ dh_installemacsen -v
+ dh_fixperms
+ dh_installinfo doc/org
+ dh_compress
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+
+binary-arch: build-arch
+
+binary: binary-indep binary-arch
+
+.PHONY: build clean build-indep build-arch binary binary-indep binary-arch
diff --git a/debian/source/format b/debian/source/format
new file mode 100644
index 0000000..163aaf8
--- /dev/null
+++ b/debian/source/format
@@ -0,0 +1 @@
+3.0 (quilt)
diff --git a/debian/watch b/debian/watch
new file mode 100644
index 0000000..e51bdf0
--- /dev/null
+++ b/debian/watch
@@ -0,0 +1,5 @@
+# format version number, currently 3; this line is compulsory!
+version=3
+
+http://orgmode.org/ \
+ org-(\d.+)\.tar\.gz debian uupdate
diff --git a/etc/Makefile b/etc/Makefile
new file mode 100644
index 0000000..8b06158
--- /dev/null
+++ b/etc/Makefile
@@ -0,0 +1,31 @@
+ETCDIRS = styles schema
+-include local.mk # optional local customization
+
+.NOTPARALLEL: # always run this make serially
+.SUFFIXES: # we don't need default suffix rules
+ifeq ($(MAKELEVEL), 0)
+ $(error This make needs to be started as a sub-make from the toplevel directory.)
+endif
+
+.PHONY: all install clean cleanall clean-install
+
+all:
+
+install: $(ETCDIRS)
+ for dir in $? ; do \
+ if [ ! -d $(DESTDIR)$(datadir)/$${dir} ] ; then \
+ $(MKDIR) $(DESTDIR)$(datadir)/$${dir} ; \
+ fi ; \
+ $(CP) $${dir}/* $(DESTDIR)$(datadir)/$${dir} ; \
+ done ;
+
+clean:
+
+cleanall:
+
+clean-install: $(ETCDIRS)
+ for dir in $? ; do \
+ if [ -d $(DESTDIR)$(datadir)/$${dir} ] ; then \
+ $(RMR) $(DESTDIR)$(datadir)/$${dir} ; \
+ fi ; \
+ done ;
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
new file mode 100644
index 0000000..35aab7a
--- /dev/null
+++ b/etc/ORG-NEWS
@@ -0,0 +1,1432 @@
+ORG NEWS -- history of user-visible changes. -*- org -*-
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+See the end of the file for license conditions.
+
+Please send Org bug reports to emacs-orgmode@gnu.org.
+
+* Version 7.9.2
+
+** New ELPA repository for Org packages
+
+You can now add the Org ELPA repository like this:
+
+#+BEGIN_SRC emacs-lisp
+(add-to-list 'package-archives '("org" . "http://orgmode.org/elpa/") t)
+#+END_SRC
+
+It contains both the =org-*.tar= package (the core Org distribution, also
+available through http://elpa.gnu.org) and the =org-plus*.tar= package (the
+extended Org distribution, with non-GNU packages from the =contrib/=
+directory.)
+
+See http://orgmode.org/elpa/
+
+** Overview of the new keybindings
+
+ | Keybinding | Speedy | Command |
+ |-----------------+--------+-----------------------------|
+ | =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] |
+ | =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] |
+ | =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] |
+ | =M-h= | | [[doc::org-mark-element][org-mark-element]] |
+ | =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] |
+ | =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] |
+ | =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] |
+ | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
+ | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
+ | | =:= | [[doc::org-columns][org-columns]] |
+ | | =W= | Set =APPT_WARNTIME= |
+ | =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
+ | C-c , | , | [[doc::org-priority][org-priority]] |
+
+** New package and Babel langage
+
+*** =org-eshell.el= by Konrad Hinsen is now in Org
+
+ =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]].
+
+*** Support for execution of Scala code blocks (see ob-scala.el)
+*** Support for execution of IO code blocks (see ob-io.el)
+
+** Incompatible changes
+
+ - If your code relies on =org-write-agenda=, please use
+ [[doc::org-agenda-write][org-agenda-write]] from now on.
+
+ - If your code relies on =org-make-link=, please use =concat=
+ instead.
+
+ - =org-link-to-org-use-id= has been renamed to
+ =org-id-link-to-org-use-id= and its default value is nil. The
+ previous default was =create-if-interactive-and-no-custom-id=.
+
+** New features and user-visible changes
+
+*** Org Element
+
+ =org-element.el= is a toolbox for parsing and analysing "elements"
+ in an Org-mode buffer. This has been written by Nicolas Goaziou
+ and has been tested for quite some time. It is now part of Org's
+ core and many core functions rely on this package.
+
+ Two functions might be particularily handy for users:
+ =org-element-at-point= and =org-element-context=.
+
+ See the docstrings for more details.
+
+ Below is a list of editing and navigating commands that now rely
+ on =org-element.el=.
+
+**** [[doc::org-fill-paragraph][org-fill-paragraph]] has been completely rewritten
+
+ The filling mechanisms now rely on org-element, trying to do the
+ right thing on each element in various contexts. E.g. filling in
+ a list item will preserve indentation; filling in message-mode
+ will fall back on the relevant filling functions; etc.
+
+**** [[doc::org-metaup][org-metaup]] and [[doc::org-metadown][org-metadown]] will drag the element backward/forward
+
+ If you want to get the old behavior (i.e. moving a line up and
+ down), you can first select the line as an active region, then
+ =org-metaup= or =org-metadown= to move the region backward or
+ forward. This also works with regions bigger than just one line.
+
+**** [[doc::org-up-element][org-up-element]] and [[doc::org-down-element][org-down-element]] (respectively =C-c C-^= and =C-c C-_=)
+
+ This will move the point up/down in the hierarchy of elements.
+
+**** [[doc::org-backward-element][org-backward-element]] and [[doc::org-forward-element][org-forward-element]] (respectively =M-{= and =M-}=)
+
+ This will move the point backward/forward in the hierarchy of
+ elements.
+
+**** [[doc::org-narrow-to-element][org-narrow-to-element]] will narrow to the element at point
+**** [[doc::org-mark-element][org-mark-element]] will mark the element at point
+
+ This command is bound to =M-h= and will mark the element at
+ point. If the point is at a paragraph, it will mark the
+ paragraph. If the point is at a list item, it will mark the list
+ item. Etc.
+
+ Note that if point is at the beginning of a list, it will mark
+ the whole list.
+
+ To mark a subtree, you can either use =M-h= on the headline
+ (since there is no ambiguity about the element you're at) or
+ [[doc::org-mark-subtree][org-mark-subtree]] (=C-c @=) anywhere in the subtree.
+
+ Invoking [[doc::org-mark-element][org-mark-element]] repeatedly will try to mark the next
+ element on top of the previous one(s). E.g. hitting =M-h= twice
+ on a headline will mark the current subtree and the next one on
+ the same level.
+
+*** Org Agenda
+
+**** New option [[doc::org-agenda-sticky][org-agenda-sticky]]
+
+ There is a new option =org-agenda-sticky= which enables "sticky"
+ agendas. Sticky agendas remain opened in the background so that
+ you don't need to regenerate them each time you hit the
+ corresponding keystroke. This is a big time saver.
+
+ When [[doc::org-agenda-sticky][org-agenda-sticky]] is =non-nil=, the agenda buffer will be
+ named using the agenda key and its description. In sticky
+ agendas, the =q= key will just bury the agenda buffers and
+ further agenda commands will show existing buffer instead of
+ generating new ones.
+
+ If [[doc::org-agenda-sticky][org-agenda-sticky]] is set to =nil=, =q= will kill the single
+ agenda buffer.
+
+**** New option [[doc::org-agenda-custom-commands-contexts][org-agenda-custom-commands-contexts]]
+
+ Setting this option allows you to define specific context where
+ agenda commands should be available from. For example, when set
+ to this value
+
+ #+BEGIN_SRC emacs-lisp
+ (setq org-agenda-custom-commands-contexts
+ '(("p" (in-file . "\\.txt"))))
+#+END_SRC
+
+ then the =p= agenda command will only be available from buffers
+ visiting *.txt files. See the docstring and the manual for more
+ details on how to use this.
+
+**** Changes in bulk actions
+
+ The set of commands starting with =k ...= as been deleted and the
+ features have been merged into the "bulk action" feature.
+
+ After you marked some entries in the agenda, if you call =B s=,
+ the agenda entries will be rescheduled using the date at point if
+ on a date header. If you are on an entry with a timestamp, you
+ will be prompted for a date to reschedule your marked entries to,
+ using the timestamp at point as the default prompt.
+
+ You can now use =k= to capture the marked entry and use the date
+ at point as an overriding date for the capture template.
+
+ To bind this behavior to =M-x org-capture RET= (or its
+ keybinding), set the new option [[doc::org-capture-use-agenda-date][org-capture-use-agenda-date]] to
+ =t=.
+
+**** =N= and =P= in the agenda will move to the next/previous item
+
+**** New command [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] to mark all items
+
+ This new command is bound to =*= in agenda mode.
+
+ There is also a new option [[doc::org-agenda-bulk-mark-char][org-agenda-bulk-mark-char]] to set the
+ character to use as a mark for bulk actions.
+
+**** New option [[doc::org-agenda-persistent-marks][org-agenda-persistent-marks]]
+
+ When set to =non-nil=, marks will remain visible after a bulk
+ action. You can temporarily toggle this by pressing =p= when
+ invoking [[doc::org-agenda-bulk-action][org-agenda-bulk-action]]. Marks are deleted if your
+ rebuild the agenda buffer or move to another date/span (e.g. with
+ =f= or =w=).
+
+**** New option [[doc::org-agenda-skip-timestamp-if-deadline-is-shown][org-agenda-skip-timestamp-if-deadline-is-shown]]
+
+ =Non-nil= means skip timestamp line if same entry shows because
+ of deadline.
+
+ In the agenda of today, an entry can show up multiple times
+ because it has both a plain timestamp and has a nearby deadline.
+ When this variable is t, then only the deadline is shown and the
+ fact that the entry has a timestamp for or including today is not
+ shown. When this variable is =nil=, the entry will be shown
+ several times.
+
+**** New =todo-unblocked= and =nottodo-unblocked= skip conditions
+
+ See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations.
+
+**** Allow category filtering in the agenda
+
+ You can now filter the agenda by category. Pressing "<" will
+ filter by the category of the item on the current line, and
+ pressing "<" again will remove the filter. You can combine tag
+ filters and category filters.
+
+ You can use =org-agenda-category-filter= in your custom agenda
+ views and =org-agenda-category-filter-preset= in your main
+ configuration.
+
+ See also the new command [[doc::org-agenda-filter-by-top-category][org-agenda-filter-by-top-category]]:
+ hitting =^= will filter by "Top" category: only show entries that
+ are of the same category than the Top category of the entry at
+ point.
+
+*** Org Links
+
+**** Inserting links
+
+ When inserting links through [[doc::org-insert-link][org-insert-link]], the description is
+ now displayed first, followed by the literal link, as the
+ description is often more useful when you look for the link you
+ want to insert.
+
+ Completion now complete both literal links and description. If
+ you complete a description, the literal link and its description
+ will be inserted directly, whereas when you complete the literal
+ link, you will be prompted for a description (as with Org 7.8.)
+
+ In the completion buffer, links to the current buffer are now
+ highlighted.
+
+**** New templates =%h= and =%(sexp)= for abbreviated links
+
+ On top of =%s= template, which is replaced by the link tag in
+ abbreviated links, you can now use =%h= (which does the same than =%s=
+ but does not hexify the tag) and =%(sexp)= (which can run a function
+ that takes the tag as its own argument.)
+
+**** New link type =help=
+
+ You can now create links from =help= buffers.
+
+ For example, if you request help for the command [[doc::org-agenda][org-agenda]] with
+ =C-h f org-agenda RET=, creating a link from this buffer will let
+ you go back to the same buffer.
+
+**** New command [[doc::org-insert-all-links][org-insert-all-links]]
+
+ This will insert all links as list items. With a universal
+ prefix argument, links will not be deleted from the variable
+ =org-stored-links=.
+
+ This new command is bound to =C-c C-M-l=.
+
+**** New option [[doc::org-url-hexify-p][org-url-hexify-p]]
+
+ When set to =nil=, the =URL= part of a link will not be hexified.
+
+**** Org can now open multiple shell links
+
+**** New option [[doc::org-doi-server-url][org-doi-server-url]] to specify an alternate DOI server
+
+**** RET now follows time stamps links
+
+*** Org Editing
+
+**** [[doc::org-todo][org-todo]] and =org-archive-*= can now loop in the active region
+
+ When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, using
+ [[doc::org-todo][org-todo]] or =org-archive-*= commands in the active region will
+ loop over headlines. This is handy if you want to set the TODO
+ keyword for several items, or archive them quickly.
+
+**** You can now set tags for headlines in a region
+
+ If [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is =non-nil=, then
+ selecting the region and hitting =C-c C-q= will set the tags for
+ all headlines in the region.
+
+**** New command [[doc::org-insert-drawer][org-insert-drawer]] to insert a drawer interactively
+
+**** Comments start with "^[ \t]*# " anywhere on a line
+
+ Note that the space after the hashtag is mandatory. Comments
+ with "^#+" are not supported anymore.
+
+**** New speed key =#= to toggle the COMMENT cookie on a headline
+
+**** =indent-region-function= is now set to [[doc::org-indent-region][org-indent-region]]
+
+ =C-M-\= should now produce useful results.
+
+ You can unindent the buffer with [[doc::org-unindent-buffer][org-unindent-buffer]].
+
+**** New option [[doc::org-allow-promoting-top-level-subtree][org-allow-promoting-top-level-subtree]]
+
+ When =non-nil=, =S-M-<left>= will promote level-1 subtrees
+ containing other subtrees. The level-1 headline will be
+ commented out. You can revert to the previous state with =M-x
+ undo RET=.
+
+*** Org Clock
+
+**** New keybinding =C-c C-x C-z= for [[doc::org-clock-resolve][org-clock-resolve]]
+
+**** New keybinding =C-c C-x C-q= for [[doc::org-clock-cancel][org-clock-cancel]]
+
+**** New command [[doc::org-clock-in-last][org-clock-in-last]] to clock in the last clocked item
+
+ This command is bound to =C-c C-x C-x= and will clock in the last
+ clocked entry, if any.
+
+**** =C-u M-x= [[doc::org-clock-out][org-clock-out]] =RET= now prompts for a state to switch to
+
+**** =S-M-<up/down>= on a clock timestamps adjusts the previous/next clock
+
+**** New option [[doc::org-clock-continuously][org-clock-continuously]]
+
+ When set to =nil=, clocking in a task will first try to find the
+ last clocked out task and restart from when that task was clocked
+ out.
+
+ You can temporarily activate continuous clocking with =C-u C-u
+ C-u M-x= [[doc::org-clock-in][org-clock-in]] =RET= (three universal prefix arguments)
+ and =C-u C-u M-x= [[org-clock-in-last][org-clock-in-last]] =RET= (two universal prefix
+ arguments).
+
+
+**** New option [[doc::org-clock-frame-title-format][org-clock-frame-title-format]]
+
+ This option sets the value of =frame-title-format= when clocking
+ in.
+
+**** New options for controlling the clockreport display
+
+ [[doc::org-clock-file-time-cell-format][org-clock-file-time-cell-format]]: Format string for the file time
+ cells in clockreport.
+
+ [[doc::org-clock-total-time-cell-format][org-clock-total-time-cell-format]]: Format string for the total
+ time cells in clockreport.
+
+
+**** New options for controlling the clock/timer display
+
+ [[doc::org-clock-clocked-in-display][org-clock-clocked-in-display]]: control whether the current clock
+ is displayed in the mode line and/or frame title.
+
+ [[doc::org-timer-display][org-timer-display]]: control whether the current timer is displayed
+ in the mode line and/or frame title.
+
+ This allows the clock and timer to be displayed in the frame
+ title instead of, or as well as, the mode line. This is useful
+ for people with limited space in the mode line but with ample
+ space in the frame title.
+
+*** Org Appearance
+
+**** New option [[doc::org-custom-properties][org-custom-properties]]
+
+ The visibility of properties listed in this options can be turn
+ on/off with [[doc::org-toggle-custom-properties-visibility][org-toggle-custom-properties-visibility]]. This might
+ be useful for properties used by third-part tools or that you
+ don't want to see temporarily.
+
+**** New command [[doc::org-redisplay-inline-images][org-redisplay-inline-images]]
+
+ This will redisplay all images. It is bound to =C-c C-x C-M-v=.
+
+**** New entities in =org-entities.el=
+
+ There are these new entities:
+
+ : ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ : ("slash" "/" nil "/" "/" "/" "/")
+ : ("plus" "+" nil "+" "+" "+" "+")
+ : ("under" "\\_" nil "_" "_" "_" "_")
+ : ("equal" "=" nil "=" "=" "=" "=")
+ : ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
+
+**** New face =org-list-dt= for definition terms
+**** New face =org-date-selected= for the selected calendar day
+**** New face value for =org-document-title=
+
+ The face is back to a normal height.
+
+*** Org Columns
+
+**** New speed command =:= to activate the column view
+**** New special property =CLOCKSUM_T= to display today's clocked time
+
+ You can use =CLOCKSUM_T= the same way you use =CLOCKSUM=. It
+ will display the time spent on tasks for today only.
+
+**** Use the =:COLUMNS:= property in columnview dynamic blocks
+
+ If the =:COLUMNS:= is set in a subtree, the columnview dynamic
+ block will use its value as the column format.
+
+**** Consider inline tasks when computing a sum
+
+*** Org Dates and Time Stamps
+
+**** Enhanced [[doc::org-sparse-tree][org-sparse-tree]]
+
+ =C-c /= can now check for time ranges.
+
+ When checking for dates with =C-c /= it is useful to change the
+ type of dates that you are interested in. You can now do this
+ interactively with =c= after =C-c /= and/or by setting
+ [[doc::org-sparse-tree-default-date-type][org-sparse-tree-default-date-type]] to the default value you want.
+
+**** Support for hourly repeat cookies
+
+ You can now use
+
+ : SCHEDULED: <2012-08-20 lun. 08:00 +1h>
+
+ if you want to add an hourly repeater to an entry.
+
+**** =C-u C-u C-c .= inserts a time-stamp with no prompt
+
+**** When (setq [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] 'time), accept days in the prompt
+
+ "8am Wed" and "Wed 8am" are now acceptable values when entering a
+ date from the prompt. If [[doc::org-read-date-prefer-future][org-read-date-prefer-future]] is set to
+ =time=, this will produce the expected prompt indication.
+
+**** New option [[doc::org-datetree-add-timestamp][org-datetree-add-timestamp]]
+
+ When set to =non-nil=, datetree entries will also have a
+ timestamp. This is useful if you want to see these entries in a
+ sparse tree with =C-c /=.
+
+*** Org Capture
+
+**** New command [[doc::org-capture-string][org-capture-string]]
+
+ M-x [[doc::org-capture-string][org-capture-string]] RET will prompt for a string and a capture
+ template. The string will be used as an annotation for the
+ template. This is useful when capturing in batch mode as it lets
+ you define the content of the template without being in Emacs.
+
+**** New option [[doc::org-capture-templates-contexts][org-capture-templates-contexts]]
+
+ Setting this option allows you to define specific context where
+ capture templates should be available from. For example, when
+ set to this value
+
+ #+BEGIN_SRC emacs-lisp
+ (setq org-capture-templates-contexts
+ '(("c" (in-mode . "message-mode"))))
+#+END_SRC
+
+ then the =c= capture template will only be available from
+ =message-mode= buffers. See the docstring and the manual for
+ more details on how to use this.
+
+**** New =%l= template to insert the literal link
+**** New option [[doc::org-capture-bookmark][org-capture-bookmark]]
+
+ Org used to automatically add a bookmark with capture a note.
+ You can now turn this on by setting [[doc::org-capture-bookmark][org-capture-bookmark]] to
+ =nil=.
+
+**** Expand =%<num>= escape sequences into text entered for <num>'th =%^{PROMPT}= escape
+
+ See the manual for more explanations.
+
+**** More control over empty lines
+
+ You can use =:empty-lines-before= and =:empty-lines-after= to
+ control the insertion of empty lines. Check the manual for more
+ explanations.
+
+**** New hook [[doc::org-capture-prepare-finalize-hook][org-capture-prepare-finalize-hook]]
+
+ This new hook runs before the finalization process starts.
+
+*** Org Export
+
+**** New functions =orgtbl-to-table.el= and =orgtbl-to-unicode=
+
+ =orgtbl-to-table.el= convert the table to a =table.el= table, and
+ =orgtbl-to-unicode= will use =ascii-art-to-unicode.el= (when
+ available) to print beautiful tables.
+
+**** [[doc::org-table-export][org-table-export]] now a bit clever about the target format
+
+ When you specify a file name like =table.csv=, [[doc::org-table-export][org-table-export]]
+ will now suggest =orgtbl-to-csv= the default method for exporting
+ the table.
+
+**** New option [[doc::org-export-date-timestamp-format][org-export-date-timestamp-format]]
+
+ The option allows to set a time string format for Org timestamps
+ in the #+DATE option.
+
+**** LaTeX: New options for exporting table rules :tstart, :hline and :tend
+
+ See [[doc::org-export-latex-tables-hline][org-export-latex-tables-hline]] and [[doc::org-export-latex-tables-tend][org-export-latex-tables-tend]].
+
+**** LaTeX: You can now set =:hfmt= from =#+ATTR_LaTeX=
+**** Beamer: Add support and keybinding for the =exampleblock= environment
+
+ Add support for these languages in [[doc::org-export-language-setup][org-export-language-setup]].
+ More languages are always welcome.
+
+**** Beamer: New option [[doc::org-beamer-inherited-properties][org-beamer-inherited-properties]]
+
+ This option allows Beamer export to inherit some properties.
+ Thanks to Carsten for implementing this.
+
+**** ODT: Add support for ODT export in org-bbdb.el
+**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details)
+**** ODT: Improve the conversion from ODT to other formats
+**** ASCII: Swap the level-1/level-2 characters to underline the headlines
+**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese
+**** HTML: New option [[doc::org-export-html-date-format-string][org-export-html-date-format-string]]
+
+ Format string to format the date and time in HTML export. Thanks
+ to Sébastien Vauban for this patch.
+
+*** Org Babel
+
+**** New =:results drawer= parameter
+
+=:results drawer= replaces =:results wrap=, which is deprecated but still
+supported.
+
+**** =:results org= now put results in a =#+BEGIN_SRC org= block
+
+=:results org= used to put results in a =#+BEGIN_ORG= block but it now puts
+results in a =#+BEGIN_SRC org= block, wich comma-escaped lines.
+
+=#+BEGIN_ORG= blocks are obsolete.
+
+**** Exporting =#+BEGIN_SRC org= blocks exports the code
+
+It used to exports the results of the code.
+
+*** Miscellaneous
+
+**** New menu entry for [[doc::org-refile][org-refile]]
+**** Allow capturing to encrypted entries
+
+If you capture to an encrypted entry, it will be decrpyted before
+inserting the template then re-encrypted after finalizing the capture.
+
+**** Inactive timestamps are now handled in tables
+
+Calc can do computation on active time-stamps like <2012-09-29 sat.>.
+Inactive time-stamps in a table's cell are now internally deactivated so
+that Calc formulas can operate on them.
+
+**** [[doc::org-table-number-regexp][org-table-number-regexp]] can now accept comma as decimal mark
+**** Org allows a new property =APPT_WARNTIME=
+
+ You can set it with the =W= speedy key or set it manually. When
+ set, exporting to iCalendar and [[doc::org-agenda-to-appt][org-agenda-to-appt]] will use the
+ value of this property as the number of minutes for the warning
+ alarm.
+
+**** New command [[doc::org-inc-effort][org-inc-effort]]
+
+ This will increment the effort value.
+
+ It is bound to =C-c C-x E= and to =E= as a speedy command.
+
+**** Attach: Add support for creating symbolic links
+
+ =org-attach-method= now supports a new method =lns=, allowing to
+ attach symbolic links.
+
+**** Archive: you can now archive to a datetree
+
+**** New option [[doc::org-inlinetask-show-first-star][org-inlinetask-show-first-star]]
+
+ =Non-nil= means display the first star of an inline task as
+ additional marker. When =nil=, the first star is not shown.
+
+**** New option [[doc::org-latex-preview-ltxpng-directory][org-latex-preview-ltxpng-directory]]
+
+ This lets you define the path for the =ltxpng/= directory.
+
+**** You can now use imagemagick instead of dvipng to preview LaTeX fragments
+**** You can now turn off [[doc::orgstruct++-mode][orgstruct++-mode]] safely
+**** =C-u C-c C-c= on list items to add check boxes
+
+ =C-u C-c C-c= will add an empty check box on a list item.
+
+ When hit from the top of the list, it will add check boxes for
+ all top level list items.
+
+**** =org-list-ending-method= and =org-list-end-regexp= are now obsolete
+
+ Fall back on using =org-list-end-re= only, which see.
+
+**** org-feed.el now expands =%(sexp)= templates
+**** New option [[doc::org-protocol-data-separator][org-protocol-data-separator]]
+
+**** New option [[doc::org-ditaa-jar-option][org-ditaa-jar-option]] to specify the ditaa jar file
+
+**** New possible value for [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]]
+
+ When [[doc::org-loop-over-headlines-in-active-region][org-loop-over-headlines-in-active-region]] is set to
+ =start-level=, the command will loop over the active region but
+ will only act upon entries that are of the same level than the
+ first headline in the region.
+
+**** New option [[doc::org-habit-show-all-today][org-habit-show-all-today]]
+
+ When set to =t=, show all (even unscheduled) habits on today's
+ agenda.
+
+** Important bug fixes
+
+*** M-TAB on options keywords perform completion correctly again
+
+ If you hit =M-TAB= on keywords like =#+TITLE=, Org will try to
+ perform completion with meaningful values.
+
+*** Add licenses to javascript embedded and external code snippets
+
+ Embedded javascript code produced when exporting an Org file to
+ HTML is now licensed under GPLv3 (or later), and the copyright is
+ owned by the Free Software Foundation, Inc.
+
+ The javascript code for embedding MathJax in the browser mentions
+ the MathJax copyright and the Apache 2.0 license.
+
+ The javascript code for embedding =org-injo.js= in the browser
+ mentions the copyright of Sebastian Rose and the GPLv3 (or later)
+ license.
+
+ =org-export-html-scripts= is now a variable, so that you can adapt
+ the code and the license to your needs.
+
+ See http://www.gnu.org/philosophy/javascript-trap.html for
+ explanations on why these changes were necessary.
+
+* Version 7.8.11
+
+** Incompatible changes
+
+*** Emacs 21 support has been dropped
+
+ Do not use Org mode 7.xx with Emacs 21, use [[http://orgmode.org/org-6.36c.zip][version 6.36c]] instead.
+
+*** XEmacs support requires the XEmacs development version
+
+ To use Org mode 7.xx with XEmacs, you need to run the developer
+ version of XEmacs. We were about to drop XEmacs support entirely,
+ but Michael Sperber stepped in and made changes to XEmacs that
+ made it easier to keep the support. Thanks to Michael for this
+ last-minute save.
+
+*** New keys for TODO sparse trees
+
+ The key =C-c C-v= is now reserved for Org Babel action. TODO
+ sparse trees can still be made with =C-c / t= (all not-done
+ states) and =C-c / T= (specific states).
+
+*** The Agenda =org-agenda-ndays= is now obsolete
+
+ The variable =org-agenda-ndays= is obsolete - please use
+ =org-agenda-span= instead.
+
+ Thanks to Julien Danjou for this.
+
+*** Changes to the intended use of =org-export-latex-classes=
+
+ So far this variable has been used to specify the complete header
+ of the LaTeX document, including all the =\usepackage= calls
+ necessary for the document. This setup makes it difficult to
+ maintain the list of packages that Org itself would like to call,
+ for example for the special symbol support it needs.
+
+ First of all, you can *opt out of this change* in the following
+ way: You can say: /I want to have full control over headers, and I
+ will take responsibility to include the packages Org needs/. If
+ that is what you want, add this to your configuration and skip the
+ rest of this section (except maybe for the description of the
+ =[EXTRA]= place holder):
+
+ #+begin_src emacs-lisp
+ (setq org-export-latex-default-packages-alist nil
+ org-export-latex-packages-alist nil)
+ #+end_src
+
+ /Continue to read here if you want to go along with the modified
+ setup./
+
+ There are now two variables that should be used to list the LaTeX
+ packages that need to be included in all classes. The header
+ definition in =org-export-latex-classes= should then not contain
+ the corresponding =\usepackage= calls (see below).
+
+ The two new variables are:
+
+ 1. =org-export-latex-default-packages-alist= :: This is the
+ variable where Org-mode itself puts the packages it needs.
+ Normally you should not change this variable. The only
+ reason to change it anyway is when one of these packages
+ causes a conflict with another package you want to use. Then
+ you can remove that packages and hope that you are not using
+ Org-mode functionality that needs it.
+
+ 2. =org-export-latex-packages-alist= :: This is the variable where
+ you can put the packages that you'd like to use across all
+ classes.
+
+ The sequence how these customizations will show up in the LaTeX
+ document are:
+
+ 1. Header from =org-export-latex-classes=
+ 2. =org-export-latex-default-packages-alist=
+ 3. =org-export-latex-packages-alist=
+ 4. Buffer-specific things set with =#+LaTeX_HEADER:=
+
+ If you want more control about which segment is placed where, or
+ if you want, for a specific class, have full control over the
+ header and exclude some of the automatic building blocks, you can
+ put the following macro-like place holders into the header:
+
+ #+begin_example
+ [DEFAULT-PACKAGES] \usepackage statements for default packages
+ [NO-DEFAULT-PACKAGES] do not include any of the default packages
+ [PACKAGES] \usepackage statements for packages
+ [NO-PACKAGES] do not include the packages
+ [EXTRA] the stuff from #+LaTeX_HEADER
+ [NO-EXTRA] do not include #+LaTeX_HEADER stuff
+ #+end_example
+
+ If you have currently customized =org-export-latex-classes=, you
+ should revise that customization and remove any package calls that
+ are covered by =org-export-latex-default-packages-alist=. This
+ applies to the following packages:
+
+ - inputenc
+ - fontenc
+ - fixltx2e
+ - graphicx
+ - longtable
+ - float
+ - wrapfig
+ - soul
+ - t1enc
+ - textcomp
+ - marvosym
+ - wasysym
+ - latexsym
+ - amssymb
+ - hyperref
+
+ If one of these packages creates a conflict with another package
+ you are using, you can remove it from
+ =org-export-latex-default-packages-alist=. But then you risk that
+ some of the advertised export features of Org will not work
+ properly.
+
+ You can also consider moving packages that you use in all classes
+ to =org-export-latex-packages-alist=. If necessary, put the place
+ holders so that the packages get loaded in the right sequence. As
+ said above, for backward compatibility, if you omit the place
+ holders, all the variables will dump their content at the end of
+ the header.
+
+*** The constant =org-html-entities= is obsolete
+
+ Its content is now part of the new constant =org-entities=, which
+ is defined in the file org-entities.el. =org-html-entities= was
+ an internal variable, but it is possible that some users did write
+ code using it.
+
+*** =org-bbdb-anniversary-format-alist= has changed
+
+ Please check the docstring and update your settings accordingly.
+
+*** Deleted =org-mode-p=
+
+ This function has been deleted: please update your code.
+
+** Important new features
+
+*** New Org to ODT exporter
+
+ Jambunathan's Org to ODT exporter is now part of Org.
+
+ To use it, it `C-c C-e o' in an Org file. See the documentation
+ for more information on how to customize it.
+
+*** org-capture.el is now the default capture system
+
+ This replaces the earlier system org-remember. The manual only
+ describes org-capture, but for people who prefer to continue to
+ use org-remember, we keep a static copy of the former manual
+ section [[http://orgmode.org/org-remember.pdf][chapter about remember]].
+
+ The new system has a technically cleaner implementation and more
+ possibilities for capturing different types of data. See
+ [[http://thread.gmane.org/gmane.emacs.orgmode/26441/focus%3D26441][Carsten's announcement]] for more details.
+
+ To switch over to the new system:
+
+ 1. Run
+
+ : M-x org-capture-import-remember-templates RET
+
+ to get a translated version of your remember templates into the
+ new variable =org-capture-templates=. This will "mostly" work,
+ but maybe not for all cases. At least it will give you a good
+ place to modify your templates. After running this command,
+ enter the customize buffer for this variable with
+
+ : M-x customize-variable RET org-capture-templates RET
+
+ and convince yourself that everything is OK. Then save the
+ customization.
+
+ 2. Bind the command =org-capture= to a key, similar to what you did
+ with org-remember:
+
+ : (define-key global-map "\C-cc" 'org-capture)
+
+ If your fingers prefer =C-c r=, you can also use this key once
+ you have decided to move over completely to the new
+ implementation. During a test time, there is nothing wrong
+ with using both system in parallel.
+
+** New libraries
+
+*** New Org libraries
+**** org-eshell.el (Konrad Hinsen)
+
+ Implement links to eshell buffers.
+
+**** org-special-blocks (Carsten Dominik)
+
+ This package generalizes the #+begin_foo and #+end_foo tokens.
+
+ To use, put the following in your init file:
+
+ #+BEGIN_EXAMPLE
+(require 'org-special-blocks)
+#+END_EXAMPLE
+
+ The tokens #+begin_center, #+begin_verse, etc. existed
+ previously. This package generalizes them (at least for the
+ LaTeX and html exporters). When a #+begin_foo token is
+ encountered by the LaTeX exporter, it is expanded
+ into \begin{foo}. The text inside the environment is not
+ protected, as text inside environments generally is.
+ When #+begin_foo is encountered by the html exporter, a div with
+ class foo is inserted into the HTML file. It is up to the user
+ to add this class to his or her stylesheet if this div is to mean
+ anything.
+
+**** org-taskjuggler.el (Christian Egli)
+
+ Christian Egli's /org-taskjuggler.el/ module is now part of Org.
+ He also wrote a [[http://orgmode.org/worg/org-tutorials/org-taskjuggler.php][tutorial]] for it.
+
+**** org-ctags.el (Paul Sexton)
+
+ Targets like =<<my target>>= can now be found by Emacs' etag
+ functionality, and Org-mode links can be used to to link to
+ etags, also in non-Org-mode files. For details, see the file
+ /org-ctags.el/.
+
+ This feature uses a new hook =org-open-link-functions= which will
+ call function to do something special with text links.
+
+ Thanks to Paul Sexton for this contribution.
+
+**** org-docview.el (Jan Böcker)
+
+ This new module allows links to various file types using docview, where
+ Emacs displays images of document pages. Docview link types can point
+ to a specific page in a document, for example to page 131 of the
+ Org-mode manual:
+
+ : [[docview:~/.elisp/org/doc/org.pdf::131][Org-Mode Manual]]
+
+ Thanks to Jan Böcker for this contribution.
+
+*** New Babel libraries
+
+- ob-picolisp.el (Thorsten Jolitz)
+- ob-fortran.el (Sergey Litvinov)
+- ob-shen.el (Eric Schulte)
+- ob-maxima.el (Eric S Fraga)
+- ob-java.el (Eric Schulte)
+- ob-lilypond.el (Martyn Jago)
+- ob-awk.el (Eric Schulte)
+
+** Other new features and various enhancements
+
+*** Hyperlinks
+
+**** Org-Bibtex -- major improvements
+
+ Provides support for managing bibtex bibliographical references
+ data in headline properties. Each headline corresponds to a
+ single reference and the relevant bibliographic meta-data is
+ stored in headline properties, leaving the body of the headline
+ free to hold notes and comments. Org-bibtex is aware of all
+ standard bibtex reference types and fields.
+
+ The key new functions are
+
+ - org-bibtex-check :: queries the user to flesh out all required
+ (and with prefix argument optional) bibtex fields available
+ for the specific reference =type= of the current headline.
+
+ - org-bibtex-create :: Create a new entry at the given level,
+ using org-bibtex-check to flesh out the relevant fields.
+
+ - org-bibtex-yank :: Yank a bibtex entry on the kill ring as a
+ formatted Org-mode headline into the current buffer
+
+ - org-bibtex-export-to-kill-ring :: Export the current headline
+ to the kill ring as a formatted bibtex entry.
+
+**** org-gnus.el now allows link creation from messages
+
+ You can now create links from messages. This is particularily
+ useful when the user wants to stored messages that he sends, for
+ later check. Thanks to Ulf Stegemann for the patch.
+
+**** Modified link escaping
+
+ David Maus worked on `org-link-escape'. See [[http://article.gmane.org/gmane.emacs.orgmode/37888][his message]]:
+
+ : Percent escaping is used in Org mode to escape certain characters
+ : in links that would either break the parser (e.g. square brackets
+ : in link target oder description) or are not allowed to appear in
+ : a particular link type (e.g. non-ascii characters in a http:
+ : link).
+ :
+ : With this change in place Org will apply percent escaping and
+ : unescaping more consistently especially for non-ascii characters.
+ : Additionally some of the outstanding bugs or glitches concerning
+ : percent escaped links are solved.
+
+ Thanks a lot to David for this work.
+
+**** Make =org-store-link= point to directory in a dired buffer
+
+ When, in a dired buffer, the cursor is not in a line listing a
+ file, `org-store-link' will store a link to the directory.
+
+ Patch by Stephen Eglen.
+
+**** Allow regexps in =org-file-apps= to capture link parameters
+
+ The way extension regexps in =org-file-apps= are handled has
+ changed. Instead of matching against the file name, the regexps
+ are now matched against the whole link, and you can use grouping
+ to extract link parameters which you can then use in a command
+ string to be executed.
+
+ For example, to allow linking to PDF files using the syntax
+ =file:/doc.pdf::<page number>=, you can add the following entry
+ to org-file-apps:
+
+ #+begin_example
+ Extension: \.pdf::\([0-9]+\)\'
+ Command: evince "%s" -p %1
+ #+end_example
+
+ Thanks to Jan Böcker for a patch to this effect.
+
+*** Dates and time
+
+**** Allow relative time when scheduling/adding a deadline
+
+ You can now use relative duration strings like "-2d" or "++3w"
+ when calling =org-schedule= or =org-deadline=: it will schedule
+ (or set the deadline for) the item respectively two days before
+ today and three weeks after the current timestamp, if any.
+
+ You can use this programmatically: =(org-schedule nil "+2d")=
+ will work on the current entry.
+
+ You can also use this while (bulk-)rescheduling and
+ (bulk-)resetting the deadline of (several) items from the agenda.
+
+ Thanks to Memnon Anon for a heads up about this!
+
+**** American-style dates are now understood by =org-read-date=
+
+ So when you are prompted for a date, you can now answer like this
+
+ #+begin_example
+ 2/5/3 --> 2003-02-05
+ 2/5 --> <CURRENT-YEAR>-02-05
+ #+end_example
+
+*** Agenda
+
+**** =org-agenda-custom-commands= has a default value
+
+ This option used to be `nil' by default. This now has a default
+ value, displaying an agenda and all TODOs. See the docstring for
+ details. Thanks to Carsten for this.
+
+**** Improved filtering through =org-agenda-to-appt=
+
+ The new function allows the user to refine the scope of entries
+ to pass to =org-agenda-get-day-entries= and allows to filter out
+ entries using a function.
+
+ Thanks to Peter Münster for raising a related issue and to
+ Tassilo Horn for this idea. Also thanks to Peter Münster for
+ [[git:68ffb7a7][fixing a small bug]] in the final implementation.
+
+**** Allow ap/pm times in agenda time grid
+
+ Times in the agenda can now be displayed in am/pm format. See
+ the new variable =org-agenda-timegrid-use-ampm=. Thanks to
+ C. A. Webber for a patch to this effect.
+
+**** Agenda: Added a bulk "scattering" command
+
+ =B S= in the agenda buffer will cause tasks to be rescheduled a
+ random number of days into the future, with 7 as the default.
+ This is useful if you've got a ton of tasks scheduled for today,
+ you realize you'll never deal with them all, and you just want
+ them to be distributed across the next N days. When called with
+ a prefix arg, rescheduling will avoid weekend days.
+
+ Thanks to John Wiegley for this.
+
+*** Exporting
+
+**** Simplification of org-export-html-preamble/postamble
+
+ When set to `t', export the preamble/postamble as usual, honoring
+ the =org-export-email/author/creator-info= variables.
+
+ When set to a formatting string, insert this string. See the
+ docstring of these variable for details about available
+ %-sequences.
+
+ You can set =:html-preamble= in publishing project in the same
+ way: `t' means to honor =:email/creator/author-info=, and a
+ formatting string will insert a string.
+
+**** New exporters to Latin-1 and UTF-8
+
+ While Ulf Stegemann was going through the entities list to
+ improve the LaTeX export, he had the great idea to provide
+ representations for many of the entities in Latin-1, and for all
+ of them in UTF-8. This means that we can now export files rich
+ in special symbols to Latin-1 and to UTF-8 files. These new
+ exporters can be reached with the commands =C-c C-e n= and =C-c
+ C-e u=, respectively.
+
+ When there is no representation for a given symbol in the
+ targeted coding system, you can choose to keep the TeX-macro-like
+ representation, or to get an "explanatory" representation. For
+ example, =\simeq= could be represented as "[approx. equal to]".
+ Please use the variable =org-entities-ascii-explanatory= to state
+ your preference.
+
+**** HTML export: Add class to outline containers using property
+
+ The =HTML_CONTAINER_CLASS= property can now be used to add a
+ class name to the outline container of a node in HTML export.
+
+**** Throw an error when creating an image from a LaTeX snippet fails
+
+ This behavior can be configured with the new option variable
+ =org-format-latex-signal-error=.
+
+**** Support for creating BEAMER presentations from Org-mode documents
+
+ Org-mode documents or subtrees can now be converted directly in
+ to BEAMER presentation. Turning a tree into a simple
+ presentations is straight forward, and there is also quite some
+ support to make richer presentations as well. See the [[http://orgmode.org/manual/Beamer-class-export.html#Beamer-class-export][BEAMER
+ section]] in the manual for more details.
+
+ Thanks to everyone who has contributed to the discussion about
+ BEAMER support and how it should work. This was a great example
+ for how this community can achieve a much better result than any
+ individual could.
+
+*** Refiling
+
+**** Refile targets can now be cached
+
+ You can turn on caching of refile targets by setting the variable
+ =org-refile-use-cache=. This should speed up refiling if you
+ have many eligible targets in many files. If you need to update
+ the cache because Org misses a newly created entry or still
+ offers a deleted one, press =C-0 C-c C-w=.
+
+**** New logging support for refiling
+
+ Whenever you refile an item, a time stamp and even a note can be
+ added to this entry. For details, see the new option
+ =org-log-refile=.
+
+ Thanks to Charles Cave for this idea.
+
+*** Completion
+
+**** In-buffer completion is now done using John Wiegleys pcomplete.el
+
+ Thanks to John Wiegley for much of this code.
+
+*** Tables
+
+**** New command =org-table-transpose-table-at-point=
+
+ See the docstring. This hack from Juan Pechiar is now part of
+ Org's core. Thanks to Juan!
+
+**** Display field's coordinates when editing it with =C-c `=
+
+ When editing a field with =C-c `=, the field's coordinate will
+ the displayed in the buffer.
+
+ Thanks to Michael Brand for a patch to this effect.
+
+**** Spreadsheet computation of durations and time values
+
+ If you want to compute time values use the =T= flag, either in
+ Calc formulas or Elisp formulas:
+
+ | Task 1 | Task 2 | Total |
+ |--------+--------+---------|
+ | 35:00 | 35:00 | 1:10:00 |
+ #+TBLFM: @2$3=$1+$2;T
+
+ Values must be of the form =[HH:]MM:SS=, where hours are
+ optional.
+
+ Thanks to Martin Halder, Eric Schulte and Carsten for code and
+ feedback on this.
+
+**** Implement formulas applying to field ranges
+
+ Carsten implemented this field-ranges formulas.
+
+ : A frequently requested feature for tables has been to be able to define
+ : row formulas in a way similar to column formulas. The patch below allows
+ : things like
+ :
+ : @3=
+ : @2$2..@5$7=
+ : @I$2..@II$4=
+ :
+ : as the left hand side for table formulas in order to write a formula that
+ : is valid for an entire column or for a rectangular section in a
+ : table.
+
+ Thanks a lot to Carsten for this.
+
+**** Sending radio tables from org buffers is now allowed
+
+ Org radio tables can no also be sent inside Org buffers. Also,
+ there is a new hook which get called after a table has been sent.
+
+ Thanks to Seweryn Kokot.
+
+*** Lists
+
+**** Improved handling of lists
+
+ Nicolas Goaziou extended and improved the way Org handles lists.
+
+ 1. Indentation of text determines again end of items in
+ lists. So, some text less indented than the previous item
+ doesn't close the whole list anymore, only all items more
+ indented than it.
+
+ 2. Alphabetical bullets are implemented, through the use of the
+ variable `org-alphabetical-lists'. This also adds alphabetical
+ counters like [@c] or [@W].
+
+ 3. Lists can now safely contain drawers, inline tasks, or various
+ blocks, themselves containing lists. Two variables are
+ controlling this: `org-list-forbidden-blocks', and
+ `org-list-export-context'.
+
+ 4. Improve `newline-and-indent' (C-j): used in an item, it will
+ keep text from moving at column 0. This allows to split text
+ and make paragraphs and still not break the list.
+
+ 5. Improve `org-toggle-item' (C-c -): used on a region with
+ standard text, it will change the region into one item. With a
+ prefix argument, it will fallback to the previous behavior and
+ make every line in region an item. It permits to easily
+ integrate paragraphs inside a list.
+
+ 6. `fill-paragraph' (M-q) now understands lists. It can freely be
+ used inside items, or on text just after a list, even with no
+ blank line around, without breaking list structure.
+
+ Thanks a lot to Nicolas for all this!
+
+*** Inline display of linked images
+
+ Images can now be displayed inline. The key C-c C-x C-v does
+ toggle the display of such images. Note that only image links
+ that have no description part will be inlined.
+
+*** Implement offsets for ordered lists
+
+ If you want to start an ordered plain list with a number different
+ from 1, you can now do it like this:
+
+ : 1. [@start:12] will star a lit a number 12
+
+*** Babel: code block body expansion for table and preview
+
+ In org-babel, code is "expanded" prior to evaluation. I.e. the
+ code that is actually evaluated comprises the code block contents,
+ augmented with the extra code which assigns the referenced data to
+ variables. It is now possible to preview expanded contents, and
+ also to expand code during during tangling. This expansion takes
+ into account all header arguments, and variables.
+
+ A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block'
+ can be used from inside of a source code block to preview its
+ expanded contents (which can be very useful for debugging).
+ tangling
+
+ The expanded body can now be tangled, this includes variable
+ values which may be the results of other source-code blocks, or
+ stored in headline properties or tables. One possible use for this
+ is to allow those using org-babel for their emacs initialization
+ to store values (e.g. usernames, passwords, etc...) in headline
+ properties or in tables.
+
+ Org-babel now supports three new header arguments, and new default
+ behavior for handling horizontal lines in tables (hlines), column
+ names, and rownames across all languages.
+
+*** Editing Convenience and Appearance
+
+**** New command =org-copy-visible= (=C-c C-x v=)
+
+ This command will copy the visible text in the region into the
+ kill ring. Thanks to Florian Beck for this function and to
+ Carsten for adding it to org.el and documenting it!
+
+**** Make it possible to protect hidden subtrees from being killed by =C-k=
+
+ See the new variable =org-ctrl-k-protect-subtree=. This was a
+ request by Scott Otterson.
+
+**** Implement pretty display of entities, sub-, and superscripts.
+
+ The command =C-c C-x \= toggles the display of Org's special
+ entities like =\alpha= as pretty unicode characters. Also, sub
+ and superscripts are displayed in a pretty way (raised/lower
+ display, in a smaller font). If you want to exclude sub- and
+ superscripts, see the variable
+ =org-pretty-entities-include-sub-superscripts=.
+
+ Thanks to Eric Schulte and Ulf Stegeman for making this possible.
+
+**** New faces for title, date, author and email address lines
+
+ The keywords in these lines are now dimmed out, and the title is
+ displayed in a larger font, and a special font is also used for
+ author, date, and email information. This is implemented by the
+ following new faces:
+
+ =org-document-title=
+ =org-document-info=
+ =org-document-info-keyword=
+
+ In addition, the variable =org-hidden-keywords= can be used to
+ make the corresponding keywords disappear.
+
+ Thanks to Dan Davison for this feature.
+
+**** Simpler way to specify faces for tags and todo keywords
+
+ The variables =org-todo-keyword-faces=, =org-tag-faces=, and
+ =org-priority-faces= now accept simple color names as
+ specifications. The colors will be used as either foreground or
+ background color for the corresponding keyword. See also the
+ variable =org-faces-easy-properties=, which governs which face
+ property is affected by this setting.
+
+ This is really a great simplification for setting keyword faces.
+ The change is based on an idea and patch by Ryan Thompson.
+
+**** <N> in tables now means fixed width, not maximum width
+
+ Requested by Michael Brand.
+
+**** Better level cycling function
+
+ =TAB= in an empty headline cycles the level of that headline
+ through likely states. Ryan Thompson implemented an improved
+ version of this function, which does not depend upon when exactly
+ this command is used. Thanks to Ryan for this improvement.
+
+**** Adaptive filling
+
+ For paragraph text, =org-adaptive-fill-function= did not handle
+ the base case of regular text which needed to be filled. This is
+ now fixed. Among other things, it allows email-style ">"
+ comments to be filled correctly.
+
+ Thanks to Dan Hackney for this patch.
+
+**** `org-reveal' (=C-c C-r=) also decrypts encrypted entries (org-crypt.el)
+
+ Thanks to Richard Riley for triggering this change.
+
+**** Better automatic letter selection for TODO keywords
+
+ When all first letters of keywords have been used, Org now
+ assigns more meaningful characters based on the keywords.
+
+ Thanks to Mikael Fornius for this patch.
+
+*** Clocking
+
+**** Clock: Allow synchronous update of timestamps in CLOCK log
+
+ Using =S-M-<up/down>= on CLOCK log timestamps will
+ increase/decrease the two timestamps on this line so that
+ duration will keep the same. Note that duration can still be
+ slightly modified in case a timestamp needs some rounding.
+
+ Thanks to Rainer Stengele for this idea.
+
+**** Localized clock tables
+
+ Clock tables now support a new new =:lang= parameter, allowing
+ the user to customize the localization of the table headers. See
+ the variable =org-clock-clocktable-language-setup= which controls
+ available translated strings.
+
+**** Show clock overruns in mode line
+
+ When clocking an item with a planned effort, overrunning the
+ planned time is now made visible in the mode line, for example
+ using the new face =org-mode-line-clock-overrun=, or by adding an
+ extra string given by =org-task-overrun-text=.
+
+ Thanks to Richard Riley for a patch to this effect.
+
+**** Clock reports can now include the running, incomplete clock
+
+ If you have a clock running, and the entry being clocked falls
+ into the scope when creating a clock table, the time so far spent
+ can be added to the total. This behavior depends on the setting
+ of =org-clock-report-include-clocking-task=. The default is
+ =nil=.
+
+ Thanks to Bernt Hansen for this useful addition.
+
+*** Misc
+
+**** Improvements with inline tasks and indentation
+
+ There is now a configurable way on how to export inline tasks.
+ See the new variable =org-inlinetask-export-templates=.
+
+ Thanks to Nicolas Goaziou for coding these changes.
+
+**** A property value of "nil" now means to unset a property
+
+ This can be useful in particular with property inheritance, if
+ some upper level has the property, and some grandchild of it
+ would like to have the default settings (i.e. not overruled by a
+ property) back.
+
+ Thanks to Robert Goldman and Bernt Hansen for suggesting this
+ change.
+
+**** New helper functions in org-table.el
+
+ There are new functions to access and write to a specific table field.
+ This is for hackers, and maybe for the org-babel people.
+
+ #+begin_example
+ org-table-get
+ org-table-put
+ org-table-current-line
+ org-table-goto-line
+ #+end_example
+
+**** Archiving: Allow to reverse order in target node
+
+ The new option =org-archive-reversed-order= allows to have
+ archived entries inserted in a last-on-top fashion in the target
+ node.
+
+ This was requested by Tom.
+
+**** Org-reveal: Double prefix arg shows the entire subtree of the parent
+
+ This can help to get out of an inconsistent state produced for
+ example by viewing from the agenda.
+
+ This was a request by Matt Lundin.
+
+* License
+
+ 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/>.
diff --git a/etc/schema/od-manifest-schema-v1.2-cs01.rnc b/etc/schema/od-manifest-schema-v1.2-cs01.rnc
new file mode 100644
index 0000000..647828d
--- /dev/null
+++ b/etc/schema/od-manifest-schema-v1.2-cs01.rnc
@@ -0,0 +1,88 @@
+# Open Document Format for Office Applications (OpenDocument) Version 1.2
+# Committee Specification (CS) 01, 17 March 2011
+# Manifest Relax-NG Schema
+#
+# Copyright (c) OASIS Open 2002-2011. All Rights Reserved.
+#
+# All capitalized terms in the following text have the meanings assigned to them
+# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The
+# full Policy may be found at the OASIS website.
+#
+# This document and translations of it may be copied and furnished to others, and
+# derivative works that comment on or otherwise explain it or assist in its
+# implementation may be prepared, copied, published, and distributed, in whole or
+# in part, without restriction of any kind, provided that the above copyright
+# notice and this section are included on all such copies and derivative works.
+# However, this document itself may not be modified in any way, including by
+# removing the copyright notice or references to OASIS, except as needed for the
+# purpose of developing any document or deliverable produced by an OASIS
+# Technical Committee (in which case the rules applicable to copyrights, as set
+# forth in the OASIS IPR Policy, must be followed) or as required to translate it
+# into languages other than English.
+#
+# The limited permissions granted above are perpetual and will not be revoked by
+# OASIS or its successors or assigns.
+#
+# This document and the information contained herein is provided on an "AS IS"
+# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT
+# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT
+# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR
+# FITNESS FOR A PARTICULAR PURPOSE.
+
+namespace manifest =
+ "urn:oasis:names:tc:opendocument:xmlns:manifest:1.0"
+
+start = manifest
+manifest = element manifest:manifest { manifest-attlist, file-entry+ }
+manifest-attlist = attribute manifest:version { "1.2" }
+file-entry =
+ element manifest:file-entry { file-entry-attlist, encryption-data? }
+file-entry-attlist =
+ attribute manifest:full-path { \string }
+ & attribute manifest:size { nonNegativeInteger }?
+ & attribute manifest:media-type { \string }
+ & attribute manifest:preferred-view-mode {
+ "edit" | "presentation-slide-show" | "read-only" | namespacedToken
+ }?
+ & attribute manifest:version { \string }?
+encryption-data =
+ element manifest:encryption-data {
+ encryption-data-attlist,
+ algorithm,
+ start-key-generation?,
+ key-derivation
+ }
+encryption-data-attlist =
+ attribute manifest:checksum-type { "SHA1/1K" | anyURI }
+ & attribute manifest:checksum { base64Binary }
+algorithm =
+ element manifest:algorithm { algorithm-attlist, anyElements }
+algorithm-attlist =
+ attribute manifest:algorithm-name { "Blowfish CFB" | anyURI }
+ & attribute manifest:initialisation-vector { base64Binary }
+anyAttListOrElements =
+ attribute * { text }*,
+ anyElements
+anyElements =
+ element * {
+ mixed { anyAttListOrElements }
+ }*
+key-derivation =
+ element manifest:key-derivation { key-derivation-attlist, empty }
+key-derivation-attlist =
+ attribute manifest:key-derivation-name { "PBKDF2" | anyURI }
+ & attribute manifest:salt { base64Binary }
+ & attribute manifest:iteration-count { nonNegativeInteger }
+ & attribute manifest:key-size { nonNegativeInteger }?
+start-key-generation =
+ element manifest:start-key-generation {
+ start-key-generation-attlist, empty
+ }
+start-key-generation-attlist =
+ attribute manifest:start-key-generation-name { "SHA1" | anyURI }
+ & attribute manifest:key-size { nonNegativeInteger }?
+base64Binary = xsd:base64Binary
+namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" }
+nonNegativeInteger = xsd:nonNegativeInteger
+\string = xsd:string
+anyURI = xsd:anyURI
diff --git a/etc/schema/od-schema-v1.2-cs01.rnc b/etc/schema/od-schema-v1.2-cs01.rnc
new file mode 100644
index 0000000..83ad017
--- /dev/null
+++ b/etc/schema/od-schema-v1.2-cs01.rnc
@@ -0,0 +1,6280 @@
+# Open Document Format for Office Applications (OpenDocument) Version 1.2
+# Committee Specification (CS) 01, 17 March 2011
+# Relax-NG Schema
+#
+# Copyright (c) OASIS Open 2002-2011. All Rights Reserved.
+#
+# All capitalized terms in the following text have the meanings assigned to them
+# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The
+# full Policy may be found at the OASIS website.
+#
+# This document and translations of it may be copied and furnished to others, and
+# derivative works that comment on or otherwise explain it or assist in its
+# implementation may be prepared, copied, published, and distributed, in whole or
+# in part, without restriction of any kind, provided that the above copyright
+# notice and this section are included on all such copies and derivative works.
+# However, this document itself may not be modified in any way, including by
+# removing the copyright notice or references to OASIS, except as needed for the
+# purpose of developing any document or deliverable produced by an OASIS
+# Technical Committee (in which case the rules applicable to copyrights, as set
+# forth in the OASIS IPR Policy, must be followed) or as required to translate it
+# into languages other than English.
+#
+# The limited permissions granted above are perpetual and will not be revoked by
+# OASIS or its successors or assigns.
+#
+# This document and the information contained herein is provided on an "AS IS"
+# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT
+# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT
+# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR
+# FITNESS FOR A PARTICULAR PURPOSE.
+
+namespace anim = "urn:oasis:names:tc:opendocument:xmlns:animation:1.0"
+namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
+namespace config = "urn:oasis:names:tc:opendocument:xmlns:config:1.0"
+namespace db = "urn:oasis:names:tc:opendocument:xmlns:database:1.0"
+namespace dc = "http://purl.org/dc/elements/1.1/"
+namespace dr3d = "urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0"
+namespace draw = "urn:oasis:names:tc:opendocument:xmlns:drawing:1.0"
+namespace fo =
+ "urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0"
+namespace form = "urn:oasis:names:tc:opendocument:xmlns:form:1.0"
+namespace grddl = "http://www.w3.org/2003/g/data-view#"
+namespace math = "http://www.w3.org/1998/Math/MathML"
+namespace meta = "urn:oasis:names:tc:opendocument:xmlns:meta:1.0"
+namespace number = "urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0"
+namespace office = "urn:oasis:names:tc:opendocument:xmlns:office:1.0"
+namespace presentation =
+ "urn:oasis:names:tc:opendocument:xmlns:presentation:1.0"
+namespace script = "urn:oasis:names:tc:opendocument:xmlns:script:1.0"
+namespace smil =
+ "urn:oasis:names:tc:opendocument:xmlns:smil-compatible:1.0"
+namespace style = "urn:oasis:names:tc:opendocument:xmlns:style:1.0"
+namespace svg =
+ "urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0"
+namespace table = "urn:oasis:names:tc:opendocument:xmlns:table:1.0"
+namespace text = "urn:oasis:names:tc:opendocument:xmlns:text:1.0"
+namespace xforms = "http://www.w3.org/2002/xforms"
+namespace xhtml = "http://www.w3.org/1999/xhtml"
+namespace xlink = "http://www.w3.org/1999/xlink"
+
+office-process-content = attribute office:process-content { boolean }?
+start =
+ office-document
+ | office-document-content
+ | office-document-styles
+ | office-document-meta
+ | office-document-settings
+office-document =
+ element office:document {
+ office-document-attrs,
+ office-document-common-attrs,
+ office-meta,
+ office-settings,
+ office-scripts,
+ office-font-face-decls,
+ office-styles,
+ office-automatic-styles,
+ office-master-styles,
+ office-body
+ }
+office-document-content =
+ element office:document-content {
+ office-document-common-attrs,
+ office-scripts,
+ office-font-face-decls,
+ office-automatic-styles,
+ office-body
+ }
+office-document-styles =
+ element office:document-styles {
+ office-document-common-attrs,
+ office-font-face-decls,
+ office-styles,
+ office-automatic-styles,
+ office-master-styles
+ }
+office-document-meta =
+ element office:document-meta {
+ office-document-common-attrs, office-meta
+ }
+office-document-settings =
+ element office:document-settings {
+ office-document-common-attrs, office-settings
+ }
+office-document-common-attrs =
+ attribute office:version { "1.2" }
+ & attribute grddl:transformation {
+ list { anyIRI* }
+ }?
+office-document-attrs = attribute office:mimetype { \string }
+office-meta = element office:meta { office-meta-content-strict }?
+office-meta-content-strict = office-meta-data*
+office-body = element office:body { office-body-content }
+office-body-content =
+ element office:text {
+ office-text-attlist,
+ office-text-content-prelude,
+ office-text-content-main,
+ office-text-content-epilogue
+ }
+ | element office:drawing {
+ office-drawing-attlist,
+ office-drawing-content-prelude,
+ office-drawing-content-main,
+ office-drawing-content-epilogue
+ }
+ | element office:presentation {
+ office-presentation-attlist,
+ office-presentation-content-prelude,
+ office-presentation-content-main,
+ office-presentation-content-epilogue
+ }
+ | element office:spreadsheet {
+ office-spreadsheet-attlist,
+ office-spreadsheet-content-prelude,
+ office-spreadsheet-content-main,
+ office-spreadsheet-content-epilogue
+ }
+ | element office:chart {
+ office-chart-attlist,
+ office-chart-content-prelude,
+ office-chart-content-main,
+ office-chart-content-epilogue
+ }
+ | element office:image {
+ office-image-attlist,
+ office-image-content-prelude,
+ office-image-content-main,
+ office-image-content-epilogue
+ }
+ | office-database
+office-text-content-prelude =
+ office-forms, text-tracked-changes, text-decls, table-decls
+office-text-content-main =
+ text-content*
+ | (text-page-sequence, (shape)*)
+text-content =
+ text-h
+ | text-p
+ | text-list
+ | text-numbered-paragraph
+ | table-table
+ | text-section
+ | text-soft-page-break
+ | text-table-of-content
+ | text-illustration-index
+ | text-table-index
+ | text-object-index
+ | text-user-index
+ | text-alphabetical-index
+ | text-bibliography
+ | shape
+ | change-marks
+office-text-content-epilogue = table-functions
+office-text-attlist =
+ attribute text:global { boolean }?
+ & attribute text:use-soft-page-breaks { boolean }?
+office-drawing-attlist = empty
+office-drawing-content-prelude = text-decls, table-decls
+office-drawing-content-main = draw-page*
+office-drawing-content-epilogue = table-functions
+office-presentation-attlist = empty
+office-presentation-content-prelude =
+ text-decls, table-decls, presentation-decls
+office-presentation-content-main = draw-page*
+office-presentation-content-epilogue =
+ presentation-settings, table-functions
+office-spreadsheet-content-prelude =
+ table-tracked-changes?, text-decls, table-decls
+table-decls =
+ table-calculation-settings?,
+ table-content-validations?,
+ table-label-ranges?
+office-spreadsheet-content-main = table-table*
+office-spreadsheet-content-epilogue = table-functions
+table-functions =
+ table-named-expressions?,
+ table-database-ranges?,
+ table-data-pilot-tables?,
+ table-consolidation?,
+ table-dde-links?
+office-chart-attlist = empty
+office-chart-content-prelude = text-decls, table-decls
+office-chart-content-main = chart-chart
+office-chart-content-epilogue = table-functions
+office-image-attlist = empty
+office-image-content-prelude = empty
+office-image-content-main = draw-frame
+office-image-content-epilogue = empty
+office-settings = element office:settings { config-config-item-set+ }?
+config-config-item-set =
+ element config:config-item-set {
+ config-config-item-set-attlist, config-items
+ }
+config-items =
+ (config-config-item
+ | config-config-item-set
+ | config-config-item-map-named
+ | config-config-item-map-indexed)+
+config-config-item-set-attlist = attribute config:name { \string }
+config-config-item =
+ element config:config-item { config-config-item-attlist, text }
+config-config-item-attlist =
+ attribute config:name { \string }
+ & attribute config:type {
+ "boolean"
+ | "short"
+ | "int"
+ | "long"
+ | "double"
+ | "string"
+ | "datetime"
+ | "base64Binary"
+ }
+config-config-item-map-indexed =
+ element config:config-item-map-indexed {
+ config-config-item-map-indexed-attlist,
+ config-config-item-map-entry+
+ }
+config-config-item-map-indexed-attlist =
+ attribute config:name { \string }
+config-config-item-map-entry =
+ element config:config-item-map-entry {
+ config-config-item-map-entry-attlist, config-items
+ }
+config-config-item-map-entry-attlist =
+ attribute config:name { \string }?
+config-config-item-map-named =
+ element config:config-item-map-named {
+ config-config-item-map-named-attlist, config-config-item-map-entry+
+ }
+config-config-item-map-named-attlist = attribute config:name { \string }
+office-scripts =
+ element office:scripts { office-script*, office-event-listeners? }?
+office-script =
+ element office:script {
+ office-script-attlist,
+ mixed { anyElements }
+ }
+office-script-attlist = attribute script:language { \string }
+office-font-face-decls =
+ element office:font-face-decls { style-font-face* }?
+office-styles =
+ element office:styles {
+ styles
+ & style-default-style*
+ & style-default-page-layout?
+ & text-outline-style?
+ & text-notes-configuration*
+ & text-bibliography-configuration?
+ & text-linenumbering-configuration?
+ & draw-gradient*
+ & svg-linearGradient*
+ & svg-radialGradient*
+ & draw-hatch*
+ & draw-fill-image*
+ & draw-marker*
+ & draw-stroke-dash*
+ & draw-opacity*
+ & style-presentation-page-layout*
+ & table-table-template*
+ }?
+office-automatic-styles =
+ element office:automatic-styles { styles & style-page-layout* }?
+office-master-styles =
+ element office:master-styles {
+ style-master-page* & style-handout-master? & draw-layer-set?
+ }?
+styles =
+ style-style*
+ & text-list-style*
+ & number-number-style*
+ & number-currency-style*
+ & number-percentage-style*
+ & number-date-style*
+ & number-time-style*
+ & number-boolean-style*
+ & number-text-style*
+office-meta-data =
+ element meta:generator { \string }
+ | element dc:title { \string }
+ | element dc:description { \string }
+ | element dc:subject { \string }
+ | element meta:keyword { \string }
+ | element meta:initial-creator { \string }
+ | dc-creator
+ | element meta:printed-by { \string }
+ | element meta:creation-date { dateTime }
+ | dc-date
+ | element meta:print-date { dateTime }
+ | element meta:template {
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?,
+ attribute xlink:title { \string }?,
+ attribute meta:date { dateTime }?
+ }
+ | element meta:auto-reload {
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "replace" }?,
+ attribute xlink:actuate { "onLoad" }?)?,
+ attribute meta:delay { duration }?
+ }
+ | element meta:hyperlink-behaviour {
+ attribute office:target-frame-name { targetFrameName }?,
+ attribute xlink:show { "new" | "replace" }?
+ }
+ | element dc:language { language }
+ | element meta:editing-cycles { nonNegativeInteger }
+ | element meta:editing-duration { duration }
+ | element meta:document-statistic {
+ attribute meta:page-count { nonNegativeInteger }?,
+ attribute meta:table-count { nonNegativeInteger }?,
+ attribute meta:draw-count { nonNegativeInteger }?,
+ attribute meta:image-count { nonNegativeInteger }?,
+ attribute meta:ole-object-count { nonNegativeInteger }?,
+ attribute meta:object-count { nonNegativeInteger }?,
+ attribute meta:paragraph-count { nonNegativeInteger }?,
+ attribute meta:word-count { nonNegativeInteger }?,
+ attribute meta:character-count { nonNegativeInteger }?,
+ attribute meta:frame-count { nonNegativeInteger }?,
+ attribute meta:sentence-count { nonNegativeInteger }?,
+ attribute meta:syllable-count { nonNegativeInteger }?,
+ attribute meta:non-whitespace-character-count {
+ nonNegativeInteger
+ }?,
+ attribute meta:row-count { nonNegativeInteger }?,
+ attribute meta:cell-count { nonNegativeInteger }?
+ }
+ | element meta:user-defined {
+ attribute meta:name { \string },
+ ((attribute meta:value-type { "float" },
+ double)
+ | (attribute meta:value-type { "date" },
+ dateOrDateTime)
+ | (attribute meta:value-type { "time" },
+ duration)
+ | (attribute meta:value-type { "boolean" },
+ boolean)
+ | (attribute meta:value-type { "string" },
+ \string)
+ | text)
+ }
+dc-creator = element dc:creator { \string }
+dc-date = element dc:date { dateTime }
+text-h =
+ element text:h {
+ heading-attrs,
+ paragraph-attrs,
+ text-number?,
+ paragraph-content-or-hyperlink*
+ }
+heading-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:restart-numbering { boolean }?
+ & attribute text:start-value { nonNegativeInteger }?
+ & attribute text:is-list-header { boolean }?
+text-number = element text:number { \string }
+text-p =
+ element text:p { paragraph-attrs, paragraph-content-or-hyperlink* }
+paragraph-attrs =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:class-names { styleNameRefs }?
+ & attribute text:cond-style-name { styleNameRef }?
+ & (xml-id,
+ attribute text:id { NCName }?)?
+ & common-in-content-meta-attlist?
+text-page-sequence = element text:page-sequence { text-page+ }
+text-page = element text:page { text-page-attlist, empty }
+text-page-attlist = attribute text:master-page-name { styleNameRef }
+text-list =
+ element text:list {
+ text-list-attr, text-list-header?, text-list-item*
+ }
+text-list-attr =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:continue-numbering { boolean }?
+ & attribute text:continue-list { IDREF }?
+ & xml-id?
+text-list-item =
+ element text:list-item { text-list-item-attr, text-list-item-content }
+text-list-item-content =
+ text-number?, (text-p | text-h | text-list | text-soft-page-break)*
+text-list-item-attr =
+ attribute text:start-value { nonNegativeInteger }?
+ & attribute text:style-override { styleNameRef }?
+ & xml-id?
+text-list-header =
+ element text:list-header {
+ text-list-header-attr, text-list-item-content
+ }
+text-list-header-attr = xml-id?
+text-numbered-paragraph =
+ element text:numbered-paragraph {
+ text-numbered-paragraph-attr, text-number?, (text-p | text-h)
+ }
+text-numbered-paragraph-attr =
+ attribute text:list-id { NCName }
+ & attribute text:level { positiveInteger }?
+ & (attribute text:style-name { styleNameRef },
+ attribute text:continue-numbering { boolean },
+ attribute text:start-value { nonNegativeInteger })?
+ & xml-id?
+text-section =
+ element text:section {
+ text-section-attlist,
+ (text-section-source | text-section-source-dde | empty),
+ text-content*
+ }
+text-section-attlist =
+ common-section-attlist
+ & (attribute text:display { "true" | "none" }
+ | (attribute text:display { "condition" },
+ attribute text:condition { \string })
+ | empty)
+common-section-attlist =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:name { \string }
+ & attribute text:protected { boolean }?
+ & attribute text:protection-key { \string }?
+ & attribute text:protection-key-digest-algorithm { anyIRI }?
+ & xml-id?
+text-section-source =
+ element text:section-source { text-section-source-attr }
+text-section-source-attr =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?)?
+ & attribute text:section-name { \string }?
+ & attribute text:filter-name { \string }?
+text-section-source-dde = office-dde-source
+text-tracked-changes =
+ element text:tracked-changes {
+ text-tracked-changes-attr, text-changed-region*
+ }?
+text-tracked-changes-attr = attribute text:track-changes { boolean }?
+text-changed-region =
+ element text:changed-region {
+ text-changed-region-attr, text-changed-region-content
+ }
+text-changed-region-attr =
+ xml-id,
+ attribute text:id { NCName }?
+text-changed-region-content =
+ element text:insertion { office-change-info }
+ | element text:deletion { office-change-info, text-content* }
+ | element text:format-change { office-change-info }
+change-marks =
+ element text:change { change-mark-attr }
+ | element text:change-start { change-mark-attr }
+ | element text:change-end { change-mark-attr }
+change-mark-attr = attribute text:change-id { IDREF }
+text-soft-page-break = element text:soft-page-break { empty }
+text-decls =
+ element text:variable-decls { text-variable-decl* }?,
+ element text:sequence-decls { text-sequence-decl* }?,
+ element text:user-field-decls { text-user-field-decl* }?,
+ element text:dde-connection-decls { text-dde-connection-decl* }?,
+ text-alphabetical-index-auto-mark-file?
+paragraph-content-or-hyperlink = paragraph-content | text-a
+paragraph-content =
+ text
+ | element text:s {
+ attribute text:c { nonNegativeInteger }?
+ }
+ | element text:tab { text-tab-attr }
+ | element text:line-break { empty }
+ | text-soft-page-break
+ | element text:span {
+ attribute text:style-name { styleNameRef }?,
+ attribute text:class-names { styleNameRefs }?,
+ paragraph-content-or-hyperlink*
+ }
+ | element text:meta {
+ text-meta-attlist, paragraph-content-or-hyperlink*
+ }
+ | (text-bookmark | text-bookmark-start | text-bookmark-end)
+ | element text:reference-mark {
+ attribute text:name { \string }
+ }
+ | (element text:reference-mark-start {
+ attribute text:name { \string }
+ }
+ | element text:reference-mark-end {
+ attribute text:name { \string }
+ })
+ | element text:note {
+ text-note-class,
+ attribute text:id { \string }?,
+ element text:note-citation {
+ attribute text:label { \string }?,
+ text
+ },
+ element text:note-body { text-content* }
+ }
+ | element text:ruby {
+ attribute text:style-name { styleNameRef }?,
+ element text:ruby-base { paragraph-content-or-hyperlink* },
+ element text:ruby-text {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+ }
+ | (office-annotation | office-annotation-end)
+ | change-marks
+ | shape
+ | element text:date { text-date-attlist, text }
+ | element text:time { text-time-attlist, text }
+ | element text:page-number { text-page-number-attlist, text }
+ | element text:page-continuation {
+ text-page-continuation-attlist, text
+ }
+ | element text:sender-firstname { common-field-fixed-attlist, text }
+ | element text:sender-lastname { common-field-fixed-attlist, text }
+ | element text:sender-initials { common-field-fixed-attlist, text }
+ | element text:sender-title { common-field-fixed-attlist, text }
+ | element text:sender-position { common-field-fixed-attlist, text }
+ | element text:sender-email { common-field-fixed-attlist, text }
+ | element text:sender-phone-private {
+ common-field-fixed-attlist, text
+ }
+ | element text:sender-fax { common-field-fixed-attlist, text }
+ | element text:sender-company { common-field-fixed-attlist, text }
+ | element text:sender-phone-work { common-field-fixed-attlist, text }
+ | element text:sender-street { common-field-fixed-attlist, text }
+ | element text:sender-city { common-field-fixed-attlist, text }
+ | element text:sender-postal-code { common-field-fixed-attlist, text }
+ | element text:sender-country { common-field-fixed-attlist, text }
+ | element text:sender-state-or-province {
+ common-field-fixed-attlist, text
+ }
+ | element text:author-name { common-field-fixed-attlist, text }
+ | element text:author-initials { common-field-fixed-attlist, text }
+ | element text:chapter { text-chapter-attlist, text }
+ | element text:file-name { text-file-name-attlist, text }
+ | element text:template-name { text-template-name-attlist, text }
+ | element text:sheet-name { text }
+ | element text:variable-set {
+ (common-field-name-attlist
+ & common-field-formula-attlist
+ & common-value-and-type-attlist
+ & common-field-display-value-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:variable-get {
+ (common-field-name-attlist
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:variable-input {
+ (common-field-name-attlist
+ & common-field-description-attlist
+ & common-value-type-attlist
+ & common-field-display-value-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:user-field-get {
+ (common-field-name-attlist
+ & common-field-display-value-formula-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:user-field-input {
+ (common-field-name-attlist
+ & common-field-description-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:sequence {
+ (common-field-name-attlist
+ & common-field-formula-attlist
+ & common-field-num-format-attlist
+ & text-sequence-ref-name),
+ text
+ }
+ | element text:expression {
+ (common-field-formula-attlist
+ & common-value-and-type-attlist?
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:text-input { common-field-description-attlist, text }
+ | element text:initial-creator { common-field-fixed-attlist, text }
+ | element text:creation-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { dateOrDateTime }?),
+ text
+ }
+ | element text:creation-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { timeOrDateTime }?),
+ text
+ }
+ | element text:description { common-field-fixed-attlist, text }
+ | element text:user-defined {
+ (common-field-fixed-attlist
+ & attribute text:name { \string }
+ & common-field-data-style-name-attlist
+ & attribute office:value { double }?
+ & attribute office:date-value { dateOrDateTime }?
+ & attribute office:time-value { duration }?
+ & attribute office:boolean-value { boolean }?
+ & attribute office:string-value { \string }?),
+ text
+ }
+ | element text:print-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { time }?),
+ text
+ }
+ | element text:print-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { date }?),
+ text
+ }
+ | element text:printed-by { common-field-fixed-attlist, text }
+ | element text:title { common-field-fixed-attlist, text }
+ | element text:subject { common-field-fixed-attlist, text }
+ | element text:keywords { common-field-fixed-attlist, text }
+ | element text:editing-cycles { common-field-fixed-attlist, text }
+ | element text:editing-duration {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:duration { duration }?),
+ text
+ }
+ | element text:modification-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { time }?),
+ text
+ }
+ | element text:modification-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { date }?),
+ text
+ }
+ | element text:creator { common-field-fixed-attlist, text }
+ | element text:page-count
+ | text:paragraph-count
+ | text:word-count
+ | text:character-count
+ | text:table-count
+ | text:image-count
+ | text:object-count {
+ common-field-num-format-attlist, text
+ }
+ | element text:database-display {
+ text-database-display-attlist, text
+ }
+ | element text:database-next { text-database-next-attlist }
+ | element text:database-row-select {
+ text-database-row-select-attlist
+ }
+ | element text:database-row-number {
+ (common-field-database-table
+ & common-field-num-format-attlist
+ & attribute text:value { nonNegativeInteger }?),
+ text
+ }
+ | element text:database-name { common-field-database-table, text }
+ | element text:page-variable-set {
+ text-set-page-variable-attlist, text
+ }
+ | element text:page-variable-get {
+ text-get-page-variable-attlist, text
+ }
+ | element text:placeholder { text-placeholder-attlist, text }
+ | element text:conditional-text {
+ text-conditional-text-attlist, text
+ }
+ | element text:hidden-text { text-hidden-text-attlist, text }
+ | element text:reference-ref | text:bookmark-ref {
+ text-common-ref-content & text-bookmark-ref-content
+ }
+ | element text:note-ref {
+ text-common-ref-content & text-note-ref-content
+ }
+ | element text:sequence-ref {
+ text-common-ref-content & text-sequence-ref-content
+ }
+ | element text:script {
+ ((attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI })
+ | text)
+ & attribute script:language { \string }?
+ }
+ | element text:execute-macro {
+ attribute text:name { \string }?,
+ office-event-listeners?,
+ text
+ }
+ | element text:hidden-paragraph {
+ text-hidden-paragraph-attlist, text
+ }
+ | element text:dde-connection {
+ attribute text:connection-name { \string },
+ text
+ }
+ | element text:measure {
+ attribute text:kind { "value" | "unit" | "gap" },
+ text
+ }
+ | element text:table-formula {
+ (common-field-formula-attlist
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:meta-field {
+ text-meta-field-attlist, paragraph-content-or-hyperlink*
+ }
+ | element text:toc-mark-start { text-toc-mark-start-attrs }
+ | element text:toc-mark-end { text-id }
+ | element text:toc-mark {
+ attribute text:string-value { \string },
+ text-outline-level
+ }
+ | element text:user-index-mark-start {
+ text-id, text-outline-level, text-index-name
+ }
+ | element text:user-index-mark-end { text-id }
+ | element text:user-index-mark {
+ attribute text:string-value { \string },
+ text-outline-level,
+ text-index-name
+ }
+ | element text:alphabetical-index-mark-start {
+ text-id, text-alphabetical-index-mark-attrs
+ }
+ | element text:alphabetical-index-mark-end { text-id }
+ | element text:alphabetical-index-mark {
+ attribute text:string-value { \string },
+ text-alphabetical-index-mark-attrs
+ }
+ | element text:bibliography-mark {
+ attribute text:bibliography-type { text-bibliography-types },
+ attribute text:identifier
+ | text:address
+ | text:annote
+ | text:author
+ | text:booktitle
+ | text:chapter
+ | text:edition
+ | text:editor
+ | text:howpublished
+ | text:institution
+ | text:journal
+ | text:month
+ | text:note
+ | text:number
+ | text:organizations
+ | text:pages
+ | text:publisher
+ | text:school
+ | text:series
+ | text:title
+ | text:report-type
+ | text:volume
+ | text:year
+ | text:url
+ | text:custom1
+ | text:custom2
+ | text:custom3
+ | text:custom4
+ | text:custom5
+ | text:isbn
+ | text:issn { \string }*,
+ text
+ }
+ | element presentation:header { empty }
+ | element presentation:footer { empty }
+ | element presentation:date-time { empty }
+text-tab-attr = attribute text:tab-ref { nonNegativeInteger }?
+text-a =
+ element text:a {
+ text-a-attlist, office-event-listeners?, paragraph-content*
+ }
+text-a-attlist =
+ attribute office:name { \string }?
+ & attribute office:title { \string }?
+ & attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute office:target-frame-name { targetFrameName }?
+ & attribute xlink:show { "new" | "replace" }?
+ & attribute text:style-name { styleNameRef }?
+ & attribute text:visited-style-name { styleNameRef }?
+text-meta-attlist = common-in-content-meta-attlist? & xml-id?
+text-bookmark = element text:bookmark { text-bookmark-attlist, empty }
+text-bookmark-start =
+ element text:bookmark-start { text-bookmark-start-attlist, empty }
+text-bookmark-end =
+ element text:bookmark-end { text-bookmark-end-attlist, empty }
+text-bookmark-attlist =
+ attribute text:name { \string }
+ & xml-id?
+text-bookmark-start-attlist =
+ attribute text:name { \string }
+ & xml-id?
+ & common-in-content-meta-attlist?
+text-bookmark-end-attlist = attribute text:name { \string }
+text-note-class = attribute text:note-class { "footnote" | "endnote" }
+text-date-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:date-value { dateOrDateTime }?
+ & attribute text:date-adjust { duration }?
+text-time-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:time-value { timeOrDateTime }?
+ & attribute text:time-adjust { duration }?
+text-page-number-attlist =
+ (common-field-num-format-attlist & common-field-fixed-attlist)
+ & attribute text:page-adjust { integer }?
+ & attribute text:select-page { "previous" | "current" | "next" }?
+text-page-continuation-attlist =
+ attribute text:select-page { "previous" | "next" }
+ & attribute text:string-value { \string }?
+text-chapter-attlist =
+ attribute text:display {
+ "name"
+ | "number"
+ | "number-and-name"
+ | "plain-number-and-name"
+ | "plain-number"
+ }
+ & attribute text:outline-level { nonNegativeInteger }
+text-file-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension"
+ }?
+ & common-field-fixed-attlist
+text-template-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension" | "area" | "title"
+ }?
+text-variable-decl =
+ element text:variable-decl {
+ common-field-name-attlist, common-value-type-attlist
+ }
+text-user-field-decl =
+ element text:user-field-decl {
+ common-field-name-attlist,
+ common-field-formula-attlist?,
+ common-value-and-type-attlist
+ }
+text-sequence-decl =
+ element text:sequence-decl { text-sequence-decl-attlist }
+text-sequence-decl-attlist =
+ common-field-name-attlist
+ & attribute text:display-outline-level { nonNegativeInteger }
+ & attribute text:separation-character { character }?
+text-sequence-ref-name = attribute text:ref-name { \string }?
+common-field-database-table =
+ common-field-database-table-attlist, common-field-database-name
+common-field-database-name =
+ attribute text:database-name { \string }?
+ | form-connection-resource
+common-field-database-table-attlist =
+ attribute text:table-name { \string }
+ & attribute text:table-type { "table" | "query" | "command" }?
+text-database-display-attlist =
+ common-field-database-table
+ & common-field-data-style-name-attlist
+ & attribute text:column-name { \string }
+text-database-next-attlist =
+ common-field-database-table
+ & attribute text:condition { \string }?
+text-database-row-select-attlist =
+ common-field-database-table
+ & attribute text:condition { \string }?
+ & attribute text:row-number { nonNegativeInteger }?
+text-set-page-variable-attlist =
+ attribute text:active { boolean }?
+ & attribute text:page-adjust { integer }?
+text-get-page-variable-attlist = common-field-num-format-attlist
+text-placeholder-attlist =
+ attribute text:placeholder-type {
+ "text" | "table" | "text-box" | "image" | "object"
+ }
+ & common-field-description-attlist
+text-conditional-text-attlist =
+ attribute text:condition { \string }
+ & attribute text:string-value-if-true { \string }
+ & attribute text:string-value-if-false { \string }
+ & attribute text:current-value { boolean }?
+text-hidden-text-attlist =
+ attribute text:condition { \string }
+ & attribute text:string-value { \string }
+ & attribute text:is-hidden { boolean }?
+text-common-ref-content =
+ text
+ & attribute text:ref-name { \string }?
+text-bookmark-ref-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "number-no-superior"
+ | "number-all-superior"
+ | "number"
+ }?
+text-note-ref-content =
+ attribute text:reference-format { common-ref-format-values }?
+ & text-note-class
+text-sequence-ref-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "category-and-value"
+ | "caption"
+ | "value"
+ }?
+common-ref-format-values = "page" | "chapter" | "direction" | "text"
+text-hidden-paragraph-attlist =
+ attribute text:condition { \string }
+ & attribute text:is-hidden { boolean }?
+text-meta-field-attlist = xml-id & common-field-data-style-name-attlist
+common-value-type-attlist = attribute office:value-type { valueType }
+common-value-and-type-attlist =
+ (attribute office:value-type { "float" },
+ attribute office:value { double })
+ | (attribute office:value-type { "percentage" },
+ attribute office:value { double })
+ | (attribute office:value-type { "currency" },
+ attribute office:value { double },
+ attribute office:currency { \string }?)
+ | (attribute office:value-type { "date" },
+ attribute office:date-value { dateOrDateTime })
+ | (attribute office:value-type { "time" },
+ attribute office:time-value { duration })
+ | (attribute office:value-type { "boolean" },
+ attribute office:boolean-value { boolean })
+ | (attribute office:value-type { "string" },
+ attribute office:string-value { \string }?)
+common-field-fixed-attlist = attribute text:fixed { boolean }?
+common-field-name-attlist = attribute text:name { variableName }
+common-field-description-attlist =
+ attribute text:description { \string }?
+common-field-display-value-none-attlist =
+ attribute text:display { "value" | "none" }?
+common-field-display-value-formula-none-attlist =
+ attribute text:display { "value" | "formula" | "none" }?
+common-field-display-value-formula-attlist =
+ attribute text:display { "value" | "formula" }?
+common-field-formula-attlist = attribute text:formula { \string }?
+common-field-data-style-name-attlist =
+ attribute style:data-style-name { styleNameRef }?
+common-field-num-format-attlist = common-num-format-attlist?
+text-toc-mark-start-attrs = text-id, text-outline-level
+text-outline-level = attribute text:outline-level { positiveInteger }?
+text-id = attribute text:id { \string }
+text-index-name = attribute text:index-name { \string }
+text-alphabetical-index-mark-attrs =
+ attribute text:key1 { \string }?
+ & attribute text:key2 { \string }?
+ & attribute text:string-value-phonetic { \string }?
+ & attribute text:key1-phonetic { \string }?
+ & attribute text:key2-phonetic { \string }?
+ & attribute text:main-entry { boolean }?
+text-bibliography-types =
+ "article"
+ | "book"
+ | "booklet"
+ | "conference"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "email"
+ | "inbook"
+ | "incollection"
+ | "inproceedings"
+ | "journal"
+ | "manual"
+ | "mastersthesis"
+ | "misc"
+ | "phdthesis"
+ | "proceedings"
+ | "techreport"
+ | "unpublished"
+ | "www"
+text-index-body = element text:index-body { index-content-main* }
+index-content-main = text-content | text-index-title
+text-index-title =
+ element text:index-title {
+ common-section-attlist, index-content-main*
+ }
+text-table-of-content =
+ element text:table-of-content {
+ common-section-attlist,
+ text-table-of-content-source,
+ text-index-body
+ }
+text-table-of-content-source =
+ element text:table-of-content-source {
+ text-table-of-content-source-attlist,
+ text-index-title-template?,
+ text-table-of-content-entry-template*,
+ text-index-source-styles*
+ }
+text-table-of-content-source-attlist =
+ attribute text:outline-level { positiveInteger }?
+ & attribute text:use-outline-level { boolean }?
+ & attribute text:use-index-marks { boolean }?
+ & attribute text:use-index-source-styles { boolean }?
+ & attribute text:index-scope { "document" | "chapter" }?
+ & attribute text:relative-tab-stop-position { boolean }?
+text-table-of-content-entry-template =
+ element text:table-of-content-entry-template {
+ text-table-of-content-entry-template-attlist,
+ text-table-of-content-children*
+ }
+text-table-of-content-children =
+ text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop
+ | text-index-entry-link-start
+ | text-index-entry-link-end
+text-table-of-content-entry-template-attlist =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+text-illustration-index =
+ element text:illustration-index {
+ common-section-attlist,
+ text-illustration-index-source,
+ text-index-body
+ }
+text-illustration-index-source =
+ element text:illustration-index-source {
+ text-illustration-index-source-attrs,
+ text-index-title-template?,
+ text-illustration-index-entry-template?
+ }
+text-illustration-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-caption { boolean }?
+ & attribute text:caption-sequence-name { \string }?
+ & attribute text:caption-sequence-format {
+ "text" | "category-and-value" | "caption"
+ }?
+text-index-scope-attr =
+ attribute text:index-scope { "document" | "chapter" }?
+text-relative-tab-stop-position-attr =
+ attribute text:relative-tab-stop-position { boolean }?
+text-illustration-index-entry-template =
+ element text:illustration-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-illustration-index-entry-content =
+ text-illustration-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+text-illustration-index-entry-template-attrs =
+ attribute text:style-name { styleNameRef }
+text-table-index =
+ element text:table-index {
+ common-section-attlist, text-table-index-source, text-index-body
+ }
+text-table-index-source =
+ element text:table-index-source {
+ text-illustration-index-source-attrs,
+ text-index-title-template?,
+ text-table-index-entry-template?
+ }
+text-table-index-entry-template =
+ element text:table-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-object-index =
+ element text:object-index {
+ common-section-attlist, text-object-index-source, text-index-body
+ }
+text-object-index-source =
+ element text:object-index-source {
+ text-object-index-source-attrs,
+ text-index-title-template?,
+ text-object-index-entry-template?
+ }
+text-object-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-spreadsheet-objects { boolean }?
+ & attribute text:use-math-objects { boolean }?
+ & attribute text:use-draw-objects { boolean }?
+ & attribute text:use-chart-objects { boolean }?
+ & attribute text:use-other-objects { boolean }?
+text-object-index-entry-template =
+ element text:object-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-user-index =
+ element text:user-index {
+ common-section-attlist, text-user-index-source, text-index-body
+ }
+text-user-index-source =
+ element text:user-index-source {
+ text-user-index-source-attr,
+ text-index-title-template?,
+ text-user-index-entry-template*,
+ text-index-source-styles*
+ }
+text-user-index-source-attr =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-index-marks { boolean }?
+ & attribute text:use-index-source-styles { boolean }?
+ & attribute text:use-graphics { boolean }?
+ & attribute text:use-tables { boolean }?
+ & attribute text:use-floating-frames { boolean }?
+ & attribute text:use-objects { boolean }?
+ & attribute text:copy-outline-levels { boolean }?
+ & attribute text:index-name { \string }
+text-user-index-entry-template =
+ element text:user-index-entry-template {
+ text-user-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+ }
+text-user-index-entry-template-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+text-alphabetical-index =
+ element text:alphabetical-index {
+ common-section-attlist,
+ text-alphabetical-index-source,
+ text-index-body
+ }
+text-alphabetical-index-source =
+ element text:alphabetical-index-source {
+ text-alphabetical-index-source-attrs,
+ text-index-title-template?,
+ text-alphabetical-index-entry-template*
+ }
+text-alphabetical-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:ignore-case { boolean }?
+ & attribute text:main-entry-style-name { styleNameRef }?
+ & attribute text:alphabetical-separators { boolean }?
+ & attribute text:combine-entries { boolean }?
+ & attribute text:combine-entries-with-dash { boolean }?
+ & attribute text:combine-entries-with-pp { boolean }?
+ & attribute text:use-keys-as-entries { boolean }?
+ & attribute text:capitalize-entries { boolean }?
+ & attribute text:comma-separated { boolean }?
+ & attribute fo:language { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute text:sort-algorithm { \string }?
+text-alphabetical-index-auto-mark-file =
+ element text:alphabetical-index-auto-mark-file {
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI }
+ }
+text-alphabetical-index-entry-template =
+ element text:alphabetical-index-entry-template {
+ text-alphabetical-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+ }
+text-alphabetical-index-entry-template-attrs =
+ attribute text:outline-level { "1" | "2" | "3" | "separator" }
+ & attribute text:style-name { styleNameRef }
+text-bibliography =
+ element text:bibliography {
+ common-section-attlist, text-bibliography-source, text-index-body
+ }
+text-bibliography-source =
+ element text:bibliography-source {
+ text-index-title-template?, text-bibliography-entry-template*
+ }
+text-bibliography-entry-template =
+ element text:bibliography-entry-template {
+ text-bibliography-entry-template-attrs,
+ (text-index-entry-span
+ | text-index-entry-tab-stop
+ | text-index-entry-bibliography)*
+ }
+text-bibliography-entry-template-attrs =
+ attribute text:bibliography-type { text-bibliography-types }
+ & attribute text:style-name { styleNameRef }
+text-index-source-styles =
+ element text:index-source-styles {
+ attribute text:outline-level { positiveInteger },
+ text-index-source-style*
+ }
+text-index-source-style =
+ element text:index-source-style {
+ attribute text:style-name { styleName },
+ empty
+ }
+text-index-title-template =
+ element text:index-title-template {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+text-index-entry-chapter =
+ element text:index-entry-chapter {
+ attribute text:style-name { styleNameRef }?,
+ text-index-entry-chapter-attrs
+ }
+text-index-entry-chapter-attrs =
+ attribute text:display {
+ "name"
+ | "number"
+ | "number-and-name"
+ | "plain-number"
+ | "plain-number-and-name"
+ }?
+ & attribute text:outline-level { positiveInteger }?
+text-index-entry-text =
+ element text:index-entry-text {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-page-number =
+ element text:index-entry-page-number {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-span =
+ element text:index-entry-span {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+text-index-entry-bibliography =
+ element text:index-entry-bibliography {
+ text-index-entry-bibliography-attrs
+ }
+text-index-entry-bibliography-attrs =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:bibliography-data-field {
+ "address"
+ | "annote"
+ | "author"
+ | "bibliography-type"
+ | "booktitle"
+ | "chapter"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "edition"
+ | "editor"
+ | "howpublished"
+ | "identifier"
+ | "institution"
+ | "isbn"
+ | "issn"
+ | "journal"
+ | "month"
+ | "note"
+ | "number"
+ | "organizations"
+ | "pages"
+ | "publisher"
+ | "report-type"
+ | "school"
+ | "series"
+ | "title"
+ | "url"
+ | "volume"
+ | "year"
+ }
+text-index-entry-tab-stop =
+ element text:index-entry-tab-stop {
+ attribute text:style-name { styleNameRef }?,
+ text-index-entry-tab-stop-attrs
+ }
+text-index-entry-tab-stop-attrs =
+ attribute style:leader-char { character }?
+ & (attribute style:type { "right" }
+ | (attribute style:type { "left" },
+ attribute style:position { length }))
+text-index-entry-link-start =
+ element text:index-entry-link-start {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-link-end =
+ element text:index-entry-link-end {
+ attribute text:style-name { styleNameRef }?
+ }
+table-table =
+ element table:table {
+ table-table-attlist,
+ table-title?,
+ table-desc?,
+ table-table-source?,
+ office-dde-source?,
+ table-scenario?,
+ office-forms?,
+ table-shapes?,
+ table-columns-and-groups,
+ table-rows-and-groups,
+ table-named-expressions?
+ }
+table-columns-and-groups =
+ (table-table-column-group | table-columns-no-group)+
+table-columns-no-group =
+ (table-columns, (table-table-header-columns, table-columns?)?)
+ | (table-table-header-columns, table-columns?)
+table-columns = table-table-columns | table-table-column+
+table-rows-and-groups = (table-table-row-group | table-rows-no-group)+
+table-rows-no-group =
+ (table-rows, (table-table-header-rows, table-rows?)?)
+ | (table-table-header-rows, table-rows?)
+table-rows =
+ table-table-rows | (text-soft-page-break?, table-table-row)+
+table-table-attlist =
+ attribute table:name { \string }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:template-name { \string }?
+ & attribute table:use-first-row-styles { boolean }?
+ & attribute table:use-last-row-styles { boolean }?
+ & attribute table:use-first-column-styles { boolean }?
+ & attribute table:use-last-column-styles { boolean }?
+ & attribute table:use-banding-rows-styles { boolean }?
+ & attribute table:use-banding-columns-styles { boolean }?
+ & attribute table:protected { boolean }?
+ & attribute table:protection-key { \string }?
+ & attribute table:protection-key-digest-algorithm { anyIRI }?
+ & attribute table:print { boolean }?
+ & attribute table:print-ranges { cellRangeAddressList }?
+ & xml-id?
+ & attribute table:is-sub-table { boolean }?
+table-title = element table:title { text }
+table-desc = element table:desc { text }
+table-table-row =
+ element table:table-row {
+ table-table-row-attlist,
+ (table-table-cell | table-covered-table-cell)+
+ }
+table-table-row-attlist =
+ attribute table:number-rows-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:default-cell-style-name { styleNameRef }?
+ & attribute table:visibility { table-visibility-value }?
+ & xml-id?
+table-visibility-value = "visible" | "collapse" | "filter"
+table-table-cell =
+ element table:table-cell {
+ table-table-cell-attlist,
+ table-table-cell-attlist-extra,
+ table-table-cell-content
+ }
+table-covered-table-cell =
+ element table:covered-table-cell {
+ table-table-cell-attlist, table-table-cell-content
+ }
+table-table-cell-content =
+ table-cell-range-source?,
+ office-annotation?,
+ table-detective?,
+ text-content*
+table-table-cell-attlist =
+ attribute table:number-columns-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:content-validation-name { \string }?
+ & attribute table:formula { \string }?
+ & common-value-and-type-attlist?
+ & attribute table:protect { boolean }?
+ & attribute table:protected { boolean }?
+ & xml-id?
+ & common-in-content-meta-attlist?
+table-table-cell-attlist-extra =
+ attribute table:number-columns-spanned { positiveInteger }?
+ & attribute table:number-rows-spanned { positiveInteger }?
+ & attribute table:number-matrix-columns-spanned { positiveInteger }?
+ & attribute table:number-matrix-rows-spanned { positiveInteger }?
+table-table-column =
+ element table:table-column { table-table-column-attlist, empty }
+table-table-column-attlist =
+ attribute table:number-columns-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:visibility { table-visibility-value }?
+ & attribute table:default-cell-style-name { styleNameRef }?
+ & xml-id?
+table-table-header-columns =
+ element table:table-header-columns { table-table-column+ }
+table-table-columns =
+ element table:table-columns { table-table-column+ }
+table-table-column-group =
+ element table:table-column-group {
+ table-table-column-group-attlist, table-columns-and-groups
+ }
+table-table-column-group-attlist = attribute table:display { boolean }?
+table-table-header-rows =
+ element table:table-header-rows {
+ (text-soft-page-break?, table-table-row)+
+ }
+table-table-rows =
+ element table:table-rows { (text-soft-page-break?, table-table-row)+ }
+table-table-row-group =
+ element table:table-row-group {
+ table-table-row-group-attlist, table-rows-and-groups
+ }
+table-table-row-group-attlist = attribute table:display { boolean }?
+cellAddress =
+ xsd:string {
+ pattern = "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+"
+ }
+cellRangeAddress =
+ xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+(:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+)?"
+ }
+ | xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+:($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+"
+ }
+ | xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+"
+ }
+cellRangeAddressList =
+ xsd:string
+ >> dc:description [
+ 'Value is a space separated list of "cellRangeAddress" patterns'
+ ]
+table-table-source =
+ element table:table-source {
+ table-table-source-attlist, table-linked-source-attlist, empty
+ }
+table-table-source-attlist =
+ attribute table:mode { "copy-all" | "copy-results-only" }?
+ & attribute table:table-name { \string }?
+table-linked-source-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute table:filter-name { \string }?
+ & attribute table:filter-options { \string }?
+ & attribute table:refresh-delay { duration }?
+table-scenario =
+ element table:scenario { table-scenario-attlist, empty }
+table-scenario-attlist =
+ attribute table:scenario-ranges { cellRangeAddressList }
+ & attribute table:is-active { boolean }
+ & attribute table:display-border { boolean }?
+ & attribute table:border-color { color }?
+ & attribute table:copy-back { boolean }?
+ & attribute table:copy-styles { boolean }?
+ & attribute table:copy-formulas { boolean }?
+ & attribute table:comment { \string }?
+ & attribute table:protected { boolean }?
+table-shapes = element table:shapes { shape+ }
+table-cell-range-source =
+ element table:cell-range-source {
+ table-table-cell-range-source-attlist,
+ table-linked-source-attlist,
+ empty
+ }
+table-table-cell-range-source-attlist =
+ attribute table:name { \string }
+ & attribute table:last-column-spanned { positiveInteger }
+ & attribute table:last-row-spanned { positiveInteger }
+table-detective =
+ element table:detective { table-highlighted-range*, table-operation* }
+table-operation =
+ element table:operation { table-operation-attlist, empty }
+table-operation-attlist =
+ attribute table:name {
+ "trace-dependents"
+ | "remove-dependents"
+ | "trace-precedents"
+ | "remove-precedents"
+ | "trace-errors"
+ }
+ & attribute table:index { nonNegativeInteger }
+table-highlighted-range =
+ element table:highlighted-range {
+ (table-highlighted-range-attlist
+ | table-highlighted-range-attlist-invalid),
+ empty
+ }
+table-highlighted-range-attlist =
+ attribute table:cell-range-address { cellRangeAddress }?
+ & attribute table:direction {
+ "from-another-table" | "to-another-table" | "from-same-table"
+ }
+ & attribute table:contains-error { boolean }?
+table-highlighted-range-attlist-invalid =
+ attribute table:marked-invalid { boolean }
+office-spreadsheet-attlist =
+ attribute table:structure-protected { boolean }?,
+ attribute table:protection-key { \string }?,
+ attribute table:protection-key-digest-algorithm { anyIRI }?
+table-calculation-settings =
+ element table:calculation-settings {
+ table-calculation-setting-attlist,
+ table-null-date?,
+ table-iteration?
+ }
+table-calculation-setting-attlist =
+ attribute table:case-sensitive { boolean }?
+ & attribute table:precision-as-shown { boolean }?
+ & attribute table:search-criteria-must-apply-to-whole-cell {
+ boolean
+ }?
+ & attribute table:automatic-find-labels { boolean }?
+ & attribute table:use-regular-expressions { boolean }?
+ & attribute table:use-wildcards { boolean }?
+ & attribute table:null-year { positiveInteger }?
+table-null-date =
+ element table:null-date {
+ attribute table:value-type { "date" }?,
+ attribute table:date-value { date }?,
+ empty
+ }
+table-iteration =
+ element table:iteration {
+ attribute table:status { "enable" | "disable" }?,
+ attribute table:steps { positiveInteger }?,
+ attribute table:maximum-difference { double }?,
+ empty
+ }
+table-content-validations =
+ element table:content-validations { table-content-validation+ }
+table-content-validation =
+ element table:content-validation {
+ table-validation-attlist,
+ table-help-message?,
+ (table-error-message | (table-error-macro, office-event-listeners))?
+ }
+table-validation-attlist =
+ attribute table:name { \string }
+ & attribute table:condition { \string }?
+ & attribute table:base-cell-address { cellAddress }?
+ & attribute table:allow-empty-cell { boolean }?
+ & attribute table:display-list {
+ "none" | "unsorted" | "sort-ascending"
+ }?
+table-help-message =
+ element table:help-message {
+ attribute table:title { \string }?,
+ attribute table:display { boolean }?,
+ text-p*
+ }
+table-error-message =
+ element table:error-message {
+ attribute table:title { \string }?,
+ attribute table:display { boolean }?,
+ attribute table:message-type {
+ "stop" | "warning" | "information"
+ }?,
+ text-p*
+ }
+table-error-macro =
+ element table:error-macro {
+ attribute table:execute { boolean }?
+ }
+table-label-ranges = element table:label-ranges { table-label-range* }
+table-label-range =
+ element table:label-range { table-label-range-attlist, empty }
+table-label-range-attlist =
+ attribute table:label-cell-range-address { cellRangeAddress }
+ & attribute table:data-cell-range-address { cellRangeAddress }
+ & attribute table:orientation { "column" | "row" }
+table-named-expressions =
+ element table:named-expressions {
+ (table-named-range | table-named-expression)*
+ }
+table-named-range =
+ element table:named-range { table-named-range-attlist, empty }
+table-named-range-attlist =
+ attribute table:name { \string },
+ attribute table:cell-range-address { cellRangeAddress },
+ attribute table:base-cell-address { cellAddress }?,
+ attribute table:range-usable-as {
+ "none"
+ | list {
+ ("print-range" | "filter" | "repeat-row" | "repeat-column")+
+ }
+ }?
+table-named-expression =
+ element table:named-expression {
+ table-named-expression-attlist, empty
+ }
+table-named-expression-attlist =
+ attribute table:name { \string },
+ attribute table:expression { \string },
+ attribute table:base-cell-address { cellAddress }?
+table-database-ranges =
+ element table:database-ranges { table-database-range* }
+table-database-range =
+ element table:database-range {
+ table-database-range-attlist,
+ (table-database-source-sql
+ | table-database-source-table
+ | table-database-source-query)?,
+ table-filter?,
+ table-sort?,
+ table-subtotal-rules?
+ }
+table-database-range-attlist =
+ attribute table:name { \string }?
+ & attribute table:is-selection { boolean }?
+ & attribute table:on-update-keep-styles { boolean }?
+ & attribute table:on-update-keep-size { boolean }?
+ & attribute table:has-persistent-data { boolean }?
+ & attribute table:orientation { "column" | "row" }?
+ & attribute table:contains-header { boolean }?
+ & attribute table:display-filter-buttons { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }
+ & attribute table:refresh-delay { boolean }?
+table-database-source-sql =
+ element table:database-source-sql {
+ table-database-source-sql-attlist, empty
+ }
+table-database-source-sql-attlist =
+ attribute table:database-name { \string }
+ & attribute table:sql-statement { \string }
+ & attribute table:parse-sql-statement { boolean }?
+table-database-source-query =
+ element table:database-source-table {
+ table-database-source-table-attlist, empty
+ }
+table-database-source-table-attlist =
+ attribute table:database-name { \string }
+ & attribute table:database-table-name { \string }
+table-database-source-table =
+ element table:database-source-query {
+ table-database-source-query-attlist, empty
+ }
+table-database-source-query-attlist =
+ attribute table:database-name { \string }
+ & attribute table:query-name { \string }
+table-sort = element table:sort { table-sort-attlist, table-sort-by+ }
+table-sort-attlist =
+ attribute table:bind-styles-to-content { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }?
+ & attribute table:case-sensitive { boolean }?
+ & attribute table:language { languageCode }?
+ & attribute table:country { countryCode }?
+ & attribute table:script { scriptCode }?
+ & attribute table:rfc-language-tag { language }?
+ & attribute table:algorithm { \string }?
+ & attribute table:embedded-number-behavior {
+ "alpha-numeric" | "integer" | "double"
+ }?
+table-sort-by = element table:sort-by { table-sort-by-attlist, empty }
+table-sort-by-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:data-type {
+ "text" | "number" | "automatic" | \string
+ }?
+ & attribute table:order { "ascending" | "descending" }?
+table-subtotal-rules =
+ element table:subtotal-rules {
+ table-subtotal-rules-attlist,
+ table-sort-groups?,
+ table-subtotal-rule*
+ }
+table-subtotal-rules-attlist =
+ attribute table:bind-styles-to-content { boolean }?
+ & attribute table:case-sensitive { boolean }?
+ & attribute table:page-breaks-on-group-change { boolean }?
+table-sort-groups =
+ element table:sort-groups { table-sort-groups-attlist, empty }
+table-sort-groups-attlist =
+ attribute table:data-type {
+ "text" | "number" | "automatic" | \string
+ }?
+ & attribute table:order { "ascending" | "descending" }?
+table-subtotal-rule =
+ element table:subtotal-rule {
+ table-subtotal-rule-attlist, table-subtotal-field*
+ }
+table-subtotal-rule-attlist =
+ attribute table:group-by-field-number { nonNegativeInteger }
+table-subtotal-field =
+ element table:subtotal-field { table-subtotal-field-attlist, empty }
+table-subtotal-field-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:function {
+ "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+table-filter =
+ element table:filter {
+ table-filter-attlist,
+ (table-filter-condition | table-filter-and | table-filter-or)
+ }
+table-filter-attlist =
+ attribute table:target-range-address { cellRangeAddress }?
+ & attribute table:condition-source { "self" | "cell-range" }?
+ & attribute table:condition-source-range-address { cellRangeAddress }?
+ & attribute table:display-duplicates { boolean }?
+table-filter-and =
+ element table:filter-and {
+ (table-filter-or | table-filter-condition)+
+ }
+table-filter-or =
+ element table:filter-or {
+ (table-filter-and | table-filter-condition)+
+ }
+table-filter-condition =
+ element table:filter-condition {
+ table-filter-condition-attlist, table-filter-set-item*
+ }
+table-filter-condition-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:value { \string | double }
+ & attribute table:operator { \string }
+ & attribute table:case-sensitive { \string }?
+ & attribute table:data-type { "text" | "number" }?
+table-filter-set-item =
+ element table:filter-set-item {
+ attribute table:value { \string },
+ empty
+ }
+table-data-pilot-tables =
+ element table:data-pilot-tables { table-data-pilot-table* }
+table-data-pilot-table =
+ element table:data-pilot-table {
+ table-data-pilot-table-attlist,
+ (table-database-source-sql
+ | table-database-source-table
+ | table-database-source-query
+ | table-source-service
+ | table-source-cell-range)?,
+ table-data-pilot-field+
+ }
+table-data-pilot-table-attlist =
+ attribute table:name { \string }
+ & attribute table:application-data { \string }?
+ & attribute table:grand-total { "none" | "row" | "column" | "both" }?
+ & attribute table:ignore-empty-rows { boolean }?
+ & attribute table:identify-categories { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }
+ & attribute table:buttons { cellRangeAddressList }?
+ & attribute table:show-filter-button { boolean }?
+ & attribute table:drill-down-on-double-click { boolean }?
+table-source-cell-range =
+ element table:source-cell-range {
+ table-source-cell-range-attlist, table-filter?
+ }
+table-source-cell-range-attlist =
+ attribute table:cell-range-address { cellRangeAddress }
+table-source-service =
+ element table:source-service { table-source-service-attlist, empty }
+table-source-service-attlist =
+ attribute table:name { \string }
+ & attribute table:source-name { \string }
+ & attribute table:object-name { \string }
+ & attribute table:user-name { \string }?
+ & attribute table:password { \string }?
+table-data-pilot-field =
+ element table:data-pilot-field {
+ table-data-pilot-field-attlist,
+ table-data-pilot-level?,
+ table-data-pilot-field-reference?,
+ table-data-pilot-groups?
+ }
+table-data-pilot-field-attlist =
+ attribute table:source-field-name { \string }
+ & (attribute table:orientation {
+ "row" | "column" | "data" | "hidden"
+ }
+ | (attribute table:orientation { "page" },
+ attribute table:selected-page { \string }))
+ & attribute table:is-data-layout-field { \string }?
+ & attribute table:function {
+ "auto"
+ | "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }?
+ & attribute table:used-hierarchy { integer }?
+table-data-pilot-level =
+ element table:data-pilot-level {
+ table-data-pilot-level-attlist,
+ table-data-pilot-subtotals?,
+ table-data-pilot-members?,
+ table-data-pilot-display-info?,
+ table-data-pilot-sort-info?,
+ table-data-pilot-layout-info?
+ }
+table-data-pilot-level-attlist = attribute table:show-empty { boolean }?
+table-data-pilot-subtotals =
+ element table:data-pilot-subtotals { table-data-pilot-subtotal* }
+table-data-pilot-subtotal =
+ element table:data-pilot-subtotal {
+ table-data-pilot-subtotal-attlist, empty
+ }
+table-data-pilot-subtotal-attlist =
+ attribute table:function {
+ "auto"
+ | "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+table-data-pilot-members =
+ element table:data-pilot-members { table-data-pilot-member* }
+table-data-pilot-member =
+ element table:data-pilot-member {
+ table-data-pilot-member-attlist, empty
+ }
+table-data-pilot-member-attlist =
+ attribute table:name { \string }
+ & attribute table:display { boolean }?
+ & attribute table:show-details { boolean }?
+table-data-pilot-display-info =
+ element table:data-pilot-display-info {
+ table-data-pilot-display-info-attlist, empty
+ }
+table-data-pilot-display-info-attlist =
+ attribute table:enabled { boolean }
+ & attribute table:data-field { \string }
+ & attribute table:member-count { nonNegativeInteger }
+ & attribute table:display-member-mode { "from-top" | "from-bottom" }
+table-data-pilot-sort-info =
+ element table:data-pilot-sort-info {
+ table-data-pilot-sort-info-attlist, empty
+ }
+table-data-pilot-sort-info-attlist =
+ ((attribute table:sort-mode { "data" },
+ attribute table:data-field { \string })
+ | attribute table:sort-mode { "none" | "manual" | "name" })
+ & attribute table:order { "ascending" | "descending" }
+table-data-pilot-layout-info =
+ element table:data-pilot-layout-info {
+ table-data-pilot-layout-info-attlist, empty
+ }
+table-data-pilot-layout-info-attlist =
+ attribute table:layout-mode {
+ "tabular-layout"
+ | "outline-subtotals-top"
+ | "outline-subtotals-bottom"
+ }
+ & attribute table:add-empty-lines { boolean }
+table-data-pilot-field-reference =
+ element table:data-pilot-field-reference {
+ table-data-pilot-field-reference-attlist
+ }
+table-data-pilot-field-reference-attlist =
+ attribute table:field-name { \string }
+ & ((attribute table:member-type { "named" },
+ attribute table:member-name { \string })
+ | attribute table:member-type { "previous" | "next" })
+ & attribute table:type {
+ "none"
+ | "member-difference"
+ | "member-percentage"
+ | "member-percentage-difference"
+ | "running-total"
+ | "row-percentage"
+ | "column-percentage"
+ | "total-percentage"
+ | "index"
+ }
+table-data-pilot-groups =
+ element table:data-pilot-groups {
+ table-data-pilot-groups-attlist, table-data-pilot-group+
+ }
+table-data-pilot-groups-attlist =
+ attribute table:source-field-name { \string }
+ & (attribute table:date-start { dateOrDateTime | "auto" }
+ | attribute table:start { double | "auto" })
+ & (attribute table:date-end { dateOrDateTime | "auto" }
+ | attribute table:end { double | "auto" })
+ & attribute table:step { double }
+ & attribute table:grouped-by {
+ "seconds"
+ | "minutes"
+ | "hours"
+ | "days"
+ | "months"
+ | "quarters"
+ | "years"
+ }
+table-data-pilot-group =
+ element table:data-pilot-group {
+ table-data-pilot-group-attlist, table-data-pilot-group-member+
+ }
+table-data-pilot-group-attlist = attribute table:name { \string }
+table-data-pilot-group-member =
+ element table:data-pilot-group-member {
+ table-data-pilot-group-member-attlist
+ }
+table-data-pilot-group-member-attlist = attribute table:name { \string }
+table-consolidation =
+ element table:consolidation { table-consolidation-attlist, empty }
+table-consolidation-attlist =
+ attribute table:function {
+ "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+ & attribute table:source-cell-range-addresses { cellRangeAddressList }
+ & attribute table:target-cell-address { cellAddress }
+ & attribute table:use-labels { "none" | "row" | "column" | "both" }?
+ & attribute table:link-to-source-data { boolean }?
+table-dde-links = element table:dde-links { table-dde-link+ }
+table-tracked-changes =
+ element table:tracked-changes {
+ table-tracked-changes-attlist,
+ (table-cell-content-change
+ | table-insertion
+ | table-deletion
+ | table-movement)*
+ }
+table-tracked-changes-attlist =
+ attribute table:track-changes { boolean }?
+table-insertion =
+ element table:insertion {
+ table-insertion-attlist,
+ common-table-change-attlist,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?
+ }
+table-insertion-attlist =
+ attribute table:type { "row" | "column" | "table" }
+ & attribute table:position { integer }
+ & attribute table:count { positiveInteger }?
+ & attribute table:table { integer }?
+table-dependencies = element table:dependencies { table-dependency+ }
+table-dependency =
+ element table:dependency {
+ attribute table:id { \string },
+ empty
+ }
+table-deletions =
+ element table:deletions {
+ (table-cell-content-deletion | table-change-deletion)+
+ }
+table-cell-content-deletion =
+ element table:cell-content-deletion {
+ attribute table:id { \string }?,
+ table-cell-address?,
+ table-change-track-table-cell?
+ }
+table-change-deletion =
+ element table:change-deletion {
+ attribute table:id { \string }?,
+ empty
+ }
+table-deletion =
+ element table:deletion {
+ table-deletion-attlist,
+ common-table-change-attlist,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?,
+ table-cut-offs?
+ }
+table-deletion-attlist =
+ attribute table:type { "row" | "column" | "table" }
+ & attribute table:position { integer }
+ & attribute table:table { integer }?
+ & attribute table:multi-deletion-spanned { integer }?
+table-cut-offs =
+ element table:cut-offs {
+ table-movement-cut-off+
+ | (table-insertion-cut-off, table-movement-cut-off*)
+ }
+table-insertion-cut-off =
+ element table:insertion-cut-off {
+ table-insertion-cut-off-attlist, empty
+ }
+table-insertion-cut-off-attlist =
+ attribute table:id { \string }
+ & attribute table:position { integer }
+table-movement-cut-off =
+ element table:movement-cut-off {
+ table-movement-cut-off-attlist, empty
+ }
+table-movement-cut-off-attlist =
+ attribute table:position { integer }
+ | (attribute table:start-position { integer },
+ attribute table:end-position { integer })
+table-movement =
+ element table:movement {
+ common-table-change-attlist,
+ table-source-range-address,
+ table-target-range-address,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?
+ }
+table-source-range-address =
+ element table:source-range-address {
+ common-table-range-attlist, empty
+ }
+table-target-range-address =
+ element table:target-range-address {
+ common-table-range-attlist, empty
+ }
+common-table-range-attlist =
+ common-table-cell-address-attlist
+ | common-table-cell-range-address-attlist
+common-table-cell-address-attlist =
+ attribute table:column { integer },
+ attribute table:row { integer },
+ attribute table:table { integer }
+common-table-cell-range-address-attlist =
+ attribute table:start-column { integer },
+ attribute table:start-row { integer },
+ attribute table:start-table { integer },
+ attribute table:end-column { integer },
+ attribute table:end-row { integer },
+ attribute table:end-table { integer }
+table-change-track-table-cell =
+ element table:change-track-table-cell {
+ table-change-track-table-cell-attlist, text-p*
+ }
+table-change-track-table-cell-attlist =
+ attribute table:cell-address { cellAddress }?
+ & attribute table:matrix-covered { boolean }?
+ & attribute table:formula { \string }?
+ & attribute table:number-matrix-columns-spanned { positiveInteger }?
+ & attribute table:number-matrix-rows-spanned { positiveInteger }?
+ & common-value-and-type-attlist?
+table-cell-content-change =
+ element table:cell-content-change {
+ common-table-change-attlist,
+ table-cell-address,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?,
+ table-previous
+ }
+table-cell-address =
+ element table:cell-address {
+ common-table-cell-address-attlist, empty
+ }
+table-previous =
+ element table:previous {
+ attribute table:id { \string }?,
+ table-change-track-table-cell
+ }
+common-table-change-attlist =
+ attribute table:id { \string }
+ & attribute table:acceptance-state {
+ "accepted" | "rejected" | "pending"
+ }?
+ & attribute table:rejecting-change-id { \string }?
+style-handout-master =
+ element style:handout-master {
+ common-presentation-header-footer-attlist,
+ style-handout-master-attlist,
+ shape*
+ }
+style-handout-master-attlist =
+ attribute presentation:presentation-page-layout-name { styleNameRef }?
+ & attribute style:page-layout-name { styleNameRef }
+ & attribute draw:style-name { styleNameRef }?
+draw-layer-set = element draw:layer-set { draw-layer* }
+draw-layer =
+ element draw:layer { draw-layer-attlist, svg-title?, svg-desc? }
+draw-layer-attlist =
+ attribute draw:name { \string }
+ & attribute draw:protected { boolean }?
+ & attribute draw:display { "always" | "screen" | "printer" | "none" }?
+draw-page =
+ element draw:page {
+ common-presentation-header-footer-attlist,
+ draw-page-attlist,
+ svg-title?,
+ svg-desc?,
+ draw-layer-set?,
+ office-forms?,
+ shape*,
+ (presentation-animations | animation-element)?,
+ presentation-notes?
+ }
+draw-page-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:style-name { styleNameRef }?
+ & attribute draw:master-page-name { styleNameRef }
+ & attribute presentation:presentation-page-layout-name {
+ styleNameRef
+ }?
+ & (xml-id,
+ attribute draw:id { NCName }?)?
+ & attribute draw:nav-order { IDREFS }?
+common-presentation-header-footer-attlist =
+ attribute presentation:use-header-name { \string }?
+ & attribute presentation:use-footer-name { \string }?
+ & attribute presentation:use-date-time-name { \string }?
+shape = shape-instance | draw-a
+shape-instance =
+ draw-rect
+ | draw-line
+ | draw-polyline
+ | draw-polygon
+ | draw-regular-polygon
+ | draw-path
+ | draw-circle
+ | draw-ellipse
+ | draw-g
+ | draw-page-thumbnail
+ | draw-frame
+ | draw-measure
+ | draw-caption
+ | draw-connector
+ | draw-control
+ | dr3d-scene
+ | draw-custom-shape
+draw-rect =
+ element draw:rect {
+ draw-rect-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-rect-attlist =
+ attribute draw:corner-radius { nonNegativeLength }?
+ | (attribute svg:rx { nonNegativeLength }?,
+ attribute svg:ry { nonNegativeLength }?)
+draw-line =
+ element draw:line {
+ draw-line-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-line-attlist =
+ attribute svg:x1 { coordinate }
+ & attribute svg:y1 { coordinate }
+ & attribute svg:x2 { coordinate }
+ & attribute svg:y2 { coordinate }
+draw-polyline =
+ element draw:polyline {
+ common-draw-points-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-points-attlist = attribute draw:points { points }
+draw-polygon =
+ element draw:polygon {
+ common-draw-points-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-regular-polygon =
+ element draw:regular-polygon {
+ draw-regular-polygon-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-regular-polygon-attlist =
+ (attribute draw:concave { "false" }
+ | (attribute draw:concave { "true" },
+ draw-regular-polygon-sharpness-attlist))
+ & attribute draw:corners { positiveInteger }
+draw-regular-polygon-sharpness-attlist =
+ attribute draw:sharpness { percent }
+draw-path =
+ element draw:path {
+ common-draw-path-data-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-path-data-attlist = attribute svg:d { pathData }
+draw-circle =
+ element draw:circle {
+ ((draw-circle-attlist, common-draw-circle-ellipse-pos-attlist)
+ | (common-draw-position-attlist, common-draw-size-attlist)),
+ common-draw-circle-ellipse-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-circle-ellipse-pos-attlist =
+ attribute svg:cx { coordinate },
+ attribute svg:cy { coordinate }
+draw-circle-attlist = attribute svg:r { length }
+common-draw-circle-ellipse-attlist =
+ attribute draw:kind { "full" | "section" | "cut" | "arc" }?
+ & attribute draw:start-angle { angle }?
+ & attribute draw:end-angle { angle }?
+draw-ellipse =
+ element draw:ellipse {
+ ((draw-ellipse-attlist, common-draw-circle-ellipse-pos-attlist)
+ | (common-draw-position-attlist, common-draw-size-attlist)),
+ common-draw-circle-ellipse-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-ellipse-attlist =
+ attribute svg:rx { length },
+ attribute svg:ry { length }
+draw-connector =
+ element draw:connector {
+ draw-connector-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ common-draw-viewbox-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-connector-attlist =
+ attribute draw:type { "standard" | "lines" | "line" | "curve" }?
+ & (attribute svg:x1 { coordinate },
+ attribute svg:y1 { coordinate })?
+ & attribute draw:start-shape { IDREF }?
+ & attribute draw:start-glue-point { nonNegativeInteger }?
+ & (attribute svg:x2 { coordinate },
+ attribute svg:y2 { coordinate })?
+ & attribute draw:end-shape { IDREF }?
+ & attribute draw:end-glue-point { nonNegativeInteger }?
+ & attribute draw:line-skew {
+ list { length, (length, length?)? }
+ }?
+ & attribute svg:d { pathData }?
+draw-caption =
+ element draw:caption {
+ draw-caption-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-caption-attlist =
+ (attribute draw:caption-point-x { coordinate },
+ attribute draw:caption-point-y { coordinate })?
+ & attribute draw:corner-radius { nonNegativeLength }?
+draw-measure =
+ element draw:measure {
+ draw-measure-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-measure-attlist =
+ attribute svg:x1 { coordinate }
+ & attribute svg:y1 { coordinate }
+ & attribute svg:x2 { coordinate }
+ & attribute svg:y2 { coordinate }
+draw-control =
+ element draw:control {
+ draw-control-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ draw-glue-point*
+ }
+draw-control-attlist = attribute draw:control { IDREF }
+draw-page-thumbnail =
+ element draw:page-thumbnail {
+ draw-page-thumbnail-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ presentation-shape-attlist,
+ common-draw-shape-with-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?
+ }
+draw-page-thumbnail-attlist =
+ attribute draw:page-number { positiveInteger }?
+draw-g =
+ element draw:g {
+ draw-g-attlist,
+ common-draw-z-index-attlist,
+ common-draw-name-attlist,
+ common-draw-id-attlist,
+ common-draw-style-name-attlist,
+ common-text-spreadsheet-shape-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ shape*
+ }
+draw-g-attlist = attribute svg:y { coordinate }?
+common-draw-name-attlist = attribute draw:name { \string }?
+common-draw-caption-id-attlist = attribute draw:caption-id { IDREF }?
+common-draw-position-attlist =
+ attribute svg:x { coordinate }?,
+ attribute svg:y { coordinate }?
+common-draw-size-attlist =
+ attribute svg:width { length }?,
+ attribute svg:height { length }?
+common-draw-transform-attlist = attribute draw:transform { \string }?
+common-draw-viewbox-attlist =
+ attribute svg:viewBox {
+ list { integer, integer, integer, integer }
+ }
+common-draw-style-name-attlist =
+ (attribute draw:style-name { styleNameRef }?,
+ attribute draw:class-names { styleNameRefs }?)
+ | (attribute presentation:style-name { styleNameRef }?,
+ attribute presentation:class-names { styleNameRefs }?)
+common-draw-text-style-name-attlist =
+ attribute draw:text-style-name { styleNameRef }?
+common-draw-layer-name-attlist = attribute draw:layer { \string }?
+common-draw-id-attlist =
+ (xml-id,
+ attribute draw:id { NCName }?)?
+common-draw-z-index-attlist =
+ attribute draw:z-index { nonNegativeInteger }?
+common-text-spreadsheet-shape-attlist =
+ attribute table:end-cell-address { cellAddress }?
+ & attribute table:end-x { coordinate }?
+ & attribute table:end-y { coordinate }?
+ & attribute table:table-background { boolean }?
+ & common-text-anchor-attlist
+common-text-anchor-attlist =
+ attribute text:anchor-type {
+ "page" | "frame" | "paragraph" | "char" | "as-char"
+ }?
+ & attribute text:anchor-page-number { positiveInteger }?
+draw-text = (text-p | text-list)*
+common-draw-shape-with-styles-attlist =
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-draw-transform-attlist,
+ common-draw-name-attlist,
+ common-text-spreadsheet-shape-attlist
+common-draw-shape-with-text-and-styles-attlist =
+ common-draw-shape-with-styles-attlist,
+ common-draw-text-style-name-attlist
+draw-glue-point =
+ element draw:glue-point { draw-glue-point-attlist, empty }
+draw-glue-point-attlist =
+ attribute draw:id { nonNegativeInteger }
+ & attribute svg:x { distance | percent }
+ & attribute svg:y { distance | percent }
+ & attribute draw:align {
+ "top-left"
+ | "top"
+ | "top-right"
+ | "left"
+ | "center"
+ | "right"
+ | "bottom-left"
+ | "bottom-right"
+ }?
+ & attribute draw:escape-direction {
+ "auto"
+ | "left"
+ | "right"
+ | "up"
+ | "down"
+ | "horizontal"
+ | "vertical"
+ }
+svg-title = element svg:title { text }
+svg-desc = element svg:desc { text }
+draw-frame =
+ element draw:frame {
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-position-attlist,
+ common-draw-rel-size-attlist,
+ common-draw-caption-id-attlist,
+ presentation-shape-attlist,
+ draw-frame-attlist,
+ (draw-text-box
+ | draw-image
+ | draw-object
+ | draw-object-ole
+ | draw-applet
+ | draw-floating-frame
+ | draw-plugin
+ | table-table)*,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-image-map?,
+ svg-title?,
+ svg-desc?,
+ (draw-contour-polygon | draw-contour-path)?
+ }
+common-draw-rel-size-attlist =
+ common-draw-size-attlist,
+ attribute style:rel-width { percent | "scale" | "scale-min" }?,
+ attribute style:rel-height { percent | "scale" | "scale-min" }?
+draw-frame-attlist = attribute draw:copy-of { \string }?
+draw-text-box =
+ element draw:text-box { draw-text-box-attlist, text-content* }
+draw-text-box-attlist =
+ attribute draw:chain-next-name { \string }?
+ & attribute draw:corner-radius { nonNegativeLength }?
+ & attribute fo:min-height { length | percent }?
+ & attribute fo:min-width { length | percent }?
+ & attribute fo:max-height { length | percent }?
+ & attribute fo:max-width { length | percent }?
+ & (xml-id,
+ attribute text:id { NCName }?)?
+draw-image =
+ element draw:image {
+ draw-image-attlist,
+ (common-draw-data-attlist | office-binary-data),
+ draw-text
+ }
+common-draw-data-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onLoad" }?
+office-binary-data = element office:binary-data { base64Binary }
+draw-image-attlist =
+ attribute draw:filter-name { \string }?
+ & xml-id?
+draw-object =
+ element draw:object {
+ draw-object-attlist,
+ (common-draw-data-attlist | office-document | math-math)
+ }
+draw-object-ole =
+ element draw:object-ole {
+ draw-object-ole-attlist,
+ (common-draw-data-attlist | office-binary-data)
+ }
+draw-object-attlist =
+ attribute draw:notify-on-update-of-ranges {
+ cellRangeAddressList | \string
+ }?
+ & xml-id?
+draw-object-ole-attlist =
+ attribute draw:class-id { \string }?
+ & xml-id?
+draw-applet =
+ element draw:applet {
+ draw-applet-attlist, common-draw-data-attlist?, draw-param*
+ }
+draw-applet-attlist =
+ attribute draw:code { \string }?
+ & attribute draw:object { \string }?
+ & attribute draw:archive { \string }?
+ & attribute draw:may-script { boolean }?
+ & xml-id?
+draw-plugin =
+ element draw:plugin {
+ draw-plugin-attlist, common-draw-data-attlist, draw-param*
+ }
+draw-plugin-attlist =
+ attribute draw:mime-type { \string }?
+ & xml-id?
+draw-param = element draw:param { draw-param-attlist, empty }
+draw-param-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:value { \string }?
+draw-floating-frame =
+ element draw:floating-frame {
+ draw-floating-frame-attlist, common-draw-data-attlist
+ }
+draw-floating-frame-attlist =
+ attribute draw:frame-name { \string }?
+ & xml-id?
+draw-contour-polygon =
+ element draw:contour-polygon {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-points-attlist,
+ empty
+ }
+draw-contour-path =
+ element draw:contour-path {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ empty
+ }
+common-contour-attlist = attribute draw:recreate-on-edit { boolean }
+draw-a = element draw:a { draw-a-attlist, shape-instance }
+draw-a-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute office:target-frame-name { targetFrameName }?
+ & attribute xlink:show { "new" | "replace" }?
+ & attribute office:name { \string }?
+ & attribute office:title { \string }?
+ & attribute office:server-map { boolean }?
+ & xml-id?
+draw-image-map =
+ element draw:image-map {
+ (draw-area-rectangle | draw-area-circle | draw-area-polygon)*
+ }
+draw-area-rectangle =
+ element draw:area-rectangle {
+ common-draw-area-attlist,
+ attribute svg:x { coordinate },
+ attribute svg:y { coordinate },
+ attribute svg:width { length },
+ attribute svg:height { length },
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+draw-area-circle =
+ element draw:area-circle {
+ common-draw-area-attlist,
+ attribute svg:cx { coordinate },
+ attribute svg:cy { coordinate },
+ attribute svg:r { length },
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+draw-area-polygon =
+ element draw:area-polygon {
+ common-draw-area-attlist,
+ attribute svg:x { coordinate },
+ attribute svg:y { coordinate },
+ attribute svg:width { length },
+ attribute svg:height { length },
+ common-draw-viewbox-attlist,
+ common-draw-points-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+common-draw-area-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute office:target-frame-name { targetFrameName }?,
+ attribute xlink:show { "new" | "replace" }?)?
+ & attribute office:name { \string }?
+ & attribute draw:nohref { "nohref" }?
+dr3d-scene =
+ element dr3d:scene {
+ dr3d-scene-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-style-name-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-text-spreadsheet-shape-attlist,
+ common-dr3d-transform-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ dr3d-light*,
+ shapes3d*,
+ draw-glue-point*
+ }
+shapes3d =
+ dr3d-scene | dr3d-extrude | dr3d-sphere | dr3d-rotate | dr3d-cube
+dr3d-scene-attlist =
+ attribute dr3d:vrp { vector3D }?
+ & attribute dr3d:vpn { vector3D }?
+ & attribute dr3d:vup { vector3D }?
+ & attribute dr3d:projection { "parallel" | "perspective" }?
+ & attribute dr3d:distance { length }?
+ & attribute dr3d:focal-length { length }?
+ & attribute dr3d:shadow-slant { angle }?
+ & attribute dr3d:shade-mode {
+ "flat" | "phong" | "gouraud" | "draft"
+ }?
+ & attribute dr3d:ambient-color { color }?
+ & attribute dr3d:lighting-mode { boolean }?
+common-dr3d-transform-attlist = attribute dr3d:transform { \string }?
+dr3d-light = element dr3d:light { dr3d-light-attlist, empty }
+dr3d-light-attlist =
+ attribute dr3d:diffuse-color { color }?
+ & attribute dr3d:direction { vector3D }
+ & attribute dr3d:enabled { boolean }?
+ & attribute dr3d:specular { boolean }?
+dr3d-cube =
+ element dr3d:cube {
+ dr3d-cube-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-cube-attlist =
+ attribute dr3d:min-edge { vector3D }?,
+ attribute dr3d:max-edge { vector3D }?
+dr3d-sphere =
+ element dr3d:sphere {
+ dr3d-sphere-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-sphere-attlist =
+ attribute dr3d:center { vector3D }?
+ & attribute dr3d:size { vector3D }?
+dr3d-extrude =
+ element dr3d:extrude {
+ common-draw-path-data-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-id-attlist,
+ common-draw-z-index-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-rotate =
+ element dr3d:rotate {
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+draw-custom-shape =
+ element draw:custom-shape {
+ draw-custom-shape-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text,
+ draw-enhanced-geometry?
+ }
+draw-custom-shape-attlist =
+ attribute draw:engine { namespacedToken }?
+ & attribute draw:data { \string }?
+draw-enhanced-geometry =
+ element draw:enhanced-geometry {
+ draw-enhanced-geometry-attlist, draw-equation*, draw-handle*
+ }
+draw-enhanced-geometry-attlist =
+ attribute draw:type { custom-shape-type }?
+ & attribute svg:viewBox {
+ list { integer, integer, integer, integer }
+ }?
+ & attribute draw:mirror-vertical { boolean }?
+ & attribute draw:mirror-horizontal { boolean }?
+ & attribute draw:text-rotate-angle { angle }?
+ & attribute draw:extrusion-allowed { boolean }?
+ & attribute draw:text-path-allowed { boolean }?
+ & attribute draw:concentric-gradient-fill-allowed { boolean }?
+ & attribute draw:extrusion { boolean }?
+ & attribute draw:extrusion-brightness { zeroToHundredPercent }?
+ & attribute draw:extrusion-depth {
+ list { length, double }
+ }?
+ & attribute draw:extrusion-diffusion { percent }?
+ & attribute draw:extrusion-number-of-line-segments { integer }?
+ & attribute draw:extrusion-light-face { boolean }?
+ & attribute draw:extrusion-first-light-harsh { boolean }?
+ & attribute draw:extrusion-second-light-harsh { boolean }?
+ & attribute draw:extrusion-first-light-level { zeroToHundredPercent }?
+ & attribute draw:extrusion-second-light-level {
+ zeroToHundredPercent
+ }?
+ & attribute draw:extrusion-first-light-direction { vector3D }?
+ & attribute draw:extrusion-second-light-direction { vector3D }?
+ & attribute draw:extrusion-metal { boolean }?
+ & attribute dr3d:shade-mode {
+ "flat" | "phong" | "gouraud" | "draft"
+ }?
+ & attribute draw:extrusion-rotation-angle {
+ list { angle, angle }
+ }?
+ & attribute draw:extrusion-rotation-center { vector3D }?
+ & attribute draw:extrusion-shininess { zeroToHundredPercent }?
+ & attribute draw:extrusion-skew {
+ list { double, angle }
+ }?
+ & attribute draw:extrusion-specularity { zeroToHundredPercent }?
+ & attribute dr3d:projection { "parallel" | "perspective" }?
+ & attribute draw:extrusion-viewpoint { point3D }?
+ & attribute draw:extrusion-origin {
+ list { extrusionOrigin, extrusionOrigin }
+ }?
+ & attribute draw:extrusion-color { boolean }?
+ & attribute draw:enhanced-path { \string }?
+ & attribute draw:path-stretchpoint-x { double }?
+ & attribute draw:path-stretchpoint-y { double }?
+ & attribute draw:text-areas { \string }?
+ & attribute draw:glue-points { \string }?
+ & attribute draw:glue-point-type {
+ "none" | "segments" | "rectangle"
+ }?
+ & attribute draw:glue-point-leaving-directions { \string }?
+ & attribute draw:text-path { boolean }?
+ & attribute draw:text-path-mode { "normal" | "path" | "shape" }?
+ & attribute draw:text-path-scale { "path" | "shape" }?
+ & attribute draw:text-path-same-letter-heights { boolean }?
+ & attribute draw:modifiers { \string }?
+custom-shape-type = "non-primitive" | \string
+point3D =
+ xsd:string {
+ pattern =
+ "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))){2}[ ]*\)"
+ }
+extrusionOrigin =
+ xsd:double { minInclusive = "-0.5" maxInclusive = "0.5" }
+draw-equation = element draw:equation { draw-equation-attlist, empty }
+draw-equation-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:formula { \string }?
+draw-handle = element draw:handle { draw-handle-attlist, empty }
+draw-handle-attlist =
+ attribute draw:handle-mirror-vertical { boolean }?
+ & attribute draw:handle-mirror-horizontal { boolean }?
+ & attribute draw:handle-switched { boolean }?
+ & attribute draw:handle-position { \string }
+ & attribute draw:handle-range-x-minimum { \string }?
+ & attribute draw:handle-range-x-maximum { \string }?
+ & attribute draw:handle-range-y-minimum { \string }?
+ & attribute draw:handle-range-y-maximum { \string }?
+ & attribute draw:handle-polar { \string }?
+ & attribute draw:handle-radius-range-minimum { \string }?
+ & attribute draw:handle-radius-range-maximum { \string }?
+presentation-shape-attlist =
+ attribute presentation:class { presentation-classes }?
+ & attribute presentation:placeholder { boolean }?
+ & attribute presentation:user-transformed { boolean }?
+presentation-classes =
+ "title"
+ | "outline"
+ | "subtitle"
+ | "text"
+ | "graphic"
+ | "object"
+ | "chart"
+ | "table"
+ | "orgchart"
+ | "page"
+ | "notes"
+ | "handout"
+ | "header"
+ | "footer"
+ | "date-time"
+ | "page-number"
+presentation-animations =
+ element presentation:animations {
+ (presentation-animation-elements | presentation-animation-group)*
+ }
+presentation-animation-elements =
+ presentation-show-shape
+ | presentation-show-text
+ | presentation-hide-shape
+ | presentation-hide-text
+ | presentation-dim
+ | presentation-play
+presentation-sound =
+ element presentation:sound {
+ presentation-sound-attlist,
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?,
+ attribute xlink:show { "new" | "replace" }?,
+ empty
+ }
+presentation-sound-attlist =
+ attribute presentation:play-full { boolean }?
+ & xml-id?
+presentation-show-shape =
+ element presentation:show-shape {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+common-presentation-effect-attlist =
+ attribute draw:shape-id { IDREF }
+ & attribute presentation:effect { presentationEffects }?
+ & attribute presentation:direction { presentationEffectDirections }?
+ & attribute presentation:speed { presentationSpeeds }?
+ & attribute presentation:delay { duration }?
+ & attribute presentation:start-scale { percent }?
+ & attribute presentation:path-id { \string }?
+presentationEffects =
+ "none"
+ | "fade"
+ | "move"
+ | "stripes"
+ | "open"
+ | "close"
+ | "dissolve"
+ | "wavyline"
+ | "random"
+ | "lines"
+ | "laser"
+ | "appear"
+ | "hide"
+ | "move-short"
+ | "checkerboard"
+ | "rotate"
+ | "stretch"
+presentationEffectDirections =
+ "none"
+ | "from-left"
+ | "from-top"
+ | "from-right"
+ | "from-bottom"
+ | "from-center"
+ | "from-upper-left"
+ | "from-upper-right"
+ | "from-lower-left"
+ | "from-lower-right"
+ | "to-left"
+ | "to-top"
+ | "to-right"
+ | "to-bottom"
+ | "to-upper-left"
+ | "to-upper-right"
+ | "to-lower-right"
+ | "to-lower-left"
+ | "path"
+ | "spiral-inward-left"
+ | "spiral-inward-right"
+ | "spiral-outward-left"
+ | "spiral-outward-right"
+ | "vertical"
+ | "horizontal"
+ | "to-center"
+ | "clockwise"
+ | "counter-clockwise"
+presentationSpeeds = "slow" | "medium" | "fast"
+presentation-show-text =
+ element presentation:show-text {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-hide-shape =
+ element presentation:hide-shape {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-hide-text =
+ element presentation:hide-text {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-dim =
+ element presentation:dim {
+ presentation-dim-attlist, presentation-sound?
+ }
+presentation-dim-attlist =
+ attribute draw:shape-id { IDREF }
+ & attribute draw:color { color }
+presentation-play =
+ element presentation:play { presentation-play-attlist, empty }
+presentation-play-attlist =
+ attribute draw:shape-id { IDREF },
+ attribute presentation:speed { presentationSpeeds }?
+presentation-animation-group =
+ element presentation:animation-group {
+ presentation-animation-elements*
+ }
+common-anim-attlist =
+ attribute presentation:node-type {
+ "default"
+ | "on-click"
+ | "with-previous"
+ | "after-previous"
+ | "timing-root"
+ | "main-sequence"
+ | "interactive-sequence"
+ }?
+ & attribute presentation:preset-id { \string }?
+ & attribute presentation:preset-sub-type { \string }?
+ & attribute presentation:preset-class {
+ "custom"
+ | "entrance"
+ | "exit"
+ | "emphasis"
+ | "motion-path"
+ | "ole-action"
+ | "media-call"
+ }?
+ & attribute presentation:master-element { IDREF }?
+ & attribute presentation:group-id { \string }?
+ & (xml-id,
+ attribute anim:id { NCName }?)?
+presentation-event-listener =
+ element presentation:event-listener {
+ presentation-event-listener-attlist, presentation-sound?
+ }
+presentation-event-listener-attlist =
+ attribute script:event-name { \string }
+ & attribute presentation:action {
+ "none"
+ | "previous-page"
+ | "next-page"
+ | "first-page"
+ | "last-page"
+ | "hide"
+ | "stop"
+ | "execute"
+ | "show"
+ | "verb"
+ | "fade-out"
+ | "sound"
+ | "last-visited-page"
+ }
+ & attribute presentation:effect { presentationEffects }?
+ & attribute presentation:direction { presentationEffectDirections }?
+ & attribute presentation:speed { presentationSpeeds }?
+ & attribute presentation:start-scale { percent }?
+ & (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute presentation:verb { nonNegativeInteger }?
+presentation-decls = presentation-decl*
+presentation-decl =
+ element presentation:header-decl {
+ presentation-header-decl-attlist, text
+ }
+ | element presentation:footer-decl {
+ presentation-footer-decl-attlist, text
+ }
+ | element presentation:date-time-decl {
+ presentation-date-time-decl-attlist, text
+ }
+presentation-header-decl-attlist =
+ attribute presentation:name { \string }
+presentation-footer-decl-attlist =
+ attribute presentation:name { \string }
+presentation-date-time-decl-attlist =
+ attribute presentation:name { \string }
+ & attribute presentation:source { "fixed" | "current-date" }
+ & attribute style:data-style-name { styleNameRef }?
+presentation-settings =
+ element presentation:settings {
+ presentation-settings-attlist, presentation-show*
+ }?
+presentation-settings-attlist =
+ attribute presentation:start-page { \string }?
+ & attribute presentation:show { \string }?
+ & attribute presentation:full-screen { boolean }?
+ & attribute presentation:endless { boolean }?
+ & attribute presentation:pause { duration }?
+ & attribute presentation:show-logo { boolean }?
+ & attribute presentation:force-manual { boolean }?
+ & attribute presentation:mouse-visible { boolean }?
+ & attribute presentation:mouse-as-pen { boolean }?
+ & attribute presentation:start-with-navigator { boolean }?
+ & attribute presentation:animations { "enabled" | "disabled" }?
+ & attribute presentation:transition-on-click {
+ "enabled" | "disabled"
+ }?
+ & attribute presentation:stay-on-top { boolean }?
+ & attribute presentation:show-end-of-presentation-slide { boolean }?
+presentation-show =
+ element presentation:show { presentation-show-attlist, empty }
+presentation-show-attlist =
+ attribute presentation:name { \string }
+ & attribute presentation:pages { \string }
+chart-chart =
+ element chart:chart {
+ chart-chart-attlist,
+ chart-title?,
+ chart-subtitle?,
+ chart-footer?,
+ chart-legend?,
+ chart-plot-area,
+ table-table?
+ }
+chart-chart-attlist =
+ attribute chart:class { namespacedToken }
+ & common-draw-size-attlist
+ & attribute chart:column-mapping { \string }?
+ & attribute chart:row-mapping { \string }?
+ & attribute chart:style-name { styleNameRef }?
+ & (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI })?
+ & xml-id?
+chart-title = element chart:title { chart-title-attlist, text-p? }
+chart-title-attlist =
+ attribute table:cell-range { cellRangeAddressList }?
+ & common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-subtitle = element chart:subtitle { chart-title-attlist, text-p? }
+chart-footer = element chart:footer { chart-title-attlist, text-p? }
+chart-legend = element chart:legend { chart-legend-attlist, text-p? }
+chart-legend-attlist =
+ ((attribute chart:legend-position {
+ "start" | "end" | "top" | "bottom"
+ },
+ attribute chart:legend-align { "start" | "center" | "end" }?)
+ | attribute chart:legend-position {
+ "top-start" | "bottom-start" | "top-end" | "bottom-end"
+ }
+ | empty)
+ & common-draw-position-attlist
+ & (attribute style:legend-expansion { "wide" | "high" | "balanced" }
+ | (attribute style:legend-expansion { "custom" },
+ attribute style:legend-expansion-aspect-ratio { double })
+ | empty)
+ & attribute chart:style-name { styleNameRef }?
+chart-plot-area =
+ element chart:plot-area {
+ chart-plot-area-attlist,
+ dr3d-light*,
+ chart-axis*,
+ chart-series*,
+ chart-stock-gain-marker?,
+ chart-stock-loss-marker?,
+ chart-stock-range-line?,
+ chart-wall?,
+ chart-floor?
+ }
+chart-plot-area-attlist =
+ common-draw-position-attlist
+ & common-draw-size-attlist
+ & attribute chart:style-name { styleNameRef }?
+ & attribute table:cell-range-address { cellRangeAddressList }?
+ & attribute chart:data-source-has-labels {
+ "none" | "row" | "column" | "both"
+ }?
+ & dr3d-scene-attlist
+ & common-dr3d-transform-attlist
+ & xml-id?
+chart-wall = element chart:wall { chart-wall-attlist, empty }
+chart-wall-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+chart-floor = element chart:floor { chart-floor-attlist, empty }
+chart-floor-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+chart-axis =
+ element chart:axis {
+ chart-axis-attlist, chart-title?, chart-categories?, chart-grid*
+ }
+chart-axis-attlist =
+ attribute chart:dimension { chart-dimension }
+ & attribute chart:name { \string }?
+ & attribute chart:style-name { styleNameRef }?
+chart-dimension = "x" | "y" | "z"
+chart-categories =
+ element chart:categories {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+chart-grid = element chart:grid { chart-grid-attlist }
+chart-grid-attlist =
+ attribute chart:class { "major" | "minor" }?
+ & attribute chart:style-name { styleNameRef }?
+chart-series =
+ element chart:series {
+ chart-series-attlist,
+ chart-domain*,
+ chart-mean-value?,
+ chart-regression-curve*,
+ chart-error-indicator*,
+ chart-data-point*,
+ chart-data-label?
+ }
+chart-series-attlist =
+ attribute chart:values-cell-range-address { cellRangeAddressList }?
+ & attribute chart:label-cell-address { cellRangeAddressList }?
+ & attribute chart:class { namespacedToken }?
+ & attribute chart:attached-axis { \string }?
+ & attribute chart:style-name { styleNameRef }?
+ & xml-id?
+chart-domain =
+ element chart:domain {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+chart-data-point =
+ element chart:data-point {
+ chart-data-point-attlist, chart-data-label?
+ }
+chart-data-point-attlist =
+ attribute chart:repeated { positiveInteger }?
+ & attribute chart:style-name { styleNameRef }?
+ & xml-id?
+chart-data-label =
+ element chart:data-label { chart-data-label-attlist, text-p? }
+chart-data-label-attlist =
+ common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-mean-value =
+ element chart:mean-value { chart-mean-value-attlist, empty }
+chart-mean-value-attlist = attribute chart:style-name { styleNameRef }?
+chart-error-indicator =
+ element chart:error-indicator { chart-error-indicator-attlist, empty }
+chart-error-indicator-attlist =
+ attribute chart:style-name { styleNameRef }?
+ & attribute chart:dimension { chart-dimension }
+chart-regression-curve =
+ element chart:regression-curve {
+ chart-regression-curve-attlist, chart-equation?
+ }
+chart-regression-curve-attlist =
+ attribute chart:style-name { styleNameRef }?
+chart-equation =
+ element chart:equation { chart-equation-attlist, text-p? }
+chart-equation-attlist =
+ attribute chart:automatic-content { boolean }?
+ & attribute chart:display-r-square { boolean }?
+ & attribute chart:display-equation { boolean }?
+ & common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-stock-gain-marker =
+ element chart:stock-gain-marker { common-stock-marker-attlist }
+chart-stock-loss-marker =
+ element chart:stock-loss-marker { common-stock-marker-attlist }
+chart-stock-range-line =
+ element chart:stock-range-line { common-stock-marker-attlist }
+common-stock-marker-attlist =
+ attribute chart:style-name { styleNameRef }?
+office-database =
+ element office:database {
+ db-data-source,
+ db-forms?,
+ db-reports?,
+ db-queries?,
+ db-table-presentations?,
+ db-schema-definition?
+ }
+db-data-source =
+ element db:data-source {
+ db-data-source-attlist,
+ db-connection-data,
+ db-driver-settings?,
+ db-application-connection-settings?
+ }
+db-data-source-attlist = empty
+db-connection-data =
+ element db:connection-data {
+ db-connection-data-attlist,
+ (db-database-description | db-connection-resource),
+ db-login?
+ }
+db-connection-data-attlist = empty
+db-database-description =
+ element db:database-description {
+ db-database-description-attlist,
+ (db-file-based-database | db-server-database)
+ }
+db-database-description-attlist = empty
+db-file-based-database =
+ element db:file-based-database { db-file-based-database-attlist }
+db-file-based-database-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute db:media-type { \string }
+ & attribute db:extension { \string }?
+db-server-database =
+ element db:server-database { db-server-database-attlist, empty }
+db-server-database-attlist =
+ attribute db:type { namespacedToken }
+ & (db-host-and-port | db-local-socket-name)
+ & attribute db:database-name { \string }?
+db-host-and-port =
+ attribute db:hostname { \string },
+ attribute db:port { positiveInteger }?
+db-local-socket-name = attribute db:local-socket { \string }?
+db-connection-resource =
+ element db:connection-resource {
+ db-connection-resource-attlist, empty
+ }
+db-connection-resource-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "none" }?,
+ attribute xlink:actuate { "onRequest" }?
+db-login = element db:login { db-login-attlist, empty }
+db-login-attlist =
+ (attribute db:user-name { \string }
+ | attribute db:use-system-user { boolean })?
+ & attribute db:is-password-required { boolean }?
+ & attribute db:login-timeout { positiveInteger }?
+db-driver-settings =
+ element db:driver-settings {
+ db-driver-settings-attlist,
+ db-auto-increment?,
+ db-delimiter?,
+ db-character-set?,
+ db-table-settings?
+ }
+db-driver-settings-attlist =
+ db-show-deleted
+ & attribute db:system-driver-settings { \string }?
+ & attribute db:base-dn { \string }?
+ & db-is-first-row-header-line
+ & attribute db:parameter-name-substitution { boolean }?
+db-show-deleted = attribute db:show-deleted { boolean }?
+db-is-first-row-header-line =
+ attribute db:is-first-row-header-line { boolean }?
+db-auto-increment =
+ element db:auto-increment { db-auto-increment-attlist, empty }
+db-auto-increment-attlist =
+ attribute db:additional-column-statement { \string }?
+ & attribute db:row-retrieving-statement { \string }?
+db-delimiter = element db:delimiter { db-delimiter-attlist, empty }
+db-delimiter-attlist =
+ attribute db:field { \string }?
+ & attribute db:string { \string }?
+ & attribute db:decimal { \string }?
+ & attribute db:thousand { \string }?
+db-character-set =
+ element db:character-set { db-character-set-attlist, empty }
+db-character-set-attlist = attribute db:encoding { textEncoding }?
+db-table-settings = element db:table-settings { db-table-setting* }
+db-table-setting =
+ element db:table-setting {
+ db-table-setting-attlist, db-delimiter?, db-character-set?, empty
+ }
+db-table-setting-attlist = db-is-first-row-header-line, db-show-deleted
+db-application-connection-settings =
+ element db:application-connection-settings {
+ db-application-connection-settings-attlist,
+ db-table-filter?,
+ db-table-type-filter?,
+ db-data-source-settings?
+ }
+db-application-connection-settings-attlist =
+ attribute db:is-table-name-length-limited { boolean }?
+ & attribute db:enable-sql92-check { boolean }?
+ & attribute db:append-table-alias-name { boolean }?
+ & attribute db:ignore-driver-privileges { boolean }?
+ & attribute db:boolean-comparison-mode {
+ "equal-integer"
+ | "is-boolean"
+ | "equal-boolean"
+ | "equal-use-only-zero"
+ }?
+ & attribute db:use-catalog { boolean }?
+ & attribute db:max-row-count { integer }?
+ & attribute db:suppress-version-columns { boolean }?
+db-table-filter =
+ element db:table-filter {
+ db-table-filter-attlist,
+ db-table-include-filter?,
+ db-table-exclude-filter?
+ }
+db-table-filter-attlist = empty
+db-table-include-filter =
+ element db:table-include-filter {
+ db-table-include-filter-attlist, db-table-filter-pattern+
+ }
+db-table-include-filter-attlist = empty
+db-table-exclude-filter =
+ element db:table-exclude-filter {
+ db-table-exclude-filter-attlist, db-table-filter-pattern+
+ }
+db-table-exclude-filter-attlist = empty
+db-table-filter-pattern =
+ element db:table-filter-pattern {
+ db-table-filter-pattern-attlist, \string
+ }
+db-table-filter-pattern-attlist = empty
+db-table-type-filter =
+ element db:table-type-filter {
+ db-table-type-filter-attlist, db-table-type*
+ }
+db-table-type-filter-attlist = empty
+db-table-type = element db:table-type { db-table-type-attlist, \string }
+db-table-type-attlist = empty
+db-data-source-settings =
+ element db:data-source-settings {
+ db-data-source-settings-attlist, db-data-source-setting+
+ }
+db-data-source-settings-attlist = empty
+db-data-source-setting =
+ element db:data-source-setting {
+ db-data-source-setting-attlist, db-data-source-setting-value+
+ }
+db-data-source-setting-attlist =
+ attribute db:data-source-setting-is-list { boolean }?
+ & attribute db:data-source-setting-name { \string }
+ & attribute db:data-source-setting-type {
+ db-data-source-setting-types
+ }
+db-data-source-setting-types =
+ "boolean" | "short" | "int" | "long" | "double" | "string"
+db-data-source-setting-value =
+ element db:data-source-setting-value {
+ db-data-source-setting-value-attlist, \string
+ }
+db-data-source-setting-value-attlist = empty
+db-forms =
+ element db:forms {
+ db-forms-attlist, (db-component | db-component-collection)*
+ }
+db-forms-attlist = empty
+db-reports =
+ element db:reports {
+ db-reports-attlist, (db-component | db-component-collection)*
+ }
+db-reports-attlist = empty
+db-component-collection =
+ element db:component-collection {
+ db-component-collection-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (db-component | db-component-collection)*
+ }
+db-component-collection-attlist = empty
+db-component =
+ element db:component {
+ db-component-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (office-document | math-math)?
+ }
+db-component-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "none" }?,
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute db:as-template { boolean }?
+db-queries =
+ element db:queries {
+ db-queries-attlist, (db-query | db-query-collection)*
+ }
+db-queries-attlist = empty
+db-query-collection =
+ element db:query-collection {
+ db-query-collection-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (db-query | db-query-collection)*
+ }
+db-query-collection-attlist = empty
+db-query =
+ element db:query {
+ db-query-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-table-style-name,
+ db-order-statement?,
+ db-filter-statement?,
+ db-columns?,
+ db-update-table?
+ }
+db-query-attlist =
+ attribute db:command { \string }
+ & attribute db:escape-processing { boolean }?
+db-order-statement =
+ element db:order-statement { db-command, db-apply-command, empty }
+db-filter-statement =
+ element db:filter-statement { db-command, db-apply-command, empty }
+db-update-table =
+ element db:update-table { common-db-table-name-attlist }
+db-table-presentations =
+ element db:table-representations {
+ db-table-presentations-attlist, db-table-presentation*
+ }
+db-table-presentations-attlist = empty
+db-table-presentation =
+ element db:table-representation {
+ db-table-presentation-attlist,
+ common-db-table-name-attlist,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-table-style-name,
+ db-order-statement?,
+ db-filter-statement?,
+ db-columns?
+ }
+db-table-presentation-attlist = empty
+db-columns = element db:columns { db-columns-attlist, db-column+ }
+db-columns-attlist = empty
+db-column =
+ element db:column {
+ db-column-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-default-value
+ }
+db-column-attlist =
+ attribute db:visible { boolean }?
+ & attribute db:style-name { styleNameRef }?
+ & attribute db:default-cell-style-name { styleNameRef }?
+db-command = attribute db:command { \string }
+db-apply-command = attribute db:apply-command { boolean }?
+common-db-table-name-attlist =
+ attribute db:name { \string }
+ & attribute db:catalog-name { \string }?
+ & attribute db:schema-name { \string }?
+common-db-object-name = attribute db:name { \string }
+common-db-object-title = attribute db:title { \string }?
+common-db-object-description = attribute db:description { \string }?
+common-db-table-style-name =
+ attribute db:style-name { styleNameRef }?
+ & attribute db:default-row-style-name { styleNameRef }?
+common-db-default-value = common-value-and-type-attlist?
+db-schema-definition =
+ element db:schema-definition {
+ db-schema-definition-attlist, db-table-definitions
+ }
+db-schema-definition-attlist = empty
+db-table-definitions =
+ element db:table-definitions {
+ db-table-definitions-attlist, db-table-definition*
+ }
+db-table-definitions-attlist = empty
+db-table-definition =
+ element db:table-definition {
+ common-db-table-name-attlist,
+ db-table-definition-attlist,
+ db-column-definitions,
+ db-keys?,
+ db-indices?
+ }
+db-table-definition-attlist = attribute db:type { \string }?
+db-column-definitions =
+ element db:column-definitions {
+ db-column-definitions-attlist, db-column-definition+
+ }
+db-column-definitions-attlist = empty
+db-column-definition =
+ element db:column-definition {
+ db-column-definition-attlist, common-db-default-value
+ }
+db-column-definition-attlist =
+ attribute db:name { \string }
+ & attribute db:data-type { db-data-types }?
+ & attribute db:type-name { \string }?
+ & attribute db:precision { positiveInteger }?
+ & attribute db:scale { positiveInteger }?
+ & attribute db:is-nullable { "no-nulls" | "nullable" }?
+ & attribute db:is-empty-allowed { boolean }?
+ & attribute db:is-autoincrement { boolean }?
+db-data-types =
+ "bit"
+ | "boolean"
+ | "tinyint"
+ | "smallint"
+ | "integer"
+ | "bigint"
+ | "float"
+ | "real"
+ | "double"
+ | "numeric"
+ | "decimal"
+ | "char"
+ | "varchar"
+ | "longvarchar"
+ | "date"
+ | "time"
+ | "timestmp"
+ | "binary"
+ | "varbinary"
+ | "longvarbinary"
+ | "sqlnull"
+ | "other"
+ | "object"
+ | "distinct"
+ | "struct"
+ | "array"
+ | "blob"
+ | "clob"
+ | "ref"
+db-keys = element db:keys { db-keys-attlist, db-key+ }
+db-keys-attlist = empty
+db-key = element db:key { db-key-attlist, db-key-columns+ }
+db-key-attlist =
+ attribute db:name { \string }?
+ & attribute db:type { "primary" | "unique" | "foreign" }
+ & attribute db:referenced-table-name { \string }?
+ & attribute db:update-rule {
+ "cascade" | "restrict" | "set-null" | "no-action" | "set-default"
+ }?
+ & attribute db:delete-rule {
+ "cascade" | "restrict" | "set-null" | "no-action" | "set-default"
+ }?
+db-key-columns =
+ element db:key-columns { db-key-columns-attlist, db-key-column+ }
+db-key-columns-attlist = empty
+db-key-column = element db:key-column { db-key-column-attlist, empty }
+db-key-column-attlist =
+ attribute db:name { \string }?
+ & attribute db:related-column-name { \string }?
+db-indices = element db:indices { db-indices-attlist, db-index+ }
+db-indices-attlist = empty
+db-index = element db:index { db-index-attlist, db-index-columns+ }
+db-index-attlist =
+ attribute db:name { \string }
+ & attribute db:catalog-name { \string }?
+ & attribute db:is-unique { boolean }?
+ & attribute db:is-clustered { boolean }?
+db-index-columns = element db:index-columns { db-index-column+ }
+db-index-column =
+ element db:index-column { db-index-column-attlist, empty }
+db-index-column-attlist =
+ attribute db:name { \string }
+ & attribute db:is-ascending { boolean }?
+office-forms =
+ element office:forms {
+ office-forms-attlist, (form-form | xforms-model)*
+ }?
+office-forms-attlist =
+ attribute form:automatic-focus { boolean }?
+ & attribute form:apply-design-mode { boolean }?
+form-form =
+ element form:form {
+ common-form-control-attlist,
+ form-form-attlist,
+ form-properties?,
+ office-event-listeners?,
+ (controls | form-form)*,
+ form-connection-resource?
+ }
+form-form-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute office:target-frame { targetFrameName }?
+ & attribute form:method { "get" | "post" | \string }?
+ & attribute form:enctype { \string }?
+ & attribute form:allow-deletes { boolean }?
+ & attribute form:allow-inserts { boolean }?
+ & attribute form:allow-updates { boolean }?
+ & attribute form:apply-filter { boolean }?
+ & attribute form:command-type { "table" | "query" | "command" }?
+ & attribute form:command { \string }?
+ & attribute form:datasource { anyIRI | \string }?
+ & attribute form:master-fields { \string }?
+ & attribute form:detail-fields { \string }?
+ & attribute form:escape-processing { boolean }?
+ & attribute form:filter { \string }?
+ & attribute form:ignore-result { boolean }?
+ & attribute form:navigation-mode { navigation }?
+ & attribute form:order { \string }?
+ & attribute form:tab-cycle { tab-cycles }?
+navigation = "none" | "current" | "parent"
+tab-cycles = "records" | "current" | "page"
+form-connection-resource =
+ element form:connection-resource {
+ attribute xlink:href { anyIRI },
+ empty
+ }
+xforms-model = element xforms:model { anyAttListOrElements }
+column-controls =
+ element form:text { form-text-attlist, common-form-control-content }
+ | element form:textarea {
+ form-textarea-attlist, common-form-control-content, text-p*
+ }
+ | element form:formatted-text {
+ form-formatted-text-attlist, common-form-control-content
+ }
+ | element form:number {
+ form-number-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:date {
+ form-date-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:time {
+ form-time-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:combobox {
+ form-combobox-attlist, common-form-control-content, form-item*
+ }
+ | element form:listbox {
+ form-listbox-attlist, common-form-control-content, form-option*
+ }
+ | element form:checkbox {
+ form-checkbox-attlist, common-form-control-content
+ }
+controls =
+ column-controls
+ | element form:password {
+ form-password-attlist, common-form-control-content
+ }
+ | element form:file { form-file-attlist, common-form-control-content }
+ | element form:fixed-text {
+ form-fixed-text-attlist, common-form-control-content
+ }
+ | element form:button {
+ form-button-attlist, common-form-control-content
+ }
+ | element form:image {
+ form-image-attlist, common-form-control-content
+ }
+ | element form:radio {
+ form-radio-attlist, common-form-control-content
+ }
+ | element form:frame {
+ form-frame-attlist, common-form-control-content
+ }
+ | element form:image-frame {
+ form-image-frame-attlist, common-form-control-content
+ }
+ | element form:hidden {
+ form-hidden-attlist, common-form-control-content
+ }
+ | element form:grid {
+ form-grid-attlist, common-form-control-content, form-column*
+ }
+ | element form:value-range {
+ form-value-range-attlist, common-form-control-content
+ }
+ | element form:generic-control {
+ form-generic-control-attlist, common-form-control-content
+ }
+form-text-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist,
+ common-linked-cell
+form-control-attlist =
+ common-form-control-attlist,
+ common-control-id-attlist,
+ xforms-bind-attlist
+common-form-control-content = form-properties?, office-event-listeners?
+form-textarea-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist,
+ common-linked-cell
+form-password-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-linked-cell
+ & attribute form:echo-char { character }?
+form-file-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-linked-cell
+form-formatted-text-attlist =
+ form-control-attlist
+ & common-current-value-attlist
+ & common-disabled-attlist
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-readonly-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-data-field-attlist
+ & common-linked-cell
+ & common-spin-button
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:max-value { \string }?
+ & attribute form:min-value { \string }?
+ & attribute form:validation { boolean }?
+common-numeric-control-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist
+form-number-attlist =
+ attribute form:value { double }?
+ & attribute form:current-value { double }?
+ & attribute form:min-value { double }?
+ & attribute form:max-value { double }?
+form-date-attlist =
+ attribute form:value { date }?
+ & attribute form:current-value { date }?
+ & attribute form:min-value { date }?
+ & attribute form:max-value { date }?
+form-time-attlist =
+ attribute form:value { time }?
+ & attribute form:current-value { time }?
+ & attribute form:min-value { time }?
+ & attribute form:max-value { time }?
+form-fixed-text-attlist =
+ form-control-attlist
+ & for
+ & common-disabled-attlist
+ & label
+ & common-printable-attlist
+ & common-title-attlist
+ & attribute form:multi-line { boolean }?
+form-combobox-attlist =
+ form-control-attlist
+ & common-current-value-attlist
+ & common-disabled-attlist
+ & dropdown
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-readonly-attlist
+ & size
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-data-field-attlist
+ & list-source
+ & list-source-type
+ & common-linked-cell
+ & common-source-cell-range
+ & attribute form:auto-complete { boolean }?
+form-item = element form:item { form-item-attlist, text }
+form-item-attlist = label
+form-listbox-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & dropdown
+ & common-printable-attlist
+ & size
+ & common-tab-attlist
+ & common-title-attlist
+ & bound-column
+ & common-data-field-attlist
+ & list-source
+ & list-source-type
+ & common-linked-cell
+ & list-linkage-type
+ & common-source-cell-range
+ & attribute form:multiple { boolean }?
+ & attribute form:xforms-list-source { \string }?
+list-linkage-type =
+ attribute form:list-linkage-type {
+ "selection" | "selection-indices"
+ }?
+form-option = element form:option { form-option-attlist, text }
+form-option-attlist =
+ current-selected, selected, label, common-value-attlist
+form-button-attlist =
+ form-control-attlist
+ & button-type
+ & common-disabled-attlist
+ & label
+ & image-data
+ & common-printable-attlist
+ & common-tab-attlist
+ & target-frame
+ & target-location
+ & common-title-attlist
+ & common-value-attlist
+ & common-form-relative-image-position-attlist
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:default-button { boolean }?
+ & attribute form:toggle { boolean }?
+ & attribute form:focus-on-click { boolean }?
+ & attribute form:xforms-submission { \string }?
+form-image-attlist =
+ form-control-attlist,
+ button-type,
+ common-disabled-attlist,
+ image-data,
+ common-printable-attlist,
+ common-tab-attlist,
+ target-frame,
+ target-location,
+ common-title-attlist,
+ common-value-attlist
+form-checkbox-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & label
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-data-field-attlist
+ & common-form-visual-effect-attlist
+ & common-form-relative-image-position-attlist
+ & common-linked-cell
+ & attribute form:current-state { states }?
+ & attribute form:is-tristate { boolean }?
+ & attribute form:state { states }?
+states = "unchecked" | "checked" | "unknown"
+form-radio-attlist =
+ form-control-attlist,
+ current-selected,
+ common-disabled-attlist,
+ label,
+ common-printable-attlist,
+ selected,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-data-field-attlist,
+ common-form-visual-effect-attlist,
+ common-form-relative-image-position-attlist,
+ common-linked-cell
+form-frame-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ for,
+ label,
+ common-printable-attlist,
+ common-title-attlist
+form-image-frame-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ image-data,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-title-attlist,
+ common-data-field-attlist
+form-hidden-attlist = form-control-attlist, common-value-attlist
+form-grid-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ common-printable-attlist,
+ common-tab-attlist,
+ common-title-attlist
+form-column =
+ element form:column { form-column-attlist, column-controls+ }
+form-column-attlist =
+ common-form-control-attlist, label, text-style-name
+text-style-name = attribute form:text-style-name { styleNameRef }?
+form-value-range-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-linked-cell
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:max-value { integer }?
+ & attribute form:min-value { integer }?
+ & attribute form:step-size { positiveInteger }?
+ & attribute form:page-step-size { positiveInteger }?
+ & attribute form:orientation { "horizontal" | "vertical" }?
+form-generic-control-attlist = form-control-attlist
+common-form-control-attlist =
+ attribute form:name { \string }?
+ & attribute form:control-implementation { namespacedToken }?
+xforms-bind-attlist = attribute xforms:bind { \string }?
+types = "submit" | "reset" | "push" | "url"
+button-type = attribute form:button-type { types }?
+common-control-id-attlist =
+ xml-id,
+ attribute form:id { NCName }?
+current-selected = attribute form:current-selected { boolean }?
+common-value-attlist = attribute form:value { \string }?
+common-current-value-attlist = attribute form:current-value { \string }?
+common-disabled-attlist = attribute form:disabled { boolean }?
+dropdown = attribute form:dropdown { boolean }?
+for = attribute form:for { \string }?
+image-data = attribute form:image-data { anyIRI }?
+label = attribute form:label { \string }?
+common-maxlength-attlist =
+ attribute form:max-length { nonNegativeInteger }?
+common-printable-attlist = attribute form:printable { boolean }?
+common-readonly-attlist = attribute form:readonly { boolean }?
+selected = attribute form:selected { boolean }?
+size = attribute form:size { nonNegativeInteger }?
+common-tab-attlist =
+ attribute form:tab-index { nonNegativeInteger }?
+ & attribute form:tab-stop { boolean }?
+target-frame = attribute office:target-frame { targetFrameName }?
+target-location = attribute xlink:href { anyIRI }?
+common-title-attlist = attribute form:title { \string }?
+common-form-visual-effect-attlist =
+ attribute form:visual-effect { "flat" | "3d" }?
+common-form-relative-image-position-attlist =
+ attribute form:image-position { "center" }?
+ | (attribute form:image-position {
+ "start" | "end" | "top" | "bottom"
+ },
+ attribute form:image-align { "start" | "center" | "end" }?)
+bound-column = attribute form:bound-column { \string }?
+common-convert-empty-attlist =
+ attribute form:convert-empty-to-null { boolean }?
+common-data-field-attlist = attribute form:data-field { \string }?
+list-source = attribute form:list-source { \string }?
+list-source-type =
+ attribute form:list-source-type {
+ "table"
+ | "query"
+ | "sql"
+ | "sql-pass-through"
+ | "value-list"
+ | "table-fields"
+ }?
+common-linked-cell =
+ attribute form:linked-cell { cellAddress | \string }?
+common-source-cell-range =
+ attribute form:source-cell-range { cellRangeAddress | \string }?
+common-spin-button = attribute form:spin-button { boolean }?
+common-repeat = attribute form:repeat { boolean }?
+common-delay-for-repeat = attribute form:delay-for-repeat { duration }?
+form-properties = element form:properties { form-property+ }
+form-property =
+ element form:property {
+ form-property-name, form-property-value-and-type-attlist
+ }
+ | element form:list-property {
+ form-property-name, form-property-type-and-value-list
+ }
+form-property-name = attribute form:property-name { \string }
+form-property-value-and-type-attlist =
+ common-value-and-type-attlist
+ | attribute office:value-type { "void" }
+form-property-type-and-value-list =
+ (attribute office:value-type { "float" },
+ element form:list-value {
+ attribute office:value { double }
+ }*)
+ | (attribute office:value-type { "percentage" },
+ element form:list-value {
+ attribute office:value { double }
+ }*)
+ | (attribute office:value-type { "currency" },
+ element form:list-value {
+ attribute office:value { double },
+ attribute office:currency { \string }?
+ }*)
+ | (attribute office:value-type { "date" },
+ element form:list-value {
+ attribute office:date-value { dateOrDateTime }
+ }*)
+ | (attribute office:value-type { "time" },
+ element form:list-value {
+ attribute office:time-value { duration }
+ }*)
+ | (attribute office:value-type { "boolean" },
+ element form:list-value {
+ attribute office:boolean-value { boolean }
+ }*)
+ | (attribute office:value-type { "string" },
+ element form:list-value {
+ attribute office:string-value { \string }
+ }*)
+ | attribute office:value-type { "void" }
+office-annotation =
+ element office:annotation {
+ office-annotation-attlist,
+ draw-caption-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ dc-creator?,
+ dc-date?,
+ meta-date-string?,
+ (text-p | text-list)*
+ }
+office-annotation-end =
+ element office:annotation-end { office-annotation-end-attlist }
+office-annotation-attlist =
+ attribute office:display { boolean }?
+ & common-office-annotation-name-attlist?
+office-annotation-end-attlist = common-office-annotation-name-attlist
+common-office-annotation-name-attlist =
+ attribute office:name { \string }
+meta-date-string = element meta:date-string { \string }
+common-num-format-prefix-suffix-attlist =
+ attribute style:num-prefix { \string }?,
+ attribute style:num-suffix { \string }?
+common-num-format-attlist =
+ attribute style:num-format { "1" | "i" | "I" | \string | empty }
+ | (attribute style:num-format { "a" | "A" },
+ style-num-letter-sync-attlist)
+ | empty
+style-num-letter-sync-attlist =
+ attribute style:num-letter-sync { boolean }?
+office-change-info =
+ element office:change-info { dc-creator, dc-date, text-p* }
+office-event-listeners =
+ element office:event-listeners {
+ (script-event-listener | presentation-event-listener)*
+ }
+script-event-listener =
+ element script:event-listener { script-event-listener-attlist, empty }
+script-event-listener-attlist =
+ attribute script:event-name { \string }
+ & attribute script:language { \string }
+ & (attribute script:macro-name { \string }
+ | (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?))
+math-math = element math:math { mathMarkup }
+[
+ dc:description [
+ "To avoid inclusion of the complete MathML schema, anything is allowed within a math:math top-level element"
+ ]
+]
+mathMarkup =
+ (attribute * { text }
+ | text
+ | element * { mathMarkup })*
+text-dde-connection-decl =
+ element text:dde-connection-decl {
+ text-dde-connection-decl-attlist, common-dde-connection-decl-attlist
+ }
+text-dde-connection-decl-attlist = attribute office:name { \string }
+common-dde-connection-decl-attlist =
+ attribute office:dde-application { \string }
+ & attribute office:dde-topic { \string }
+ & attribute office:dde-item { \string }
+ & attribute office:automatic-update { boolean }?
+table-dde-link =
+ element table:dde-link { office-dde-source, table-table }
+office-dde-source =
+ element office:dde-source {
+ office-dde-source-attlist, common-dde-connection-decl-attlist
+ }
+office-dde-source-attlist =
+ attribute office:name { \string }?
+ & attribute office:conversion-mode {
+ "into-default-style-data-style"
+ | "into-english-number"
+ | "keep-text"
+ }?
+animation-element =
+ element anim:animate {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ common-spline-anim-value-attlist,
+ common-timing-attlist,
+ common-anim-add-accum-attlist
+ }
+ | element anim:set {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-set-values-attlist,
+ common-timing-attlist,
+ common-anim-add-accum-attlist
+ }
+ | element anim:animateMotion {
+ anim-animate-motion-attlist,
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-timing-attlist,
+ common-spline-anim-value-attlist
+ }
+ | element anim:animateColor {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ common-spline-anim-value-attlist,
+ anim-animate-color-attlist,
+ common-timing-attlist
+ }
+ | element anim:animateTransform {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ anim-animate-transform-attlist,
+ common-timing-attlist
+ }
+ | element anim:transitionFilter {
+ common-anim-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ anim-transition-filter-attlist,
+ common-timing-attlist
+ }
+ | element anim:par {
+ common-anim-attlist,
+ common-timing-attlist,
+ common-endsync-timing-attlist,
+ animation-element*
+ }
+ | element anim:seq {
+ common-anim-attlist,
+ common-endsync-timing-attlist,
+ common-timing-attlist,
+ animation-element*
+ }
+ | element anim:iterate {
+ common-anim-attlist,
+ anim-iterate-attlist,
+ common-timing-attlist,
+ common-endsync-timing-attlist,
+ animation-element*
+ }
+ | element anim:audio {
+ common-anim-attlist,
+ anim-audio-attlist,
+ common-basic-timing-attlist
+ }
+ | element anim:command {
+ common-anim-attlist,
+ anim-command-attlist,
+ common-begin-end-timing-attlist,
+ common-anim-target-attlist,
+ element anim:param {
+ attribute anim:name { \string },
+ attribute anim:value { \string }
+ }*
+ }
+anim-animate-motion-attlist =
+ attribute svg:path { pathData }?
+ & attribute svg:origin { \string }?
+ & attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+anim-animate-color-attlist =
+ attribute anim:color-interpolation { "rgb" | "hsl" }?
+ & attribute anim:color-interpolation-direction {
+ "clockwise" | "counter-clockwise"
+ }?
+anim-animate-transform-attlist =
+ attribute svg:type {
+ "translate" | "scale" | "rotate" | "skewX" | "skewY"
+ }
+anim-transition-filter-attlist =
+ attribute smil:type { \string }
+ & attribute smil:subtype { \string }?
+ & attribute smil:direction { "forward" | "reverse" }?
+ & attribute smil:fadeColor { color }?
+ & attribute smil:mode { "in" | "out" }?
+common-anim-target-attlist =
+ attribute smil:targetElement { IDREF }?
+ & attribute anim:sub-item { \string }?
+common-anim-named-target-attlist =
+ attribute smil:attributeName { \string }
+common-anim-values-attlist =
+ attribute smil:values { \string }?
+ & attribute anim:formula { \string }?
+ & common-anim-set-values-attlist
+ & attribute smil:from { \string }?
+ & attribute smil:by { \string }?
+common-anim-spline-mode-attlist =
+ attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+common-spline-anim-value-attlist =
+ attribute smil:keyTimes { \string }?
+ & attribute smil:keySplines { \string }?
+common-anim-add-accum-attlist =
+ attribute smil:accumulate { "none" | "sum" }?
+ & attribute smil:additive { "replace" | "sum" }?
+common-anim-set-values-attlist = attribute smil:to { \string }?
+common-begin-end-timing-attlist =
+ attribute smil:begin { \string }?
+ & attribute smil:end { \string }?
+common-dur-timing-attlist = attribute smil:dur { \string }?
+common-endsync-timing-attlist =
+ attribute smil:endsync { "first" | "last" | "all" | "media" | IDREF }?
+common-repeat-timing-attlist =
+ attribute smil:repeatDur { \string }?,
+ attribute smil:repeatCount { nonNegativeDecimal | "indefinite" }?
+nonNegativeDecimal = xsd:decimal { minInclusive = "0.0" }
+common-fill-timing-attlist =
+ attribute smil:fill {
+ "remove" | "freeze" | "hold" | "auto" | "default" | "transition"
+ }?
+common-fill-default-attlist =
+ attribute smil:fillDefault {
+ "remove" | "freeze" | "hold" | "transition" | "auto" | "inherit"
+ }?
+common-restart-timing-attlist =
+ attribute smil:restart {
+ "never" | "always" | "whenNotActive" | "default"
+ }?
+common-restart-default-attlist =
+ attribute smil:restartDefault {
+ "never" | "always" | "whenNotActive" | "inherit"
+ }?
+common-time-manip-attlist =
+ attribute smil:accelerate { zeroToOneDecimal }?
+ & attribute smil:decelerate { zeroToOneDecimal }?
+ & attribute smil:autoReverse { boolean }?
+zeroToOneDecimal = xsd:decimal { minInclusive = "0" maxInclusive = "1" }
+common-basic-timing-attlist =
+ common-begin-end-timing-attlist,
+ common-dur-timing-attlist,
+ common-repeat-timing-attlist,
+ common-restart-timing-attlist,
+ common-restart-default-attlist,
+ common-fill-timing-attlist,
+ common-fill-default-attlist
+common-timing-attlist =
+ common-basic-timing-attlist, common-time-manip-attlist
+anim-iterate-attlist =
+ common-anim-target-attlist
+ & attribute anim:iterate-type { \string }?
+ & attribute anim:iterate-interval { duration }?
+anim-audio-attlist =
+ attribute xlink:href { anyIRI }?
+ & attribute anim:audio-level { double }?
+anim-command-attlist = attribute anim:command { \string }
+style-style =
+ element style:style {
+ style-style-attlist, style-style-content, style-map*
+ }
+common-in-content-meta-attlist =
+ attribute xhtml:about { URIorSafeCURIE },
+ attribute xhtml:property { CURIEs },
+ common-meta-literal-attlist
+common-meta-literal-attlist =
+ attribute xhtml:datatype { CURIE }?,
+ attribute xhtml:content { \string }?
+xml-id = attribute xml:id { ID }
+style-style-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute style:parent-style-name { styleNameRef }?
+ & attribute style:next-style-name { styleNameRef }?
+ & attribute style:list-level { positiveInteger | empty }?
+ & attribute style:list-style-name { styleName | empty }?
+ & attribute style:master-page-name { styleNameRef }?
+ & attribute style:auto-update { boolean }?
+ & attribute style:data-style-name { styleNameRef }?
+ & attribute style:percentage-data-style-name { styleNameRef }?
+ & attribute style:class { \string }?
+ & attribute style:default-outline-level { positiveInteger | empty }?
+style-map = element style:map { style-map-attlist, empty }
+style-map-attlist =
+ attribute style:condition { \string }
+ & attribute style:apply-style-name { styleNameRef }
+ & attribute style:base-cell-address { cellAddress }?
+style-default-style =
+ element style:default-style { style-style-content }
+style-page-layout =
+ element style:page-layout {
+ style-page-layout-attlist, style-page-layout-content
+ }
+style-page-layout-content =
+ style-page-layout-properties?,
+ style-header-style?,
+ style-footer-style?
+style-page-layout-attlist =
+ attribute style:name { styleName }
+ & attribute style:page-usage {
+ "all" | "left" | "right" | "mirrored"
+ }?
+style-header-style =
+ element style:header-style { style-header-footer-properties? }
+style-footer-style =
+ element style:footer-style { style-header-footer-properties? }
+style-default-page-layout =
+ element style:default-page-layout { style-page-layout-content }
+style-master-page =
+ element style:master-page {
+ style-master-page-attlist,
+ (style-header, style-header-left?)?,
+ (style-footer, style-footer-left?)?,
+ draw-layer-set?,
+ office-forms?,
+ shape*,
+ animation-element?,
+ presentation-notes?
+ }
+style-master-page-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute style:page-layout-name { styleNameRef }
+ & attribute draw:style-name { styleNameRef }?
+ & attribute style:next-style-name { styleNameRef }?
+style-header =
+ element style:header {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-footer =
+ element style:footer {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-header-left =
+ element style:header-left {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-footer-left =
+ element style:footer-left {
+ common-style-header-footer-attlist, header-footer-content
+ }
+header-footer-content =
+ (text-tracked-changes,
+ text-decls,
+ (text-h
+ | text-p
+ | text-list
+ | table-table
+ | text-section
+ | text-table-of-content
+ | text-illustration-index
+ | text-table-index
+ | text-object-index
+ | text-user-index
+ | text-alphabetical-index
+ | text-bibliography
+ | text-index-title
+ | change-marks)*)
+ | (style-region-left?, style-region-center?, style-region-right?)
+common-style-header-footer-attlist =
+ attribute style:display { boolean }?
+style-region-left = element style:region-left { region-content }
+style-region-center = element style:region-center { region-content }
+style-region-right = element style:region-right { region-content }
+region-content = text-p*
+presentation-notes =
+ element presentation:notes {
+ common-presentation-header-footer-attlist,
+ presentation-notes-attlist,
+ office-forms,
+ shape*
+ }
+presentation-notes-attlist =
+ attribute style:page-layout-name { styleNameRef }?
+ & attribute draw:style-name { styleNameRef }?
+table-table-template =
+ element table:table-template {
+ table-table-template-attlist,
+ table-first-row?,
+ table-last-row?,
+ table-first-column?,
+ table-last-column?,
+ table-body,
+ table-even-rows?,
+ table-odd-rows?,
+ table-even-columns?,
+ table-odd-columns?,
+ table-background?
+ }
+table-table-template-attlist =
+ attribute table:name { \string }
+ & attribute table:first-row-start-column { rowOrCol }
+ & attribute table:first-row-end-column { rowOrCol }
+ & attribute table:last-row-start-column { rowOrCol }
+ & attribute table:last-row-end-column { rowOrCol }
+rowOrCol = "row" | "column"
+table-first-row =
+ element table:first-row { common-table-template-attlist, empty }
+table-last-row =
+ element table:last-row { common-table-template-attlist, empty }
+table-first-column =
+ element table:first-column { common-table-template-attlist, empty }
+table-last-column =
+ element table:last-column { common-table-template-attlist, empty }
+table-body = element table:body { common-table-template-attlist, empty }
+table-even-rows =
+ element table:even-rows { common-table-template-attlist, empty }
+table-odd-rows =
+ element table:odd-rows { common-table-template-attlist, empty }
+table-even-columns =
+ element table:even-columns { common-table-template-attlist, empty }
+table-odd-columns =
+ element table:odd-columns { common-table-template-attlist, empty }
+common-table-template-attlist =
+ attribute table:style-name { styleNameRef },
+ attribute table:paragraph-style-name { styleNameRef }?
+table-background =
+ element table:background { table-background-attlist, empty }
+table-background-attlist = attribute table:style-name { styleNameRef }
+style-font-face =
+ element style:font-face {
+ style-font-face-attlist, svg-font-face-src?, svg-definition-src?
+ }
+style-font-face-attlist =
+ attribute svg:font-family { \string }?
+ & attribute svg:font-style { fontStyle }?
+ & attribute svg:font-variant { fontVariant }?
+ & attribute svg:font-weight { fontWeight }?
+ & attribute svg:font-stretch {
+ "normal"
+ | "ultra-condensed"
+ | "extra-condensed"
+ | "condensed"
+ | "semi-condensed"
+ | "semi-expanded"
+ | "expanded"
+ | "extra-expanded"
+ | "ultra-expanded"
+ }?
+ & attribute svg:font-size { positiveLength }?
+ & attribute svg:unicode-range { \string }?
+ & attribute svg:units-per-em { integer }?
+ & attribute svg:panose-1 { \string }?
+ & attribute svg:stemv { integer }?
+ & attribute svg:stemh { integer }?
+ & attribute svg:slope { integer }?
+ & attribute svg:cap-height { integer }?
+ & attribute svg:x-height { integer }?
+ & attribute svg:accent-height { integer }?
+ & attribute svg:ascent { integer }?
+ & attribute svg:descent { integer }?
+ & attribute svg:widths { \string }?
+ & attribute svg:bbox { \string }?
+ & attribute svg:ideographic { integer }?
+ & attribute svg:alphabetic { integer }?
+ & attribute svg:mathematical { integer }?
+ & attribute svg:hanging { integer }?
+ & attribute svg:v-ideographic { integer }?
+ & attribute svg:v-alphabetic { integer }?
+ & attribute svg:v-mathematical { integer }?
+ & attribute svg:v-hanging { integer }?
+ & attribute svg:underline-position { integer }?
+ & attribute svg:underline-thickness { integer }?
+ & attribute svg:strikethrough-position { integer }?
+ & attribute svg:strikethrough-thickness { integer }?
+ & attribute svg:overline-position { integer }?
+ & attribute svg:overline-thickness { integer }?
+ & attribute style:name { \string }
+ & attribute style:font-adornments { \string }?
+ & attribute style:font-family-generic { fontFamilyGeneric }?
+ & attribute style:font-pitch { fontPitch }?
+ & attribute style:font-charset { textEncoding }?
+svg-font-face-src =
+ element svg:font-face-src {
+ (svg-font-face-uri | svg-font-face-name)+
+ }
+svg-font-face-uri =
+ element svg:font-face-uri {
+ common-svg-font-face-xlink-attlist, svg-font-face-format*
+ }
+svg-font-face-format =
+ element svg:font-face-format {
+ attribute svg:string { \string }?,
+ empty
+ }
+svg-font-face-name =
+ element svg:font-face-name {
+ attribute svg:name { \string }?,
+ empty
+ }
+svg-definition-src =
+ element svg:definition-src {
+ common-svg-font-face-xlink-attlist, empty
+ }
+common-svg-font-face-xlink-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?
+number-number-style =
+ element number:number-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-number, number-text?)?,
+ style-map*
+ }
+any-number = number-number | number-scientific-number | number-fraction
+number-number =
+ element number:number {
+ number-number-attlist,
+ common-decimal-places-attlist,
+ common-number-attlist,
+ number-embedded-text*
+ }
+number-number-attlist =
+ attribute number:decimal-replacement { \string }?
+ & attribute number:display-factor { double }?
+number-embedded-text =
+ element number:embedded-text { number-embedded-text-attlist, text }
+number-embedded-text-attlist = attribute number:position { integer }
+number-scientific-number =
+ element number:scientific-number {
+ number-scientific-number-attlist,
+ common-decimal-places-attlist,
+ common-number-attlist,
+ empty
+ }
+number-scientific-number-attlist =
+ attribute number:min-exponent-digits { integer }?
+number-fraction =
+ element number:fraction {
+ number-fraction-attlist, common-number-attlist, empty
+ }
+number-fraction-attlist =
+ attribute number:min-numerator-digits { integer }?
+ & attribute number:min-denominator-digits { integer }?
+ & attribute number:denominator-value { integer }?
+number-currency-style =
+ element number:currency-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ style-text-properties?,
+ number-text?,
+ ((number-and-text, currency-symbol-and-text?)
+ | (currency-symbol-and-text, number-and-text?))?,
+ style-map*
+ }
+currency-symbol-and-text = number-currency-symbol, number-text?
+number-and-text = number-number, number-text?
+number-currency-symbol =
+ element number:currency-symbol {
+ number-currency-symbol-attlist, text
+ }
+number-currency-symbol-attlist =
+ attribute number:language { languageCode }?,
+ attribute number:country { countryCode }?,
+ attribute number:script { scriptCode }?,
+ attribute number:rfc-language-tag { language }?
+number-percentage-style =
+ element number:percentage-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ number-and-text?,
+ style-map*
+ }
+number-date-style =
+ element number:date-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-date, number-text?)+,
+ style-map*
+ }
+any-date =
+ number-day
+ | number-month
+ | number-year
+ | number-era
+ | number-day-of-week
+ | number-week-of-year
+ | number-quarter
+ | number-hours
+ | number-am-pm
+ | number-minutes
+ | number-seconds
+number-day =
+ element number:day {
+ number-day-attlist, common-calendar-attlist, empty
+ }
+number-day-attlist = attribute number:style { "short" | "long" }?
+number-month =
+ element number:month {
+ number-month-attlist, common-calendar-attlist, empty
+ }
+number-month-attlist =
+ attribute number:textual { boolean }?
+ & attribute number:possessive-form { boolean }?
+ & attribute number:style { "short" | "long" }?
+number-year =
+ element number:year {
+ number-year-attlist, common-calendar-attlist, empty
+ }
+number-year-attlist = attribute number:style { "short" | "long" }?
+number-era =
+ element number:era {
+ number-era-attlist, common-calendar-attlist, empty
+ }
+number-era-attlist = attribute number:style { "short" | "long" }?
+number-day-of-week =
+ element number:day-of-week {
+ number-day-of-week-attlist, common-calendar-attlist, empty
+ }
+number-day-of-week-attlist =
+ attribute number:style { "short" | "long" }?
+number-week-of-year =
+ element number:week-of-year { common-calendar-attlist, empty }
+number-quarter =
+ element number:quarter {
+ number-quarter-attlist, common-calendar-attlist, empty
+ }
+number-quarter-attlist = attribute number:style { "short" | "long" }?
+number-time-style =
+ element number:time-style {
+ number-time-style-attlist,
+ common-data-style-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-time, number-text?)+,
+ style-map*
+ }
+any-time = number-hours | number-am-pm | number-minutes | number-seconds
+number-time-style-attlist =
+ attribute number:truncate-on-overflow { boolean }?
+number-hours = element number:hours { number-hours-attlist, empty }
+number-hours-attlist = attribute number:style { "short" | "long" }?
+number-minutes =
+ element number:minutes { number-minutes-attlist, empty }
+number-minutes-attlist = attribute number:style { "short" | "long" }?
+number-seconds =
+ element number:seconds { number-seconds-attlist, empty }
+number-seconds-attlist =
+ attribute number:style { "short" | "long" }?
+ & attribute number:decimal-places { integer }?
+number-am-pm = element number:am-pm { empty }
+number-boolean-style =
+ element number:boolean-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (number-boolean, number-text?)?,
+ style-map*
+ }
+number-boolean = element number:boolean { empty }
+number-text-style =
+ element number:text-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (number-text-content, number-text?)*,
+ style-map*
+ }
+number-text = element number:text { text }
+number-text-content = element number:text-content { empty }
+common-data-style-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute number:language { languageCode }?
+ & attribute number:country { countryCode }?
+ & attribute number:script { scriptCode }?
+ & attribute number:rfc-language-tag { language }?
+ & attribute number:title { \string }?
+ & attribute style:volatile { boolean }?
+ & attribute number:transliteration-format { \string }?
+ & attribute number:transliteration-language { countryCode }?
+ & attribute number:transliteration-country { countryCode }?
+ & attribute number:transliteration-style {
+ "short" | "medium" | "long"
+ }?
+common-auto-reorder-attlist =
+ attribute number:automatic-order { boolean }?
+common-format-source-attlist =
+ attribute number:format-source { "fixed" | "language" }?
+common-decimal-places-attlist =
+ attribute number:decimal-places { integer }?
+common-number-attlist =
+ attribute number:min-integer-digits { integer }?
+ & attribute number:grouping { boolean }?
+common-calendar-attlist =
+ attribute number:calendar {
+ "gregorian"
+ | "gengou"
+ | "ROC"
+ | "hanja_yoil"
+ | "hanja"
+ | "hijri"
+ | "jewish"
+ | "buddhist"
+ | \string
+ }?
+style-style-content =
+ (attribute style:family { "text" },
+ style-text-properties?)
+ | (attribute style:family { "paragraph" },
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "section" },
+ style-section-properties?)
+ | (attribute style:family { "ruby" },
+ style-ruby-properties?)
+ | (attribute style:family { "table" },
+ style-table-properties?)
+ | (attribute style:family { "table-column" },
+ style-table-column-properties?)
+ | (attribute style:family { "table-row" },
+ style-table-row-properties?)
+ | (attribute style:family { "table-cell" },
+ style-table-cell-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "graphic" | "presentation" },
+ style-graphic-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "drawing-page" },
+ style-drawing-page-properties?)
+ | (attribute style:family { "chart" },
+ style-chart-properties?,
+ style-graphic-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+text-linenumbering-configuration =
+ element text:linenumbering-configuration {
+ text-linenumbering-configuration-attlist,
+ text-linenumbering-separator?
+ }
+text-linenumbering-configuration-attlist =
+ attribute text:number-lines { boolean }?
+ & common-num-format-attlist?
+ & attribute text:style-name { styleNameRef }?
+ & attribute text:increment { nonNegativeInteger }?
+ & attribute text:number-position {
+ "left" | "right" | "inner" | "outer"
+ }?
+ & attribute text:offset { nonNegativeLength }?
+ & attribute text:count-empty-lines { boolean }?
+ & attribute text:count-in-text-boxes { boolean }?
+ & attribute text:restart-on-page { boolean }?
+text-linenumbering-separator =
+ element text:linenumbering-separator {
+ attribute text:increment { nonNegativeInteger }?,
+ text
+ }
+text-notes-configuration =
+ element text:notes-configuration { text-notes-configuration-content }
+text-notes-configuration-content =
+ text-note-class
+ & attribute text:citation-style-name { styleNameRef }?
+ & attribute text:citation-body-style-name { styleNameRef }?
+ & attribute text:default-style-name { styleNameRef }?
+ & attribute text:master-page-name { styleNameRef }?
+ & attribute text:start-value { nonNegativeInteger }?
+ & common-num-format-prefix-suffix-attlist
+ & common-num-format-attlist?
+ & attribute text:start-numbering-at {
+ "document" | "chapter" | "page"
+ }?
+ & attribute text:footnotes-position {
+ "text" | "page" | "section" | "document"
+ }?
+ & element text:note-continuation-notice-forward { text }?
+ & element text:note-continuation-notice-backward { text }?
+text-bibliography-configuration =
+ element text:bibliography-configuration {
+ text-bibliography-configuration-attlist, text-sort-key*
+ }
+text-bibliography-configuration-attlist =
+ attribute text:prefix { \string }?
+ & attribute text:suffix { \string }?
+ & attribute text:numbered-entries { boolean }?
+ & attribute text:sort-by-position { boolean }?
+ & attribute fo:language { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute text:sort-algorithm { \string }?
+text-sort-key = element text:sort-key { text-sort-key-attlist, empty }
+text-sort-key-attlist =
+ attribute text:key {
+ "address"
+ | "annote"
+ | "author"
+ | "bibliography-type"
+ | "booktitle"
+ | "chapter"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "edition"
+ | "editor"
+ | "howpublished"
+ | "identifier"
+ | "institution"
+ | "isbn"
+ | "issn"
+ | "journal"
+ | "month"
+ | "note"
+ | "number"
+ | "organizations"
+ | "pages"
+ | "publisher"
+ | "report-type"
+ | "school"
+ | "series"
+ | "title"
+ | "url"
+ | "volume"
+ | "year"
+ },
+ attribute text:sort-ascending { boolean }?
+text-list-style =
+ element text:list-style {
+ text-list-style-attr, text-list-style-content*
+ }
+text-list-style-attr =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute text:consecutive-numbering { boolean }?
+text-list-style-content =
+ element text:list-level-style-number {
+ text-list-level-style-attr,
+ text-list-level-style-number-attr,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+ | element text:list-level-style-bullet {
+ text-list-level-style-attr,
+ text-list-level-style-bullet-attr,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+ | element text:list-level-style-image {
+ text-list-level-style-attr,
+ text-list-level-style-image-attr,
+ style-list-level-properties?
+ }
+text-list-level-style-number-attr =
+ attribute text:style-name { styleNameRef }?
+ & common-num-format-attlist
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:display-levels { positiveInteger }?
+ & attribute text:start-value { positiveInteger }?
+text-list-level-style-bullet-attr =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:bullet-char { character }
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:bullet-relative-size { percent }?
+text-list-level-style-image-attr =
+ common-draw-data-attlist | office-binary-data
+text-list-level-style-attr = attribute text:level { positiveInteger }
+text-outline-style =
+ element text:outline-style {
+ text-outline-style-attr, text-outline-level-style+
+ }
+text-outline-style-attr = attribute style:name { styleName }
+text-outline-level-style =
+ element text:outline-level-style {
+ text-outline-level-style-attlist,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+text-outline-level-style-attlist =
+ attribute text:level { positiveInteger }
+ & attribute text:style-name { styleNameRef }?
+ & common-num-format-attlist
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:display-levels { positiveInteger }?
+ & attribute text:start-value { positiveInteger }?
+style-graphic-properties =
+ element style:graphic-properties {
+ style-graphic-properties-content-strict
+ }
+style-graphic-properties-content-strict =
+ style-graphic-properties-attlist,
+ style-graphic-fill-properties-attlist,
+ style-graphic-properties-elements
+style-drawing-page-properties =
+ element style:drawing-page-properties {
+ style-drawing-page-properties-content-strict
+ }
+style-drawing-page-properties-content-strict =
+ style-graphic-fill-properties-attlist,
+ style-drawing-page-properties-attlist,
+ style-drawing-page-properties-elements
+draw-gradient =
+ element draw:gradient {
+ common-draw-gradient-attlist, draw-gradient-attlist, empty
+ }
+common-draw-gradient-attlist =
+ attribute draw:name { styleName }?
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { gradient-style }
+ & attribute draw:cx { percent }?
+ & attribute draw:cy { percent }?
+ & attribute draw:angle { angle }?
+ & attribute draw:border { percent }?
+gradient-style =
+ "linear" | "axial" | "radial" | "ellipsoid" | "square" | "rectangular"
+draw-gradient-attlist =
+ attribute draw:start-color { color }?
+ & attribute draw:end-color { color }?
+ & attribute draw:start-intensity { zeroToHundredPercent }?
+ & attribute draw:end-intensity { zeroToHundredPercent }?
+svg-linearGradient =
+ element svg:linearGradient {
+ common-svg-gradient-attlist,
+ attribute svg:x1 { coordinate | percent }?,
+ attribute svg:y1 { coordinate | percent }?,
+ attribute svg:x2 { coordinate | percent }?,
+ attribute svg:y2 { coordinate | percent }?,
+ svg-stop*
+ }
+svg-radialGradient =
+ element svg:radialGradient {
+ common-svg-gradient-attlist,
+ attribute svg:cx { coordinate | percent }?,
+ attribute svg:cy { coordinate | percent }?,
+ attribute svg:r { coordinate | percent }?,
+ attribute svg:fx { coordinate | percent }?,
+ attribute svg:fy { coordinate | percent }?,
+ svg-stop*
+ }
+svg-stop =
+ element svg:stop {
+ attribute svg:offset { double | percent },
+ attribute svg:stop-color { color }?,
+ attribute svg:stop-opacity { double }?
+ }
+common-svg-gradient-attlist =
+ attribute svg:gradientUnits { "objectBoundingBox" }?
+ & attribute svg:gradientTransform { \string }?
+ & attribute svg:spreadMethod { "pad" | "reflect" | "repeat" }?
+ & attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+draw-hatch = element draw:hatch { draw-hatch-attlist, empty }
+draw-hatch-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { "single" | "double" | "triple" }
+ & attribute draw:color { color }?
+ & attribute draw:distance { length }?
+ & attribute draw:rotation { angle }?
+draw-fill-image =
+ element draw:fill-image {
+ draw-fill-image-attlist,
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onLoad" }?,
+ empty
+ }
+draw-fill-image-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute svg:width { length }?
+ & attribute svg:height { length }?
+draw-opacity =
+ element draw:opacity {
+ common-draw-gradient-attlist, draw-opacity-attlist, empty
+ }
+draw-opacity-attlist =
+ attribute draw:start { zeroToHundredPercent }?,
+ attribute draw:end { zeroToHundredPercent }?
+draw-marker =
+ element draw:marker {
+ draw-marker-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ empty
+ }
+draw-marker-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+draw-stroke-dash =
+ element draw:stroke-dash { draw-stroke-dash-attlist, empty }
+draw-stroke-dash-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { "rect" | "round" }?
+ & attribute draw:dots1 { integer }?
+ & attribute draw:dots1-length { length | percent }?
+ & attribute draw:dots2 { integer }?
+ & attribute draw:dots2-length { length | percent }?
+ & attribute draw:distance { length | percent }?
+style-presentation-page-layout =
+ element style:presentation-page-layout {
+ attribute style:name { styleName },
+ attribute style:display-name { \string }?,
+ presentation-placeholder*
+ }
+presentation-placeholder =
+ element presentation:placeholder {
+ attribute presentation:object { presentation-classes },
+ attribute svg:x { coordinate | percent },
+ attribute svg:y { coordinate | percent },
+ attribute svg:width { length | percent },
+ attribute svg:height { length | percent },
+ empty
+ }
+style-page-layout-properties =
+ element style:page-layout-properties {
+ style-page-layout-properties-content-strict
+ }
+style-page-layout-properties-content-strict =
+ style-page-layout-properties-attlist,
+ style-page-layout-properties-elements
+style-page-layout-properties-attlist =
+ attribute fo:page-width { length }?
+ & attribute fo:page-height { length }?
+ & common-num-format-attlist?
+ & common-num-format-prefix-suffix-attlist
+ & attribute style:paper-tray-name { "default" | \string }?
+ & attribute style:print-orientation { "portrait" | "landscape" }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & attribute style:register-truth-ref-style-name { styleNameRef }?
+ & attribute style:print {
+ list {
+ ("headers"
+ | "grid"
+ | "annotations"
+ | "objects"
+ | "charts"
+ | "drawings"
+ | "formulas"
+ | "zero-values")*
+ }
+ }?
+ & attribute style:print-page-order { "ttb" | "ltr" }?
+ & attribute style:first-page-number { positiveInteger | "continue" }?
+ & attribute style:scale-to { percent }?
+ & attribute style:scale-to-pages { positiveInteger }?
+ & attribute style:table-centering {
+ "horizontal" | "vertical" | "both" | "none"
+ }?
+ & attribute style:footnote-max-height { length }?
+ & common-writing-mode-attlist
+ & attribute style:layout-grid-mode { "none" | "line" | "both" }?
+ & attribute style:layout-grid-standard-mode { boolean }?
+ & attribute style:layout-grid-base-height { length }?
+ & attribute style:layout-grid-ruby-height { length }?
+ & attribute style:layout-grid-lines { positiveInteger }?
+ & attribute style:layout-grid-base-width { length }?
+ & attribute style:layout-grid-color { color }?
+ & attribute style:layout-grid-ruby-below { boolean }?
+ & attribute style:layout-grid-print { boolean }?
+ & attribute style:layout-grid-display { boolean }?
+ & attribute style:layout-grid-snap-to { boolean }?
+style-page-layout-properties-elements =
+ style-background-image & style-columns & style-footnote-sep
+style-footnote-sep =
+ element style:footnote-sep { style-footnote-sep-attlist, empty }?
+style-footnote-sep-attlist =
+ attribute style:width { length }?,
+ attribute style:rel-width { percent }?,
+ attribute style:color { color }?,
+ attribute style:line-style { lineStyle }?,
+ attribute style:adjustment { "left" | "center" | "right" }?,
+ attribute style:distance-before-sep { length }?,
+ attribute style:distance-after-sep { length }?
+style-header-footer-properties =
+ element style:header-footer-properties {
+ style-header-footer-properties-content-strict
+ }
+style-header-footer-properties-content-strict =
+ style-header-footer-properties-attlist,
+ style-header-footer-properties-elements
+style-header-footer-properties-attlist =
+ attribute svg:height { length }?
+ & attribute fo:min-height { length }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-background-color-attlist
+ & common-shadow-attlist
+ & attribute style:dynamic-spacing { boolean }?
+style-header-footer-properties-elements = style-background-image
+style-text-properties =
+ element style:text-properties { style-text-properties-content-strict }
+style-text-properties-content-strict =
+ style-text-properties-attlist, style-text-properties-elements
+style-text-properties-elements = empty
+style-text-properties-attlist =
+ attribute fo:font-variant { fontVariant }?
+ & attribute fo:text-transform {
+ "none" | "lowercase" | "uppercase" | "capitalize"
+ }?
+ & attribute fo:color { color }?
+ & attribute style:use-window-font-color { boolean }?
+ & attribute style:text-outline { boolean }?
+ & attribute style:text-line-through-type { lineType }?
+ & attribute style:text-line-through-style { lineStyle }?
+ & attribute style:text-line-through-width { lineWidth }?
+ & attribute style:text-line-through-color { "font-color" | color }?
+ & attribute style:text-line-through-text { \string }?
+ & attribute style:text-line-through-text-style { styleNameRef }?
+ & attribute style:text-position {
+ list { (percent | "super" | "sub"), percent? }
+ }?
+ & attribute style:font-name { \string }?
+ & attribute style:font-name-asian { \string }?
+ & attribute style:font-name-complex { \string }?
+ & attribute fo:font-family { \string }?
+ & attribute style:font-family-asian { \string }?
+ & attribute style:font-family-complex { \string }?
+ & attribute style:font-family-generic { fontFamilyGeneric }?
+ & attribute style:font-family-generic-asian { fontFamilyGeneric }?
+ & attribute style:font-family-generic-complex { fontFamilyGeneric }?
+ & attribute style:font-style-name { \string }?
+ & attribute style:font-style-name-asian { \string }?
+ & attribute style:font-style-name-complex { \string }?
+ & attribute style:font-pitch { fontPitch }?
+ & attribute style:font-pitch-asian { fontPitch }?
+ & attribute style:font-pitch-complex { fontPitch }?
+ & attribute style:font-charset { textEncoding }?
+ & attribute style:font-charset-asian { textEncoding }?
+ & attribute style:font-charset-complex { textEncoding }?
+ & attribute fo:font-size { positiveLength | percent }?
+ & attribute style:font-size-asian { positiveLength | percent }?
+ & attribute style:font-size-complex { positiveLength | percent }?
+ & attribute style:font-size-rel { length }?
+ & attribute style:font-size-rel-asian { length }?
+ & attribute style:font-size-rel-complex { length }?
+ & attribute style:script-type {
+ "latin" | "asian" | "complex" | "ignore"
+ }?
+ & attribute fo:letter-spacing { length | "normal" }?
+ & attribute fo:language { languageCode }?
+ & attribute style:language-asian { languageCode }?
+ & attribute style:language-complex { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute style:country-asian { countryCode }?
+ & attribute style:country-complex { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:script-asian { scriptCode }?
+ & attribute style:script-complex { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute style:rfc-language-tag-asian { language }?
+ & attribute style:rfc-language-tag-complex { language }?
+ & attribute fo:font-style { fontStyle }?
+ & attribute style:font-style-asian { fontStyle }?
+ & attribute style:font-style-complex { fontStyle }?
+ & attribute style:font-relief { "none" | "embossed" | "engraved" }?
+ & attribute fo:text-shadow { shadowType }?
+ & attribute style:text-underline-type { lineType }?
+ & attribute style:text-underline-style { lineStyle }?
+ & attribute style:text-underline-width { lineWidth }?
+ & attribute style:text-underline-color { "font-color" | color }?
+ & attribute style:text-overline-type { lineType }?
+ & attribute style:text-overline-style { lineStyle }?
+ & attribute style:text-overline-width { lineWidth }?
+ & attribute style:text-overline-color { "font-color" | color }?
+ & attribute style:text-overline-mode { lineMode }?
+ & attribute fo:font-weight { fontWeight }?
+ & attribute style:font-weight-asian { fontWeight }?
+ & attribute style:font-weight-complex { fontWeight }?
+ & attribute style:text-underline-mode { lineMode }?
+ & attribute style:text-line-through-mode { lineMode }?
+ & attribute style:letter-kerning { boolean }?
+ & attribute style:text-blinking { boolean }?
+ & common-background-color-attlist
+ & attribute style:text-combine { "none" | "letters" | "lines" }?
+ & attribute style:text-combine-start-char { character }?
+ & attribute style:text-combine-end-char { character }?
+ & attribute style:text-emphasize {
+ "none"
+ | list {
+ ("none" | "accent" | "dot" | "circle" | "disc"),
+ ("above" | "below")
+ }
+ }?
+ & attribute style:text-scale { percent }?
+ & attribute style:text-rotation-angle { angle }?
+ & attribute style:text-rotation-scale { "fixed" | "line-height" }?
+ & attribute fo:hyphenate { boolean }?
+ & attribute fo:hyphenation-remain-char-count { positiveInteger }?
+ & attribute fo:hyphenation-push-char-count { positiveInteger }?
+ & (attribute text:display { "true" }
+ | attribute text:display { "none" }
+ | (attribute text:display { "condition" },
+ attribute text:condition { "none" })
+ | empty)
+fontVariant = "normal" | "small-caps"
+fontFamilyGeneric =
+ "roman" | "swiss" | "modern" | "decorative" | "script" | "system"
+fontPitch = "fixed" | "variable"
+textEncoding = xsd:string { pattern = "[A-Za-z][A-Za-z0-9._\-]*" }
+fontStyle = "normal" | "italic" | "oblique"
+shadowType = "none" | \string
+lineType = "none" | "single" | "double"
+lineStyle =
+ "none"
+ | "solid"
+ | "dotted"
+ | "dash"
+ | "long-dash"
+ | "dot-dash"
+ | "dot-dot-dash"
+ | "wave"
+lineWidth =
+ "auto"
+ | "normal"
+ | "bold"
+ | "thin"
+ | "medium"
+ | "thick"
+ | positiveInteger
+ | percent
+ | positiveLength
+fontWeight =
+ "normal"
+ | "bold"
+ | "100"
+ | "200"
+ | "300"
+ | "400"
+ | "500"
+ | "600"
+ | "700"
+ | "800"
+ | "900"
+lineMode = "continuous" | "skip-white-space"
+style-paragraph-properties =
+ element style:paragraph-properties {
+ style-paragraph-properties-content-strict
+ }
+style-paragraph-properties-content-strict =
+ style-paragraph-properties-attlist,
+ style-paragraph-properties-elements
+style-paragraph-properties-attlist =
+ attribute fo:line-height { "normal" | nonNegativeLength | percent }?
+ & attribute style:line-height-at-least { nonNegativeLength }?
+ & attribute style:line-spacing { length }?
+ & attribute style:font-independent-line-spacing { boolean }?
+ & common-text-align
+ & attribute fo:text-align-last { "start" | "center" | "justify" }?
+ & attribute style:justify-single-word { boolean }?
+ & attribute fo:keep-together { "auto" | "always" }?
+ & attribute fo:widows { nonNegativeInteger }?
+ & attribute fo:orphans { nonNegativeInteger }?
+ & attribute style:tab-stop-distance { nonNegativeLength }?
+ & attribute fo:hyphenation-keep { "auto" | "page" }?
+ & attribute fo:hyphenation-ladder-count {
+ "no-limit" | positiveInteger
+ }?
+ & attribute style:register-true { boolean }?
+ & common-horizontal-margin-attlist
+ & attribute fo:text-indent { length | percent }?
+ & attribute style:auto-text-indent { boolean }?
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-break-attlist
+ & common-background-color-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & attribute style:join-border { boolean }?
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-keep-with-next-attlist
+ & attribute text:number-lines { boolean }?
+ & attribute text:line-number { nonNegativeInteger }?
+ & attribute style:text-autospace { "none" | "ideograph-alpha" }?
+ & attribute style:punctuation-wrap { "simple" | "hanging" }?
+ & attribute style:line-break { "normal" | "strict" }?
+ & attribute style:vertical-align {
+ "top" | "middle" | "bottom" | "auto" | "baseline"
+ }?
+ & common-writing-mode-attlist
+ & attribute style:writing-mode-automatic { boolean }?
+ & attribute style:snap-to-layout-grid { boolean }?
+ & common-page-number-attlist
+ & common-background-transparency-attlist
+common-text-align =
+ attribute fo:text-align {
+ "start" | "end" | "left" | "right" | "center" | "justify"
+ }?
+style-paragraph-properties-elements =
+ style-tab-stops & style-drop-cap & style-background-image
+style-tab-stops = element style:tab-stops { style-tab-stop* }?
+style-tab-stop =
+ element style:tab-stop { style-tab-stop-attlist, empty }
+style-tab-stop-attlist =
+ attribute style:position { length }
+ & (attribute style:type { "left" | "center" | "right" }?
+ | (attribute style:type { "char" },
+ style-tab-stop-char-attlist))
+ & attribute style:leader-type { lineType }?
+ & attribute style:leader-style { lineStyle }?
+ & attribute style:leader-width { lineWidth }?
+ & attribute style:leader-color { "font-color" | color }?
+ & attribute style:leader-text { character }?
+ & attribute style:leader-text-style { styleNameRef }?
+style-tab-stop-char-attlist = attribute style:char { character }
+style-drop-cap =
+ element style:drop-cap { style-drop-cap-attlist, empty }?
+style-drop-cap-attlist =
+ attribute style:length { "word" | positiveInteger }?
+ & attribute style:lines { positiveInteger }?
+ & attribute style:distance { length }?
+ & attribute style:style-name { styleNameRef }?
+common-horizontal-margin-attlist =
+ attribute fo:margin-left { length | percent }?,
+ attribute fo:margin-right { length | percent }?
+common-vertical-margin-attlist =
+ attribute fo:margin-top { nonNegativeLength | percent }?,
+ attribute fo:margin-bottom { nonNegativeLength | percent }?
+common-margin-attlist =
+ attribute fo:margin { nonNegativeLength | percent }?
+common-break-attlist =
+ attribute fo:break-before { "auto" | "column" | "page" }?,
+ attribute fo:break-after { "auto" | "column" | "page" }?
+common-background-color-attlist =
+ attribute fo:background-color { "transparent" | color }?
+style-background-image =
+ element style:background-image {
+ style-background-image-attlist,
+ (common-draw-data-attlist | office-binary-data | empty)
+ }?
+style-background-image-attlist =
+ attribute style:repeat { "no-repeat" | "repeat" | "stretch" }?
+ & attribute style:position {
+ "left"
+ | "center"
+ | "right"
+ | "top"
+ | "bottom"
+ | list { horiBackPos, vertBackPos }
+ | list { vertBackPos, horiBackPos }
+ }?
+ & attribute style:filter-name { \string }?
+ & attribute draw:opacity { zeroToHundredPercent }?
+horiBackPos = "left" | "center" | "right"
+vertBackPos = "top" | "center" | "bottom"
+common-border-attlist =
+ attribute fo:border { \string }?,
+ attribute fo:border-top { \string }?,
+ attribute fo:border-bottom { \string }?,
+ attribute fo:border-left { \string }?,
+ attribute fo:border-right { \string }?
+common-border-line-width-attlist =
+ attribute style:border-line-width { borderWidths }?,
+ attribute style:border-line-width-top { borderWidths }?,
+ attribute style:border-line-width-bottom { borderWidths }?,
+ attribute style:border-line-width-left { borderWidths }?,
+ attribute style:border-line-width-right { borderWidths }?
+borderWidths = list { positiveLength, positiveLength, positiveLength }
+common-padding-attlist =
+ attribute fo:padding { nonNegativeLength }?,
+ attribute fo:padding-top { nonNegativeLength }?,
+ attribute fo:padding-bottom { nonNegativeLength }?,
+ attribute fo:padding-left { nonNegativeLength }?,
+ attribute fo:padding-right { nonNegativeLength }?
+common-shadow-attlist = attribute style:shadow { shadowType }?
+common-keep-with-next-attlist =
+ attribute fo:keep-with-next { "auto" | "always" }?
+common-writing-mode-attlist =
+ attribute style:writing-mode {
+ "lr-tb" | "rl-tb" | "tb-rl" | "tb-lr" | "lr" | "rl" | "tb" | "page"
+ }?
+common-page-number-attlist =
+ attribute style:page-number { positiveInteger | "auto" }?
+common-background-transparency-attlist =
+ attribute style:background-transparency { zeroToHundredPercent }?
+style-ruby-properties =
+ element style:ruby-properties { style-ruby-properties-content-strict }
+style-ruby-properties-content-strict =
+ style-ruby-properties-attlist, style-ruby-properties-elements
+style-ruby-properties-elements = empty
+style-ruby-properties-attlist =
+ attribute style:ruby-position { "above" | "below" }?
+ & attribute style:ruby-align {
+ "left"
+ | "center"
+ | "right"
+ | "distribute-letter"
+ | "distribute-space"
+ }?
+style-section-properties =
+ element style:section-properties {
+ style-section-properties-content-strict
+ }
+style-section-properties-content-strict =
+ style-section-properties-attlist, style-section-properties-elements
+style-section-properties-attlist =
+ common-background-color-attlist
+ & common-horizontal-margin-attlist
+ & attribute style:protect { boolean }?
+ & common-editable-attlist
+ & attribute text:dont-balance-text-columns { boolean }?
+ & common-writing-mode-attlist
+style-section-properties-elements =
+ style-background-image & style-columns & text-notes-configuration*
+style-columns =
+ element style:columns {
+ style-columns-attlist, style-column-sep?, style-column*
+ }?
+style-columns-attlist =
+ attribute fo:column-count { positiveInteger }
+ & attribute fo:column-gap { length }?
+style-column = element style:column { style-column-attlist }
+style-column-attlist =
+ attribute style:rel-width { relativeLength }
+ & attribute fo:start-indent { length }?
+ & attribute fo:end-indent { length }?
+ & attribute fo:space-before { length }?
+ & attribute fo:space-after { length }?
+style-column-sep = element style:column-sep { style-column-sep-attlist }
+style-column-sep-attlist =
+ attribute style:style {
+ "none" | "solid" | "dotted" | "dashed" | "dot-dashed"
+ }?
+ & attribute style:width { length }
+ & attribute style:height { zeroToHundredPercent }?
+ & attribute style:vertical-align { "top" | "middle" | "bottom" }?
+ & attribute style:color { color }?
+style-table-properties =
+ element style:table-properties {
+ style-table-properties-content-strict
+ }
+style-table-properties-content-strict =
+ style-table-properties-attlist, style-table-properties-elements
+style-table-properties-attlist =
+ attribute style:width { positiveLength }?
+ & attribute style:rel-width { percent }?
+ & attribute table:align { "left" | "center" | "right" | "margins" }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-page-number-attlist
+ & common-break-attlist
+ & common-background-color-attlist
+ & common-shadow-attlist
+ & common-keep-with-next-attlist
+ & attribute style:may-break-between-rows { boolean }?
+ & attribute table:border-model { "collapsing" | "separating" }?
+ & common-writing-mode-attlist
+ & attribute table:display { boolean }?
+style-table-properties-elements = style-background-image
+style-table-column-properties =
+ element style:table-column-properties {
+ style-table-column-properties-content-strict
+ }
+style-table-column-properties-content-strict =
+ style-table-column-properties-attlist,
+ style-table-column-properties-elements
+style-table-column-properties-elements = empty
+style-table-column-properties-attlist =
+ attribute style:column-width { positiveLength }?
+ & attribute style:rel-column-width { relativeLength }?
+ & attribute style:use-optimal-column-width { boolean }?
+ & common-break-attlist
+style-table-row-properties =
+ element style:table-row-properties {
+ style-table-row-properties-content-strict
+ }
+style-table-row-properties-content-strict =
+ style-table-row-properties-attlist,
+ style-table-row-properties-elements
+style-table-row-properties-attlist =
+ attribute style:row-height { positiveLength }?
+ & attribute style:min-row-height { nonNegativeLength }?
+ & attribute style:use-optimal-row-height { boolean }?
+ & common-background-color-attlist
+ & common-break-attlist
+ & attribute fo:keep-together { "auto" | "always" }?
+style-table-row-properties-elements = style-background-image
+style-table-cell-properties =
+ element style:table-cell-properties {
+ style-table-cell-properties-content-strict
+ }
+style-table-cell-properties-content-strict =
+ style-table-cell-properties-attlist,
+ style-table-cell-properties-elements
+style-table-cell-properties-attlist =
+ attribute style:vertical-align {
+ "top" | "middle" | "bottom" | "automatic"
+ }?
+ & attribute style:text-align-source { "fix" | "value-type" }?
+ & common-style-direction-attlist
+ & attribute style:glyph-orientation-vertical {
+ "auto" | "0" | "0deg" | "0rad" | "0grad"
+ }?
+ & common-writing-mode-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & common-border-attlist
+ & attribute style:diagonal-tl-br { \string }?
+ & attribute style:diagonal-tl-br-widths { borderWidths }?
+ & attribute style:diagonal-bl-tr { \string }?
+ & attribute style:diagonal-bl-tr-widths { borderWidths }?
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & attribute fo:wrap-option { "no-wrap" | "wrap" }?
+ & common-rotation-angle-attlist
+ & attribute style:rotation-align {
+ "none" | "bottom" | "top" | "center"
+ }?
+ & attribute style:cell-protect {
+ "none"
+ | "hidden-and-protected"
+ | list { ("protected" | "formula-hidden")+ }
+ }?
+ & attribute style:print-content { boolean }?
+ & attribute style:decimal-places { nonNegativeInteger }?
+ & attribute style:repeat-content { boolean }?
+ & attribute style:shrink-to-fit { boolean }?
+common-style-direction-attlist =
+ attribute style:direction { "ltr" | "ttb" }?
+style-table-cell-properties-elements = style-background-image
+common-rotation-angle-attlist =
+ attribute style:rotation-angle { angle }?
+style-list-level-properties =
+ element style:list-level-properties {
+ style-list-level-properties-content-strict
+ }
+style-list-level-properties-content-strict =
+ style-list-level-properties-attlist,
+ style-list-level-properties-elements
+style-list-level-properties-attlist =
+ common-text-align
+ & attribute text:space-before { length }?
+ & attribute text:min-label-width { nonNegativeLength }?
+ & attribute text:min-label-distance { nonNegativeLength }?
+ & attribute style:font-name { \string }?
+ & attribute fo:width { positiveLength }?
+ & attribute fo:height { positiveLength }?
+ & common-vertical-rel-attlist
+ & common-vertical-pos-attlist
+ & attribute text:list-level-position-and-space-mode {
+ "label-width-and-position" | "label-alignment"
+ }?
+style-list-level-properties-elements = style-list-level-label-alignment
+style-list-level-label-alignment =
+ element style:list-level-label-alignment {
+ style-list-level-label-alignment-attlist, empty
+ }?
+style-list-level-label-alignment-attlist =
+ attribute text:label-followed-by { "listtab" | "space" | "nothing" }
+ & attribute text:list-tab-stop-position { length }?
+ & attribute fo:text-indent { length }?
+ & attribute fo:margin-left { length }?
+style-graphic-properties-attlist =
+ attribute draw:stroke { "none" | "dash" | "solid" }?
+ & attribute draw:stroke-dash { styleNameRef }?
+ & attribute draw:stroke-dash-names { styleNameRefs }?
+ & attribute svg:stroke-width { length }?
+ & attribute svg:stroke-color { color }?
+ & attribute draw:marker-start { styleNameRef }?
+ & attribute draw:marker-end { styleNameRef }?
+ & attribute draw:marker-start-width { length }?
+ & attribute draw:marker-end-width { length }?
+ & attribute draw:marker-start-center { boolean }?
+ & attribute draw:marker-end-center { boolean }?
+ & attribute svg:stroke-opacity {
+ xsd:double { minInclusive = "0" maxInclusive = "1" }
+ | zeroToHundredPercent
+ }?
+ & attribute draw:stroke-linejoin {
+ "miter" | "round" | "bevel" | "middle" | "none"
+ }?
+ & attribute svg:stroke-linecap { "butt" | "square" | "round" }?
+ & attribute draw:symbol-color { color }?
+ & attribute text:animation {
+ "none" | "scroll" | "alternate" | "slide"
+ }?
+ & attribute text:animation-direction {
+ "left" | "right" | "up" | "down"
+ }?
+ & attribute text:animation-start-inside { boolean }?
+ & attribute text:animation-stop-inside { boolean }?
+ & attribute text:animation-repeat { nonNegativeInteger }?
+ & attribute text:animation-delay { duration }?
+ & attribute text:animation-steps { length }?
+ & attribute draw:auto-grow-width { boolean }?
+ & attribute draw:auto-grow-height { boolean }?
+ & attribute draw:fit-to-size { boolean }?
+ & attribute draw:fit-to-contour { boolean }?
+ & attribute draw:textarea-vertical-align {
+ "top" | "middle" | "bottom" | "justify"
+ }?
+ & attribute draw:textarea-horizontal-align {
+ "left" | "center" | "right" | "justify"
+ }?
+ & attribute fo:wrap-option { "no-wrap" | "wrap" }?
+ & attribute style:shrink-to-fit { boolean }?
+ & attribute draw:color-mode {
+ "greyscale" | "mono" | "watermark" | "standard"
+ }?
+ & attribute draw:color-inversion { boolean }?
+ & attribute draw:luminance { zeroToHundredPercent }?
+ & attribute draw:contrast { percent }?
+ & attribute draw:gamma { percent }?
+ & attribute draw:red { signedZeroToHundredPercent }?
+ & attribute draw:green { signedZeroToHundredPercent }?
+ & attribute draw:blue { signedZeroToHundredPercent }?
+ & attribute draw:image-opacity { zeroToHundredPercent }?
+ & attribute draw:shadow { "visible" | "hidden" }?
+ & attribute draw:shadow-offset-x { length }?
+ & attribute draw:shadow-offset-y { length }?
+ & attribute draw:shadow-color { color }?
+ & attribute draw:shadow-opacity { zeroToHundredPercent }?
+ & attribute draw:start-line-spacing-horizontal { distance }?
+ & attribute draw:start-line-spacing-vertical { distance }?
+ & attribute draw:end-line-spacing-horizontal { distance }?
+ & attribute draw:end-line-spacing-vertical { distance }?
+ & attribute draw:line-distance { distance }?
+ & attribute draw:guide-overhang { length }?
+ & attribute draw:guide-distance { distance }?
+ & attribute draw:start-guide { length }?
+ & attribute draw:end-guide { length }?
+ & attribute draw:placing { "below" | "above" }?
+ & attribute draw:parallel { boolean }?
+ & attribute draw:measure-align {
+ "automatic" | "left-outside" | "inside" | "right-outside"
+ }?
+ & attribute draw:measure-vertical-align {
+ "automatic" | "above" | "below" | "center"
+ }?
+ & attribute draw:unit {
+ "automatic"
+ | "mm"
+ | "cm"
+ | "m"
+ | "km"
+ | "pt"
+ | "pc"
+ | "inch"
+ | "ft"
+ | "mi"
+ }?
+ & attribute draw:show-unit { boolean }?
+ & attribute draw:decimal-places { nonNegativeInteger }?
+ & attribute draw:caption-type {
+ "straight-line" | "angled-line" | "angled-connector-line"
+ }?
+ & attribute draw:caption-angle-type { "fixed" | "free" }?
+ & attribute draw:caption-angle { angle }?
+ & attribute draw:caption-gap { distance }?
+ & attribute draw:caption-escape-direction {
+ "horizontal" | "vertical" | "auto"
+ }?
+ & attribute draw:caption-escape { length | percent }?
+ & attribute draw:caption-line-length { length }?
+ & attribute draw:caption-fit-line-length { boolean }?
+ & attribute dr3d:horizontal-segments { nonNegativeInteger }?
+ & attribute dr3d:vertical-segments { nonNegativeInteger }?
+ & attribute dr3d:edge-rounding { percent }?
+ & attribute dr3d:edge-rounding-mode { "correct" | "attractive" }?
+ & attribute dr3d:back-scale { percent }?
+ & attribute dr3d:depth { length }?
+ & attribute dr3d:backface-culling { "enabled" | "disabled" }?
+ & attribute dr3d:end-angle { angle }?
+ & attribute dr3d:close-front { boolean }?
+ & attribute dr3d:close-back { boolean }?
+ & attribute dr3d:lighting-mode { "standard" | "double-sided" }?
+ & attribute dr3d:normals-kind { "object" | "flat" | "sphere" }?
+ & attribute dr3d:normals-direction { "normal" | "inverse" }?
+ & attribute dr3d:texture-generation-mode-x {
+ "object" | "parallel" | "sphere"
+ }?
+ & attribute dr3d:texture-generation-mode-y {
+ "object" | "parallel" | "sphere"
+ }?
+ & attribute dr3d:texture-kind { "luminance" | "intensity" | "color" }?
+ & attribute dr3d:texture-filter { "enabled" | "disabled" }?
+ & attribute dr3d:texture-mode { "replace" | "modulate" | "blend" }?
+ & attribute dr3d:ambient-color { color }?
+ & attribute dr3d:emissive-color { color }?
+ & attribute dr3d:specular-color { color }?
+ & attribute dr3d:diffuse-color { color }?
+ & attribute dr3d:shininess { percent }?
+ & attribute dr3d:shadow { "visible" | "hidden" }?
+ & common-draw-rel-size-attlist
+ & attribute fo:min-width { length | percent }?
+ & attribute fo:min-height { length | percent }?
+ & attribute fo:max-height { length | percent }?
+ & attribute fo:max-width { length | percent }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & attribute style:print-content { boolean }?
+ & attribute style:protect {
+ "none"
+ | list { ("content" | "position" | "size")+ }
+ }?
+ & attribute style:horizontal-pos {
+ "left"
+ | "center"
+ | "right"
+ | "from-left"
+ | "inside"
+ | "outside"
+ | "from-inside"
+ }?
+ & attribute svg:x { coordinate }?
+ & attribute style:horizontal-rel {
+ "page"
+ | "page-content"
+ | "page-start-margin"
+ | "page-end-margin"
+ | "frame"
+ | "frame-content"
+ | "frame-start-margin"
+ | "frame-end-margin"
+ | "paragraph"
+ | "paragraph-content"
+ | "paragraph-start-margin"
+ | "paragraph-end-margin"
+ | "char"
+ }?
+ & common-vertical-pos-attlist
+ & common-vertical-rel-attlist
+ & common-text-anchor-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & common-background-transparency-attlist
+ & common-editable-attlist
+ & attribute style:wrap {
+ "none"
+ | "left"
+ | "right"
+ | "parallel"
+ | "dynamic"
+ | "run-through"
+ | "biggest"
+ }?
+ & attribute style:wrap-dynamic-threshold { nonNegativeLength }?
+ & attribute style:number-wrapped-paragraphs {
+ "no-limit" | positiveInteger
+ }?
+ & attribute style:wrap-contour { boolean }?
+ & attribute style:wrap-contour-mode { "full" | "outside" }?
+ & attribute style:run-through { "foreground" | "background" }?
+ & attribute style:flow-with-text { boolean }?
+ & attribute style:overflow-behavior {
+ "clip" | "auto-create-new-frame"
+ }?
+ & attribute style:mirror {
+ "none"
+ | "vertical"
+ | horizontal-mirror
+ | list { "vertical", horizontal-mirror }
+ | list { horizontal-mirror, "vertical" }
+ }?
+ & attribute fo:clip { "auto" | clipShape }?
+ & attribute draw:wrap-influence-on-position {
+ "iterative" | "once-concurrent" | "once-successive"
+ }?
+ & common-writing-mode-attlist
+ & attribute draw:frame-display-scrollbar { boolean }?
+ & attribute draw:frame-display-border { boolean }?
+ & attribute draw:frame-margin-horizontal { nonNegativePixelLength }?
+ & attribute draw:frame-margin-vertical { nonNegativePixelLength }?
+ & attribute draw:visible-area-left { nonNegativeLength }?
+ & attribute draw:visible-area-top { nonNegativeLength }?
+ & attribute draw:visible-area-width { positiveLength }?
+ & attribute draw:visible-area-height { positiveLength }?
+ & attribute draw:draw-aspect {
+ "content" | "thumbnail" | "icon" | "print-view"
+ }?
+ & attribute draw:ole-draw-aspect { nonNegativeInteger }?
+style-graphic-fill-properties-attlist =
+ attribute draw:fill {
+ "none" | "solid" | "bitmap" | "gradient" | "hatch"
+ }?
+ & attribute draw:fill-color { color }?
+ & attribute draw:secondary-fill-color { color }?
+ & attribute draw:fill-gradient-name { styleNameRef }?
+ & attribute draw:gradient-step-count { nonNegativeInteger }?
+ & attribute draw:fill-hatch-name { styleNameRef }?
+ & attribute draw:fill-hatch-solid { boolean }?
+ & attribute draw:fill-image-name { styleNameRef }?
+ & attribute style:repeat { "no-repeat" | "repeat" | "stretch" }?
+ & attribute draw:fill-image-width { length | percent }?
+ & attribute draw:fill-image-height { length | percent }?
+ & attribute draw:fill-image-ref-point-x { percent }?
+ & attribute draw:fill-image-ref-point-y { percent }?
+ & attribute draw:fill-image-ref-point {
+ "top-left"
+ | "top"
+ | "top-right"
+ | "left"
+ | "center"
+ | "right"
+ | "bottom-left"
+ | "bottom"
+ | "bottom-right"
+ }?
+ & attribute draw:tile-repeat-offset {
+ list { zeroToHundredPercent, ("horizontal" | "vertical") }
+ }?
+ & attribute draw:opacity { zeroToHundredPercent }?
+ & attribute draw:opacity-name { styleNameRef }?
+ & attribute svg:fill-rule { "nonzero" | "evenodd" }?
+style-graphic-properties-elements =
+ text-list-style? & style-background-image & style-columns
+common-vertical-pos-attlist =
+ attribute style:vertical-pos {
+ "top" | "middle" | "bottom" | "from-top" | "below"
+ }?,
+ attribute svg:y { coordinate }?
+common-vertical-rel-attlist =
+ attribute style:vertical-rel {
+ "page"
+ | "page-content"
+ | "frame"
+ | "frame-content"
+ | "paragraph"
+ | "paragraph-content"
+ | "char"
+ | "line"
+ | "baseline"
+ | "text"
+ }?
+common-editable-attlist = attribute style:editable { boolean }?
+horizontal-mirror =
+ "horizontal" | "horizontal-on-odd" | "horizontal-on-even"
+clipShape =
+ xsd:string {
+ pattern =
+ "rect\([ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)))|(auto))([ ]*,[ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))))|(auto)){3}[ ]*\)"
+ }
+nonNegativePixelLength =
+ xsd:string { pattern = "([0-9]+(\.[0-9]*)?|\.[0-9]+)(px)" }
+style-chart-properties =
+ element style:chart-properties {
+ style-chart-properties-content-strict
+ }
+style-chart-properties-content-strict =
+ style-chart-properties-attlist, style-chart-properties-elements
+style-chart-properties-elements = empty
+style-chart-properties-attlist =
+ attribute chart:scale-text { boolean }?
+ & attribute chart:three-dimensional { boolean }?
+ & attribute chart:deep { boolean }?
+ & attribute chart:right-angled-axes { boolean }?
+ & (attribute chart:symbol-type { "none" }
+ | attribute chart:symbol-type { "automatic" }
+ | (attribute chart:symbol-type { "named-symbol" },
+ attribute chart:symbol-name {
+ "square"
+ | "diamond"
+ | "arrow-down"
+ | "arrow-up"
+ | "arrow-right"
+ | "arrow-left"
+ | "bow-tie"
+ | "hourglass"
+ | "circle"
+ | "star"
+ | "x"
+ | "plus"
+ | "asterisk"
+ | "horizontal-bar"
+ | "vertical-bar"
+ })
+ | (attribute chart:symbol-type { "image" },
+ element chart:symbol-image {
+ attribute xlink:href { anyIRI }
+ })
+ | empty)
+ & attribute chart:symbol-width { nonNegativeLength }?
+ & attribute chart:symbol-height { nonNegativeLength }?
+ & attribute chart:sort-by-x-values { boolean }?
+ & attribute chart:vertical { boolean }?
+ & attribute chart:connect-bars { boolean }?
+ & attribute chart:gap-width { integer }?
+ & attribute chart:overlap { integer }?
+ & attribute chart:group-bars-per-axis { boolean }?
+ & attribute chart:japanese-candle-stick { boolean }?
+ & attribute chart:interpolation {
+ "none" | "cubic-spline" | "b-spline"
+ }?
+ & attribute chart:spline-order { positiveInteger }?
+ & attribute chart:spline-resolution { positiveInteger }?
+ & attribute chart:pie-offset { nonNegativeInteger }?
+ & attribute chart:angle-offset { angle }?
+ & attribute chart:hole-size { percent }?
+ & attribute chart:lines { boolean }?
+ & attribute chart:solid-type {
+ "cuboid" | "cylinder" | "cone" | "pyramid"
+ }?
+ & attribute chart:stacked { boolean }?
+ & attribute chart:percentage { boolean }?
+ & attribute chart:treat-empty-cells {
+ "use-zero" | "leave-gap" | "ignore"
+ }?
+ & attribute chart:link-data-style-to-source { boolean }?
+ & attribute chart:logarithmic { boolean }?
+ & attribute chart:maximum { double }?
+ & attribute chart:minimum { double }?
+ & attribute chart:origin { double }?
+ & attribute chart:interval-major { double }?
+ & attribute chart:interval-minor-divisor { positiveInteger }?
+ & attribute chart:tick-marks-major-inner { boolean }?
+ & attribute chart:tick-marks-major-outer { boolean }?
+ & attribute chart:tick-marks-minor-inner { boolean }?
+ & attribute chart:tick-marks-minor-outer { boolean }?
+ & attribute chart:reverse-direction { boolean }?
+ & attribute chart:display-label { boolean }?
+ & attribute chart:text-overlap { boolean }?
+ & attribute text:line-break { boolean }?
+ & attribute chart:label-arrangement {
+ "side-by-side" | "stagger-even" | "stagger-odd"
+ }?
+ & common-style-direction-attlist
+ & common-rotation-angle-attlist
+ & attribute chart:data-label-number {
+ "none" | "value" | "percentage" | "value-and-percentage"
+ }?
+ & attribute chart:data-label-text { boolean }?
+ & attribute chart:data-label-symbol { boolean }?
+ & element chart:label-separator { text-p }?
+ & attribute chart:label-position { labelPositions }?
+ & attribute chart:label-position-negative { labelPositions }?
+ & attribute chart:visible { boolean }?
+ & attribute chart:auto-position { boolean }?
+ & attribute chart:auto-size { boolean }?
+ & attribute chart:mean-value { boolean }?
+ & attribute chart:error-category {
+ "none"
+ | "variance"
+ | "standard-deviation"
+ | "percentage"
+ | "error-margin"
+ | "constant"
+ | "standard-error"
+ | "cell-range"
+ }?
+ & attribute chart:error-percentage { double }?
+ & attribute chart:error-margin { double }?
+ & attribute chart:error-lower-limit { double }?
+ & attribute chart:error-upper-limit { double }?
+ & attribute chart:error-upper-indicator { boolean }?
+ & attribute chart:error-lower-indicator { boolean }?
+ & attribute chart:error-lower-range { cellRangeAddressList }?
+ & attribute chart:error-upper-range { cellRangeAddressList }?
+ & attribute chart:series-source { "columns" | "rows" }?
+ & attribute chart:regression-type {
+ "none" | "linear" | "logarithmic" | "exponential" | "power"
+ }?
+ & attribute chart:axis-position { "start" | "end" | double }?
+ & attribute chart:axis-label-position {
+ "near-axis"
+ | "near-axis-other-side"
+ | "outside-start"
+ | "outside-end"
+ }?
+ & attribute chart:tick-mark-position {
+ "at-labels" | "at-axis" | "at-labels-and-axis"
+ }?
+ & attribute chart:include-hidden-cells { boolean }?
+labelPositions =
+ "avoid-overlap"
+ | "center"
+ | "top"
+ | "top-right"
+ | "right"
+ | "bottom-right"
+ | "bottom"
+ | "bottom-left"
+ | "left"
+ | "top-left"
+ | "inside"
+ | "outside"
+ | "near-origin"
+style-drawing-page-properties-attlist =
+ attribute presentation:transition-type {
+ "manual" | "automatic" | "semi-automatic"
+ }?
+ & attribute presentation:transition-style {
+ "none"
+ | "fade-from-left"
+ | "fade-from-top"
+ | "fade-from-right"
+ | "fade-from-bottom"
+ | "fade-from-upperleft"
+ | "fade-from-upperright"
+ | "fade-from-lowerleft"
+ | "fade-from-lowerright"
+ | "move-from-left"
+ | "move-from-top"
+ | "move-from-right"
+ | "move-from-bottom"
+ | "move-from-upperleft"
+ | "move-from-upperright"
+ | "move-from-lowerleft"
+ | "move-from-lowerright"
+ | "uncover-to-left"
+ | "uncover-to-top"
+ | "uncover-to-right"
+ | "uncover-to-bottom"
+ | "uncover-to-upperleft"
+ | "uncover-to-upperright"
+ | "uncover-to-lowerleft"
+ | "uncover-to-lowerright"
+ | "fade-to-center"
+ | "fade-from-center"
+ | "vertical-stripes"
+ | "horizontal-stripes"
+ | "clockwise"
+ | "counterclockwise"
+ | "open-vertical"
+ | "open-horizontal"
+ | "close-vertical"
+ | "close-horizontal"
+ | "wavyline-from-left"
+ | "wavyline-from-top"
+ | "wavyline-from-right"
+ | "wavyline-from-bottom"
+ | "spiralin-left"
+ | "spiralin-right"
+ | "spiralout-left"
+ | "spiralout-right"
+ | "roll-from-top"
+ | "roll-from-left"
+ | "roll-from-right"
+ | "roll-from-bottom"
+ | "stretch-from-left"
+ | "stretch-from-top"
+ | "stretch-from-right"
+ | "stretch-from-bottom"
+ | "vertical-lines"
+ | "horizontal-lines"
+ | "dissolve"
+ | "random"
+ | "vertical-checkerboard"
+ | "horizontal-checkerboard"
+ | "interlocking-horizontal-left"
+ | "interlocking-horizontal-right"
+ | "interlocking-vertical-top"
+ | "interlocking-vertical-bottom"
+ | "fly-away"
+ | "open"
+ | "close"
+ | "melt"
+ }?
+ & attribute presentation:transition-speed { presentationSpeeds }?
+ & attribute smil:type { \string }?
+ & attribute smil:subtype { \string }?
+ & attribute smil:direction { "forward" | "reverse" }?
+ & attribute smil:fadeColor { color }?
+ & attribute presentation:duration { duration }?
+ & attribute presentation:visibility { "visible" | "hidden" }?
+ & attribute draw:background-size { "full" | "border" }?
+ & attribute presentation:background-objects-visible { boolean }?
+ & attribute presentation:background-visible { boolean }?
+ & attribute presentation:display-header { boolean }?
+ & attribute presentation:display-footer { boolean }?
+ & attribute presentation:display-page-number { boolean }?
+ & attribute presentation:display-date-time { boolean }?
+style-drawing-page-properties-elements = presentation-sound?
+\string = xsd:string
+date = xsd:date
+time = xsd:time
+dateTime = xsd:dateTime
+duration = xsd:duration
+integer = xsd:integer
+nonNegativeInteger = xsd:nonNegativeInteger
+positiveInteger = xsd:positiveInteger
+double = xsd:double
+anyURI = xsd:anyURI
+base64Binary = xsd:base64Binary
+ID = xsd:ID
+IDREF = xsd:IDREF
+IDREFS = xsd:IDREFS
+NCName = xsd:NCName
+boolean = "true" | "false"
+dateOrDateTime = xsd:date | xsd:dateTime
+timeOrDateTime = xsd:time | xsd:dateTime
+language = xsd:language
+countryCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+languageCode = xsd:token { pattern = "[A-Za-z]{1,8}" }
+scriptCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+character = xsd:string { length = "1" }
+length =
+ xsd:string {
+ pattern =
+ "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+nonNegativeLength =
+ xsd:string {
+ pattern =
+ "([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+positiveLength =
+ xsd:string {
+ pattern =
+ "([0-9]*[1-9][0-9]*(\.[0-9]*)?|0+\.[0-9]*[1-9][0-9]*|\.[0-9]*[1-9][0-9]*)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+percent = xsd:string { pattern = "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)%" }
+zeroToHundredPercent =
+ xsd:string {
+ pattern = "([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+ }
+signedZeroToHundredPercent =
+ xsd:string {
+ pattern = "-?([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+ }
+relativeLength = xsd:string { pattern = "[0-9]+\*" }
+coordinate = length
+distance = length
+color = xsd:string { pattern = "#[0-9a-fA-F]{6}" }
+angle = xsd:string
+CURIE =
+ xsd:string { pattern = "(([\i-[:]][\c-[:]]*)?:)?.+" minLength = "1" }
+CURIEs = list { CURIE+ }
+SafeCURIE =
+ xsd:string {
+ pattern = "\[(([\i-[:]][\c-[:]]*)?:)?.+\]"
+ minLength = "3"
+ }
+URIorSafeCURIE = anyURI | SafeCURIE
+styleName = xsd:NCName
+styleNameRef = xsd:NCName | empty
+styleNameRefs = list { xsd:NCName* }
+variableName = xsd:string
+targetFrameName = "_self" | "_blank" | "_parent" | "_top" | \string
+valueType =
+ "float"
+ | "time"
+ | "date"
+ | "percentage"
+ | "currency"
+ | "boolean"
+ | "string"
+points =
+ xsd:string { pattern = "-?[0-9]+,-?[0-9]+([ ]+-?[0-9]+,-?[0-9]+)*" }
+pathData = xsd:string
+vector3D =
+ xsd:string {
+ pattern =
+ "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)){2}[ ]*\)"
+ }
+namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" }
+anyIRI =
+ xsd:anyURI
+ >> dc:description [
+ "An IRI-reference as defined in [RFC3987]. See ODF 1.2 Part 1 section 18.3."
+ ]
+anyAttListOrElements =
+ attribute * { text }*,
+ anyElements
+anyElements =
+ element * {
+ mixed { anyAttListOrElements }
+ }*
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
new file mode 100644
index 0000000..a319191
--- /dev/null
+++ b/etc/schema/schemas.xml
@@ -0,0 +1,7 @@
+<?xml version="1.0"?>
+<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">
+ <documentElement prefix="office" typeId="OpenDocument"/>
+ <documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/>
+ <typeId id="OpenDocument" uri="od-schema-v1.2-cs01.rnc"/>
+ <typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-cs01.rnc"/>
+</locatingRules>
diff --git a/etc/styles/OrgOdtContentTemplate.xml b/etc/styles/OrgOdtContentTemplate.xml
new file mode 100644
index 0000000..55e1b78
--- /dev/null
+++ b/etc/styles/OrgOdtContentTemplate.xml
@@ -0,0 +1,263 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- See etc/org/README for copyright information -->
+<office:document-content
+ xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0"
+ xmlns:style="urn:oasis:names:tc:opendocument:xmlns:style:1.0"
+ xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0"
+ xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0"
+ xmlns:draw="urn:oasis:names:tc:opendocument:xmlns:drawing:1.0"
+ xmlns:fo="urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0"
+ xmlns:xlink="http://www.w3.org/1999/xlink"
+ xmlns:dc="http://purl.org/dc/elements/1.1/"
+ xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0"
+ xmlns:number="urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0"
+ xmlns:svg="urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0"
+ xmlns:chart="urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
+ xmlns:dr3d="urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0"
+ xmlns:math="http://www.w3.org/1998/Math/MathML"
+ xmlns:form="urn:oasis:names:tc:opendocument:xmlns:form:1.0"
+ xmlns:script="urn:oasis:names:tc:opendocument:xmlns:script:1.0"
+ xmlns:ooo="http://openoffice.org/2004/office"
+ xmlns:ooow="http://openoffice.org/2004/writer"
+ xmlns:oooc="http://openoffice.org/2004/calc"
+ xmlns:dom="http://www.w3.org/2001/xml-events"
+ xmlns:xforms="http://www.w3.org/2002/xforms"
+ xmlns:xsd="http://www.w3.org/2001/XMLSchema"
+ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xmlns:rpt="http://openoffice.org/2005/report"
+ xmlns:of="urn:oasis:names:tc:opendocument:xmlns:of:1.2"
+ xmlns:xodt="http://www.w3.org/1999/xodt"
+ xmlns:field="urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0" office:version="1.2">
+ <!-- scripts -->
+ <office:scripts/>
+
+ <!-- font face declarations -->
+ <office:font-face-decls>
+ <style:font-face style:name="Tahoma1" svg:font-family="Tahoma"/>
+ <style:font-face style:name="courier" svg:font-family="courier, monospace"/>
+ <style:font-face style:name="Arial Unicode MS" svg:font-family="&apos;Arial Unicode MS&apos;" style:font-pitch="variable"/>
+ <style:font-face style:name="HG Mincho Light J" svg:font-family="&apos;HG Mincho Light J&apos;" style:font-pitch="variable"/>
+ <style:font-face style:name="Thorndale" svg:font-family="Thorndale" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Times New Roman" svg:font-family="&apos;Times New Roman&apos;" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Albany" svg:font-family="Albany" style:font-family-generic="swiss" style:font-pitch="variable"/>
+ <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable"/>
+ <style:font-face style:name="Tahoma" svg:font-family="Tahoma" style:font-family-generic="system" style:font-pitch="variable"/>
+ </office:font-face-decls>
+
+ <!-- automatic styles -->
+ <office:automatic-styles>
+ <!-- Section styles -->
+ <style:style style:name="OrgIndentedSection-Level-1" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.281cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-2" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="1.905cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-3" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="2.54cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-4" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="3.175cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-5" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="3.81cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-6" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="4.445cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-7" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="5.08cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-8" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="5.715cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-9" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="6.35cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+ <style:style style:name="OrgIndentedSection-Level-10" style:family="section">
+ <style:section-properties text:dont-balance-text-columns="false" fo:margin-left="6.985cm" fo:margin-right="0cm" style:editable="false">
+ <style:columns fo:column-count="1" fo:column-gap="0cm"/>
+ </style:section-properties>
+ </style:style>
+
+ <!-- Table styles -->
+ <style:style style:name="OrgTable" style:family="table">
+ <style:table-properties style:rel-width="96%" fo:margin-top="0cm" fo:margin-bottom="0.20cm" table:align="center"/>
+ </style:style>
+
+ <style:style style:name="OrgTableColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+
+ <style:style style:name="OrgTblCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellT" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="none" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellB" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellBLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTB" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBL" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="none" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+ <style:style style:name="OrgTblCellTBLR" style:family="table-cell" style:parent-style-name="OrgTblCell">
+ <style:table-cell-properties fo:padding="0.159cm" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000"/>
+ </style:style>
+
+ <!-- BEGIN: Table styles for numbered equations -->
+ <style:style style:name="OrgEquation" style:family="table">
+ <style:table-properties style:rel-width="100%" fo:margin-top="0cm" fo:margin-bottom="0.20cm" table:align="center"/>
+ </style:style>
+ <style:style style:name="OrgEquationTableColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+ <style:style style:name="OrgFirstEquationFirstColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="middle" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgEquationLastColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="middle" fo:padding="0.159cm" fo:border-top="none" fo:border-bottom="none" fo:border-left="none" fo:border-right="none"/>
+ </style:style>
+ <style:style style:name="OrgEquationFirstColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgEquationLastColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="end" style:justify-single-word="false"/>
+ </style:style>
+ <!-- END: Table styles for numbered equations -->
+
+ <!-- BEGIN: Custom Table Template -->
+ <style:style style:name="Custom" style:family="table">
+ <style:table-properties style:rel-width="80%" table:align="center"/>
+ </style:style>
+
+ <style:style style:name="CustomColumn" style:family="table-column">
+ <style:table-column-properties style:rel-column-width="1*"/>
+ </style:style>
+
+ <!-- Table Paragraph Styles -->
+ <style:style style:name="CustomTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomLastRowTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomLastColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#000000" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomFirstRowTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#ffffff" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <style:style style:name="CustomFirstColumnTableParagraph" style:family="paragraph" style:parent-style-name="Table_20_Contents">
+ <style:paragraph-properties fo:text-align="start" style:justify-single-word="false"/>
+ <style:text-properties fo:color="#ffffff" style:text-outline="false" style:text-line-through-style="none" style:font-name="Times New Roman" fo:font-size="12pt" fo:font-style="normal" fo:text-shadow="none" style:text-underline-style="none" fo:font-weight="normal" style:font-size-asian="12pt" style:font-style-asian="normal" style:font-weight-asian="normal" style:font-size-complex="12pt" style:font-style-complex="normal" style:font-weight-complex="normal" style:text-overline-style="none" style:text-overline-color="font-color"/>
+ </style:style>
+
+ <!-- Table Cell Styles -->
+ <style:style style:name="CustomTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#ffffff" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomFirstRowTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#000080" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomLastRowTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#cccccc" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomFirstColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#4d4d4d" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <style:style style:name="CustomLastColumnTableCell" style:family="table-cell">
+ <style:table-cell-properties style:vertical-align="top" fo:background-color="#cccccc" fo:padding="0.097cm" fo:border-left="0.002cm solid #000000" fo:border-right="0.002cm solid #000000" fo:border-top="0.002cm solid #000000" fo:border-bottom="0.002cm solid #000000">
+ <style:background-image/>
+ </style:table-cell-properties>
+ </style:style>
+
+ <!-- END: Custom Table Template -->
+
+ </office:automatic-styles>
+
+ <office:body>
+ <office:text>
+ <text:sequence-decls>
+ <text:sequence-decl text:display-outline-level="0" text:name="Illustration"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Table"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Text"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Drawing"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Equation"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Figure"/>
+ <text:sequence-decl text:display-outline-level="0" text:name="Listing"/>
+ </text:sequence-decls>
+ </office:text>
+ </office:body>
+</office:document-content>
diff --git a/etc/styles/OrgOdtStyles.xml b/etc/styles/OrgOdtStyles.xml
new file mode 100644
index 0000000..5dfcfa8
--- /dev/null
+++ b/etc/styles/OrgOdtStyles.xml
@@ -0,0 +1,797 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- See etc/org/README for copyright information -->
+<office:document-styles xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" xmlns:style="urn:oasis:names:tc:opendocument:xmlns:style:1.0" xmlns:text="urn:oasis:names:tc:opendocument:xmlns:text:1.0" xmlns:table="urn:oasis:names:tc:opendocument:xmlns:table:1.0" xmlns:draw="urn:oasis:names:tc:opendocument:xmlns:drawing:1.0" xmlns:fo="urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0" xmlns:number="urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0" xmlns:svg="urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0" xmlns:chart="urn:oasis:names:tc:opendocument:xmlns:chart:1.0" xmlns:dr3d="urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0" xmlns:math="http://www.w3.org/1998/Math/MathML" xmlns:form="urn:oasis:names:tc:opendocument:xmlns:form:1.0" xmlns:script="urn:oasis:names:tc:opendocument:xmlns:script:1.0" xmlns:ooo="http://openoffice.org/2004/office" xmlns:ooow="http://openoffice.org/2004/writer" xmlns:oooc="http://openoffice.org/2004/calc" xmlns:dom="http://www.w3.org/2001/xml-events" xmlns:rpt="http://openoffice.org/2005/report" xmlns:of="urn:oasis:names:tc:opendocument:xmlns:of:1.2" xmlns:xhtml="http://www.w3.org/1999/xhtml" xmlns:grddl="http://www.w3.org/2003/g/data-view#" office:version="1.2">
+ <office:font-face-decls>
+ <style:font-face style:name="OpenSymbol" svg:font-family="OpenSymbol"/>
+ <style:font-face style:name="Tahoma1" svg:font-family="Tahoma"/>
+ <style:font-face style:name="Courier New" svg:font-family="&apos;Courier New&apos;" style:font-family-generic="modern" style:font-pitch="fixed"/>
+ <style:font-face style:name="NSimSun" svg:font-family="NSimSun" style:font-family-generic="modern" style:font-pitch="fixed"/>
+ <style:font-face style:name="Times New Roman" svg:font-family="&apos;Times New Roman&apos;" style:font-family-generic="roman" style:font-pitch="variable"/>
+ <style:font-face style:name="Arial" svg:font-family="Arial" style:font-family-generic="swiss" style:font-pitch="variable"/>
+ <style:font-face style:name="SimSun" svg:font-family="SimSun" style:font-family-generic="system" style:font-pitch="variable"/>
+ <style:font-face style:name="Tahoma" svg:font-family="Tahoma" style:font-family-generic="system" style:font-pitch="variable"/>
+ </office:font-face-decls>
+ <office:styles>
+ <style:default-style style:family="graphic">
+ <style:graphic-properties draw:shadow-offset-x="0.3cm" draw:shadow-offset-y="0.3cm" draw:start-line-spacing-horizontal="0.283cm" draw:start-line-spacing-vertical="0.283cm" draw:end-line-spacing-horizontal="0.283cm" draw:end-line-spacing-vertical="0.283cm" style:flow-with-text="false"/>
+ <style:paragraph-properties style:text-autospace="ideograph-alpha" style:line-break="strict" style:writing-mode="lr-tb" style:font-independent-line-spacing="false">
+ <style:tab-stops/>
+ </style:paragraph-properties>
+ <style:text-properties style:use-window-font-color="true" fo:font-size="12pt" fo:language="en" fo:country="GB" style:letter-kerning="true" style:font-size-asian="12pt" style:language-asian="zh" style:country-asian="CN" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN"/>
+ </style:default-style>
+ <style:default-style style:family="paragraph">
+ <style:paragraph-properties fo:hyphenation-ladder-count="no-limit" style:text-autospace="ideograph-alpha" style:punctuation-wrap="hanging" style:line-break="strict" style:tab-stop-distance="1.251cm" style:writing-mode="page"/>
+ <style:text-properties style:use-window-font-color="true" style:font-name="Times New Roman" fo:font-size="12pt" fo:language="en" fo:country="GB" style:letter-kerning="true" style:font-name-asian="SimSun" style:font-size-asian="12pt" style:language-asian="zh" style:country-asian="CN" style:font-name-complex="Tahoma" style:font-size-complex="12pt" style:language-complex="hi" style:country-complex="IN" fo:hyphenate="false" fo:hyphenation-remain-char-count="2" fo:hyphenation-push-char-count="2"/>
+ </style:default-style>
+ <style:default-style style:family="table">
+ <style:table-properties table:border-model="collapsing"/>
+ </style:default-style>
+ <style:default-style style:family="table-row">
+ <style:table-row-properties fo:keep-together="auto"/>
+ </style:default-style>
+
+ <!-- Outline numbering -->
+ <text:outline-style style:name="OrgOutline">
+ <text:outline-level-style text:level="1" style:num-suffix=". " style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-0.762cm" fo:margin-left="0.762cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="2" style:num-suffix=". " style:num-format="1" text:display-levels="2">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.016cm" fo:margin-left="1.016cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="3" style:num-suffix=". " style:num-format="1" text:display-levels="3">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.27cm" fo:margin-left="1.27cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="4" style:num-suffix=". " style:num-format="1" text:display-levels="4">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.524cm" fo:margin-left="1.524cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="5" style:num-suffix=". " style:num-format="1" text:display-levels="5">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-1.778cm" fo:margin-left="1.778cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="6" style:num-suffix=". " style:num-format="1" text:display-levels="6">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.032cm" fo:margin-left="2.032cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="7" style:num-suffix=". " style:num-format="1" text:display-levels="7">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.286cm" fo:margin-left="2.286cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="8" style:num-suffix=". " style:num-format="1" text:display-levels="8">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.54cm" fo:margin-left="2.54cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="9" style:num-suffix=". " style:num-format="1" text:display-levels="9">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-2.794cm" fo:margin-left="2.794cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ <text:outline-level-style text:level="10" style:num-suffix=". " style:num-format="1" text:display-levels="10">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="nothing" fo:text-indent="-3.048cm" fo:margin-left="3.048cm"/>
+ </style:list-level-properties>
+ </text:outline-level-style>
+ </text:outline-style>
+
+ <style:style style:name="Standard" style:family="paragraph" style:class="text"/>
+ <style:style style:name="Heading" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-top="0.423cm" fo:margin-bottom="0.212cm" fo:keep-with-next="always"/>
+ <style:text-properties style:font-name="Arial" fo:font-size="14pt" style:font-name-asian="SimSun" style:font-size-asian="14pt" style:font-name-complex="Tahoma" style:font-size-complex="14pt"/>
+ </style:style>
+ <style:style style:name="Text_20_body" style:display-name="Text body" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.212cm"/>
+ </style:style>
+ <style:style style:name="List" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="list">
+ <style:text-properties style:font-name-complex="Tahoma1"/>
+ </style:style>
+ <style:style style:name="Caption" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
+ <style:paragraph-properties fo:margin-top="0.212cm" fo:margin-bottom="0.212cm" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="12pt" fo:font-style="italic" style:font-size-asian="12pt" style:font-style-asian="italic" style:font-name-complex="Tahoma1" style:font-size-complex="12pt" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Index" style:family="paragraph" style:parent-style-name="Standard" style:class="index">
+ <style:paragraph-properties text:number-lines="false" text:line-number="0"/>
+ <style:text-properties style:font-name-complex="Tahoma1"/>
+ </style:style>
+ <style:style style:name="Heading_20_1" style:display-name="Heading 1" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="1" style:class="text">
+ <style:text-properties fo:font-size="115%" fo:font-weight="bold" style:font-size-asian="115%" style:font-weight-asian="bold" style:font-size-complex="115%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_2" style:display-name="Heading 2" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="2" style:class="text">
+ <style:text-properties fo:font-size="14pt" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-style-complex="italic" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_3" style:display-name="Heading 3" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="3" style:class="text">
+ <style:text-properties fo:font-size="14pt" fo:font-weight="bold" style:font-size-asian="14pt" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_4" style:display-name="Heading 4" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="4" style:class="text">
+ <style:text-properties fo:font-size="85%" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="85%" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-style-complex="italic" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_5" style:display-name="Heading 5" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="5" style:class="text">
+ <style:text-properties fo:font-size="85%" fo:font-weight="bold" style:font-size-asian="85%" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_6" style:display-name="Heading 6" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="6" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_7" style:display-name="Heading 7" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="7" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_8" style:display-name="Heading 8" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="8" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_9" style:display-name="Heading 9" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="9" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_10" style:display-name="Heading 10" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="10" style:class="text">
+ <style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Heading_20_1.title" style:display-name="Heading 1.title" style:family="paragraph" style:parent-style-name="Heading_20_1">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Title" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Subtitle" style:class="chapter">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ <style:text-properties fo:font-size="18pt" fo:font-weight="bold" style:font-size-asian="18pt" style:font-weight-asian="bold" style:font-size-complex="18pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="OrgTitle" style:family="paragraph" style:parent-style-name="Title">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties fo:font-size="24pt"/>
+ </style:style>
+ <style:style style:name="Subtitle" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:class="chapter">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ <style:text-properties fo:font-size="14pt" fo:font-style="italic" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-size-complex="14pt" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="OrgSubtitle" style:family="paragraph" style:parent-style-name="Subtitle">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties fo:font-size="20pt"/>
+ </style:style>
+ <style:style style:name="Text_20_body_20_indent" style:display-name="Text body indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="List_20_Indent" style:display-name="List Indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="5.001cm" fo:margin-right="0cm" fo:text-indent="-4.5cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="0cm"/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="First_20_line_20_indent" style:display-name="First line indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0.499cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="Hanging_20_indent" style:display-name="Hanging indent" style:family="paragraph" style:parent-style-name="Text_20_body" style:class="text">
+ <style:paragraph-properties fo:margin-left="1cm" fo:margin-right="0cm" fo:text-indent="-0.499cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="0cm"/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Salutation" style:family="paragraph" style:parent-style-name="Standard" style:class="text">
+ <style:paragraph-properties text:number-lines="false" text:line-number="0"/>
+ </style:style>
+ <style:style style:name="Contents_20_Heading" style:display-name="Contents Heading" style:family="paragraph" style:parent-style-name="Heading" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="16pt" fo:font-weight="bold" style:font-size-asian="16pt" style:font-weight-asian="bold" style:font-size-complex="16pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Contents_20_1" style:display-name="Contents 1" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="17cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_2" style:display-name="Contents 2" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="16.501cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_3" style:display-name="Contents 3" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="0.998cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="16.002cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_4" style:display-name="Contents 4" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="1.498cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="15.503cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_5" style:display-name="Contents 5" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="1.997cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="15.004cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_6" style:display-name="Contents 6" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="2.496cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="14.504cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_7" style:display-name="Contents 7" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="2.995cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="14.005cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_8" style:display-name="Contents 8" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="3.494cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="13.506cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_9" style:display-name="Contents 9" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="3.993cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="13.007cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Contents_20_10" style:display-name="Contents 10" style:family="paragraph" style:parent-style-name="Index" style:class="index">
+ <style:paragraph-properties fo:margin-left="4.493cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false">
+ <style:tab-stops>
+ <style:tab-stop style:position="12.508cm" style:type="right" style:leader-style="dotted" style:leader-text="."/>
+ </style:tab-stops>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Quotations" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
+ <style:paragraph-properties fo:margin-left="1cm" fo:margin-right="1cm" fo:margin-top="0cm" fo:margin-bottom="0.499cm" fo:text-indent="0cm" style:auto-text-indent="false"/>
+ </style:style>
+ <style:style style:name="Preformatted_20_Text" style:display-name="Preformatted Text" style:family="paragraph" style:parent-style-name="Standard" style:class="html">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0cm"/>
+ <style:text-properties style:font-name="Courier New" fo:font-size="10pt" style:font-name-asian="NSimSun" style:font-size-asian="10pt" style:font-name-complex="Courier New" style:font-size-complex="10pt"/>
+ </style:style>
+ <style:style style:name="OrgVerse" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
+ <style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:paragraph-properties>
+ </style:style>
+
+ <style:style style:name="OrgFixedWidthBlock" style:family="paragraph" style:parent-style-name="Preformatted_20_Text">
+ <style:paragraph-properties fo:background-color="#c0c0c0" fo:padding="0.049cm" fo:border="0.018cm solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:paragraph-properties>
+ </style:style>
+
+ <style:style style:name="OrgFixedWidthBlockLastLine" style:family="paragraph" style:parent-style-name="OrgFixedWidthBlock">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
+ </style:style>
+
+ <style:style style:name="OrgSrcBlockLastLine" style:family="paragraph" style:parent-style-name="OrgSrcBlock">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.21cm"/>
+ </style:style>
+
+ <style:style style:name="OrgCenter" style:family="paragraph" style:parent-style-name="Text_20_body">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContents" style:family="paragraph" style:parent-style-name="Text_20_body"/>
+ <style:style style:name="OrgTableHeading" style:family="paragraph" style:parent-style-name="OrgTableContents" style:class="extra">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>
+ </style:style>
+
+ <style:style style:name="OrgTableHeadingLeft" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="left" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableHeadingRight" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="right" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableHeadingCenter" style:family="paragraph" style:parent-style-name="OrgTableHeading">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+
+ <style:style style:name="OrgTableContentsLeft" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="left" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContentsRight" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="right" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="OrgTableContentsCenter" style:family="paragraph" style:parent-style-name="OrgTableContents">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Text_20_body_20_bold" style:display-name="Text body bold" style:family="paragraph" style:parent-style-name="Text_20_body" style:next-style-name="Text_20_body">
+ <style:text-properties fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="Footnote" style:family="paragraph" style:parent-style-name="Standard" style:class="extra">
+ <style:paragraph-properties fo:margin-left="0.499cm" fo:margin-right="0cm" fo:text-indent="-0.499cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="10pt" style:font-size-asian="10pt" style:font-size-complex="10pt"/>
+ </style:style>
+ <style:style style:name="Figure" style:family="paragraph" style:parent-style-name="Caption"/>
+ <style:style style:name="Illustration_20_Index_20_Heading" style:display-name="Illustration Index Heading" style:family="paragraph" style:parent-style-name="Heading" style:class="index">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" text:number-lines="false" text:line-number="0"/>
+ <style:text-properties fo:font-size="16pt" fo:font-weight="bold" style:font-size-asian="16pt" style:font-weight-asian="bold" style:font-size-complex="16pt" style:font-weight-complex="bold"/>
+ </style:style>
+ <style:style style:name="Table" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:style style:name="Listing" style:family="paragraph" style:parent-style-name="Caption" style:class="extra">
+ <style:paragraph-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:text-indent="0cm" style:auto-text-indent="false" fo:keep-with-next="always">
+ <style:tab-stops/>
+ </style:paragraph-properties>
+ </style:style>
+ <style:style style:name="Horizontal_20_Line" style:display-name="Horizontal Line" style:family="paragraph" style:parent-style-name="Standard" style:next-style-name="Text_20_body" style:class="html">
+ <style:paragraph-properties fo:margin-top="0cm" fo:margin-bottom="0.499cm" style:border-line-width-bottom="0.002cm 0.035cm 0.002cm" fo:padding="0cm" fo:border-left="none" fo:border-right="none" fo:border-top="none" fo:border-bottom="0.039cm double #808080" text:number-lines="false" text:line-number="0" style:join-border="false"/>
+ <style:text-properties fo:font-size="6pt" style:font-size-asian="6pt" style:font-size-complex="6pt"/>
+ </style:style>
+ <style:style style:name="Emphasis" style:family="text">
+ <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Underline" style:family="text">
+ <style:text-properties style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" fo:background-color="transparent"/>
+ </style:style>
+ <style:style style:name="Strikethrough" style:family="text">
+ <style:text-properties style:text-line-through-style="solid"/>
+ </style:style>
+ <style:style style:name="Source_20_Text" style:display-name="Source Text" style:family="text">
+ <style:text-properties style:font-name="Courier New" fo:background-color="transparent" style:font-name-asian="NSimSun" style:font-name-complex="Courier New"/>
+ </style:style>
+ <style:style style:name="Citation" style:family="text">
+ <style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic"/>
+ </style:style>
+ <style:style style:name="Example" style:family="text">
+ <style:text-properties style:font-name="Courier New" fo:background-color="transparent" style:font-name-asian="NSimSun" style:font-name-complex="Courier New"/>
+ </style:style>
+ <style:style style:name="OrgCode" style:family="text" style:parent-style-name="Source_20_Text"/>
+
+ <!-- BEGIN: Org Agenda Styles -->
+ <style:style style:name="OrgTodo" style:family="text">
+ <style:text-properties fo:color="#ff0000"/>
+ </style:style>
+ <style:style style:name="OrgDone" style:family="text">
+ <style:text-properties fo:color="#008000"/>
+ </style:style>
+ <style:style style:name="OrgTag" style:family="text">
+ <style:text-properties fo:background-color="#add8e6"/>
+ </style:style>
+ <style:style style:name="OrgTimestamp" style:family="text">
+ <style:text-properties fo:color="#bebebe"/>
+ </style:style>
+ <style:style style:name="OrgTimestampKeyword" style:family="text">
+ <style:text-properties fo:color="#5f9ea0"/>
+ </style:style>
+ <style:style style:name="OrgTimestampWrapper" style:family="text"/>
+ <style:style style:name="OrgTarget" style:family="text"/>
+ <!-- END: Org Agenda Styles -->
+
+ <style:style style:name="Bold" style:family="text">
+ <style:text-properties fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="Numbering_20_Symbols" style:display-name="Numbering Symbols" style:family="text"/>
+ <style:style style:name="Footnote_20_Symbol" style:display-name="Footnote Symbol" style:family="text"/>
+ <style:style style:name="Footnote_20_anchor" style:display-name="Footnote anchor" style:family="text">
+ <style:text-properties style:text-position="super 58%"/>
+ </style:style>
+ <style:style style:name="OrgSuperscript" style:family="text">
+ <style:text-properties style:text-position="super 58%"/>
+ </style:style>
+ <style:style style:name="OrgSubscript" style:family="text">
+ <style:text-properties style:text-position="sub 58%"/>
+ </style:style>
+ <style:style style:name="Internet_20_link" style:display-name="Internet link" style:family="text">
+ <style:text-properties fo:color="#000080" fo:language="zxx" fo:country="none" style:text-underline-style="solid" style:text-underline-width="auto" style:text-underline-color="font-color" style:language-asian="zxx" style:country-asian="none" style:language-complex="zxx" style:country-complex="none"/>
+ </style:style>
+ <style:style style:name="Graphics" style:family="graphic">
+ <style:graphic-properties text:anchor-type="paragraph" svg:x="0cm" svg:y="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+ <style:style style:name="Frame" style:family="graphic">
+ <style:graphic-properties text:anchor-type="paragraph" svg:x="0cm" svg:y="0cm" fo:margin-left="0.201cm" fo:margin-right="0.201cm" fo:margin-top="0.201cm" fo:margin-bottom="0.201cm" style:wrap="parallel" style:number-wrapped-paragraphs="no-limit" style:wrap-contour="false" style:vertical-pos="top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:padding="0.15cm" fo:border="0.002cm solid #000000"/>
+ </style:style>
+
+ <!-- Simple Images -->
+ <style:style style:name="OrgDisplayImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="paragraph" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+
+ <style:style style:name="OrgPageImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="page" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" style:shadow="none" style:mirror="none" fo:clip="rect(0cm, 0cm, 0cm, 0cm)" draw:luminance="0%" draw:contrast="0%" draw:red="0%" draw:green="0%" draw:blue="0%" draw:gamma="100%" draw:color-inversion="false" draw:image-opacity="100%" draw:color-mode="standard">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <!-- Captioned Images -->
+ <style:style style:name="OrgCaptionedImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties style:rel-width="100%" text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:run-through="foreground" style:wrap="none" style:vertical-pos="from-top" style:vertical-rel="paragraph-content" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none" style:shadow="none"/>
+ </style:style>
+
+ <style:style style:name="OrgImageCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph" style:horizontal-pos="center" style:horizontal-rel="paragraph" fo:padding="0cm" fo:border="none"/>
+ </style:style>
+
+ <style:style style:name="OrgPageImageCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties text:anchor-type="paragraph" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.21cm" fo:margin-bottom="0.21cm" style:wrap="none" style:vertical-pos="middle" style:vertical-rel="page" style:horizontal-pos="center" style:horizontal-rel="page" fo:background-color="transparent" style:background-transparency="100%" fo:padding="0cm" fo:border="none" style:shadow="none">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <!-- Inlined Images -->
+ <style:style style:name="OrgInlineImage" style:family="graphic" style:parent-style-name="Graphics">
+ <style:graphic-properties text:anchor-type="as-char" style:vertical-pos="top" style:vertical-rel="baseline" style:horizontal-pos="center" style:horizontal-rel="paragraph"/>
+ </style:style>
+
+ <!-- Inline Formula -->
+ <style:style style:name="OrgFormula" style:family="graphic">
+ <style:graphic-properties text:anchor-type="as-char" svg:y="0cm" fo:margin-left="0.201cm" fo:margin-right="0.201cm" style:vertical-pos="middle" style:vertical-rel="text" style:shadow="none"/>
+ </style:style>
+
+ <style:style style:name="OrgInlineFormula" style:family="graphic" style:parent-style-name="Formula">
+ <style:graphic-properties text:anchor-type="as-char" fo:margin-left="0.201cm" fo:margin-right="0.201cm" style:vertical-pos="middle" style:vertical-rel="text"/>
+ </style:style>
+
+ <style:style style:name="OrgInlineFormula" style:family="graphic" style:parent-style-name="Formula">
+ <style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <style:style style:name="OrgDisplayFormula" style:family="graphic" style:parent-style-name="OrgFormula">
+ <style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <style:style style:name="OrgFormulaCaptionFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties fo:margin-top="0cm" fo:margin-bottom="0cm" style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="from-left" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none"/>
+ </style:style>
+
+ <style:style style:name="OrgCaptionedFormula" style:family="graphic" style:parent-style-name="OrgFormula">
+ <style:graphic-properties fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0cm" fo:margin-bottom="0cm" style:run-through="foreground" style:wrap="none" style:vertical-pos="from-top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:padding="0cm" fo:border="none" style:shadow="none" draw:ole-draw-aspect="1"/>
+ </style:style>
+
+ <!-- Inline Tasks -->
+ <style:style style:name="OrgInlineTaskHeading" style:family="paragraph" style:parent-style-name="Caption" style:next-style-name="Text_20_body">
+ <style:text-properties style:font-name="Arial1" fo:font-style="normal" fo:font-weight="bold"/>
+ </style:style>
+ <style:style style:name="OrgInlineTaskFrame" style:family="graphic" style:parent-style-name="Frame">
+ <style:graphic-properties svg:x="0cm" svg:y="0cm" style:wrap="none" style:vertical-pos="top" style:vertical-rel="paragraph-content" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" fo:background-color="#ffffcc" style:background-transparency="0%" fo:padding="0.15cm" fo:border="0.26pt solid #000000" style:shadow="none">
+ <style:background-image/>
+ </style:graphic-properties>
+ </style:style>
+
+ <text:list-style style:name="Numbering_20_1" style:display-name="Numbering 1">
+ <text:list-level-style-number text:level="1" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.499cm" fo:text-indent="-0.499cm" fo:margin-left="0.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1cm" fo:text-indent="-0.499cm" fo:margin-left="1cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.499cm" fo:text-indent="-0.499cm" fo:margin-left="1.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2cm" fo:text-indent="-0.499cm" fo:margin-left="2cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.499cm" fo:text-indent="-0.499cm" fo:margin-left="2.499cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3cm" fo:text-indent="-0.499cm" fo:margin-left="3cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.5cm" fo:text-indent="-0.499cm" fo:margin-left="3.5cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.001cm" fo:text-indent="-0.499cm" fo:margin-left="4.001cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.5cm" fo:text-indent="-0.499cm" fo:margin-left="4.5cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" text:style-name="Numbering_20_Symbols" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="5.001cm" fo:text-indent="-0.499cm" fo:margin-left="5.001cm"/>
+ </style:list-level-properties>
+ </text:list-level-style-number>
+ </text:list-style>
+ <text:list-style style:name="List_20_1" style:display-name="List 1">
+ <text:list-level-style-bullet text:level="1" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.4cm" fo:text-indent="-0.4cm" fo:margin-left="0.4cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="2" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="0.801cm" fo:text-indent="-0.4cm" fo:margin-left="0.801cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="3" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.199cm" fo:text-indent="-0.4cm" fo:margin-left="1.199cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="4" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="1.6cm" fo:text-indent="-0.4cm" fo:margin-left="1.6cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="5" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2cm" fo:text-indent="-0.4cm" fo:margin-left="2cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="6" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.401cm" fo:text-indent="-0.4cm" fo:margin-left="2.401cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="7" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="2.799cm" fo:text-indent="-0.4cm" fo:margin-left="2.799cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="8" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.2cm" fo:text-indent="-0.4cm" fo:margin-left="3.2cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="9" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="3.6cm" fo:text-indent="-0.4cm" fo:margin-left="3.6cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="10" text:style-name="Numbering_20_Symbols" text:bullet-char="•">
+ <style:list-level-properties text:list-level-position-and-space-mode="label-alignment">
+ <style:list-level-label-alignment text:label-followed-by="listtab" text:list-tab-stop-position="4.001cm" fo:text-indent="-0.4cm" fo:margin-left="4.001cm"/>
+ </style:list-level-properties>
+ <style:text-properties style:font-name="OpenSymbol"/>
+ </text:list-level-style-bullet>
+ </text:list-style>
+
+ <!-- Numbered List -->
+ <text:list-style style:name="OrgNumberedList">
+ <text:list-level-style-number text:level="1" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-suffix="." style:num-format="1">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <!-- Bulleted List -->
+ <text:list-style style:name="OrgBulletedList">
+ <text:list-level-style-bullet text:level="1" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="2" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="3" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="4" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="5" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="6" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="7" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="8" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="9" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ <text:list-level-style-bullet text:level="10" text:style-name="Bullet_20_Symbols" style:num-suffix="." text:bullet-char="•">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm"/>
+ <style:text-properties fo:font-family="StarSymbol" style:font-charset="x-symbol"/>
+ </text:list-level-style-bullet>
+ </text:list-style>
+
+ <!-- Description List -->
+ <text:list-style style:name="OrgDescriptionList">
+ <text:list-level-style-number text:level="1" style:num-format="">
+ <style:list-level-properties text:space-before="0.635cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-format="">
+ <style:list-level-properties text:space-before="1.27cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-format="">
+ <style:list-level-properties text:space-before="1.905cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-format="">
+ <style:list-level-properties text:space-before="2.54cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-format="">
+ <style:list-level-properties text:space-before="3.175cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-format="">
+ <style:list-level-properties text:space-before="3.81cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-format="">
+ <style:list-level-properties text:space-before="4.445cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-format="">
+ <style:list-level-properties text:space-before="5.08cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-format="">
+ <style:list-level-properties text:space-before="5.715cm"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-format="">
+ <style:list-level-properties text:space-before="6.35cm"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <text:list-style style:name="OrgSrcBlockNumberedLine">
+ <text:list-level-style-number text:level="1" style:num-format="1">
+ <style:list-level-properties text:space-before="0.635cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="2" style:num-format="1">
+ <style:list-level-properties text:space-before="1.27cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="3" style:num-format="1">
+ <style:list-level-properties text:space-before="1.905cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="4" style:num-format="1">
+ <style:list-level-properties text:space-before="2.54cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="5" style:num-format="1">
+ <style:list-level-properties text:space-before="3.175cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="6" style:num-format="1">
+ <style:list-level-properties text:space-before="3.81cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="7" style:num-format="1">
+ <style:list-level-properties text:space-before="4.445cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="8" style:num-format="1">
+ <style:list-level-properties text:space-before="5.08cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="9" style:num-format="1">
+ <style:list-level-properties text:space-before="5.715cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ <text:list-level-style-number text:level="10" style:num-format="1">
+ <style:list-level-properties text:space-before="6.35cm" text:min-label-width="0.635cm" text:min-label-distance="0.101cm" fo:text-align="end"/>
+ </text:list-level-style-number>
+ </text:list-style>
+
+ <text:notes-configuration text:note-class="footnote" text:citation-style-name="Footnote_20_Symbol" text:citation-body-style-name="Footnote_20_anchor" style:num-format="1" text:start-value="0" text:footnotes-position="page" text:start-numbering-at="document"/>
+ <text:notes-configuration text:note-class="endnote" style:num-format="i" text:start-value="0"/>
+ <text:linenumbering-configuration text:number-lines="false" text:offset="0.499cm" style:num-format="1" text:number-position="left" text:increment="5"/>
+ </office:styles>
+ <office:automatic-styles>
+ <style:style style:name="MP1" style:family="paragraph" style:parent-style-name="Footer">
+ <style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
+ </style:style>
+ <style:page-layout style:name="Mpm1" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="none" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm2">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style/>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm3" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="i" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm4" style:page-usage="right">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" fo:background-color="transparent" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:background-image/>
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ <style:page-layout style:name="Mpm5" style:page-usage="mirrored">
+ <style:page-layout-properties fo:page-width="21.001cm" fo:page-height="29.7cm" style:num-format="1" style:print-orientation="portrait" fo:margin-top="2cm" fo:margin-bottom="2cm" fo:margin-left="2cm" fo:margin-right="2cm" style:writing-mode="lr-tb" style:footnote-max-height="0cm">
+ <style:footnote-sep style:width="0.018cm" style:distance-before-sep="0.101cm" style:distance-after-sep="0.101cm" style:line-style="solid" style:adjustment="left" style:rel-width="25%" style:color="#000000"/>
+ </style:page-layout-properties>
+ <style:header-style/>
+ <style:footer-style>
+ <style:header-footer-properties fo:min-height="0.6cm" fo:margin-left="0cm" fo:margin-right="0cm" fo:margin-top="0.499cm" style:dynamic-spacing="false"/>
+ </style:footer-style>
+ </style:page-layout>
+ </office:automatic-styles>
+ <office:master-styles>
+ <style:master-page style:name="Standard" style:page-layout-name="Mpm1">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"></text:page-number></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgTitlePage" style:page-layout-name="Mpm2" style:next-style-name="OrgFrontMatterPage"/>
+ <style:master-page style:name="OrgFrontMatterPage" style:page-layout-name="Mpm3">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgFirstPage" style:page-layout-name="Mpm4" style:next-style-name="OrgPage">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ <style:master-page style:name="OrgPage" style:page-layout-name="Mpm5">
+ <style:footer>
+ <text:p text:style-name="MP1"><text:page-number text:select-page="current"/></text:p>
+ </style:footer>
+ </style:master-page>
+ </office:master-styles>
+</office:document-styles>
diff --git a/etc/styles/README b/etc/styles/README
new file mode 100644
index 0000000..206f3a2
--- /dev/null
+++ b/etc/styles/README
@@ -0,0 +1,36 @@
+The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the
+following copyright information:
+
+Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+These files are 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/>.
+
+
+Author: Jambunathan K <kjambunathan at gmail dot com>
+Keywords: outlines, hypermedia, calendar, wp
+Homepage: http://orgmode.org
+
+Commentary:
+
+These files are part of Org-mode's OpenDocument export module.
+
+OrgOdtContentTemplate.xml provides a template within which the content
+of an exported document is enclosed. This file contributes to
+"content.xml" file within an exported document and acts as a
+repository of automatic styles.
+
+OrgOdtStyles.xml contributes to "styles.xml" file within an exported
+document and acts as a repository of custom styles.
diff --git a/lisp/Makefile b/lisp/Makefile
new file mode 100644
index 0000000..4bc86d4
--- /dev/null
+++ b/lisp/Makefile
@@ -0,0 +1,86 @@
+.NOTPARALLEL: # always run this make serially
+.SUFFIXES: # we don't need default suffix rules
+ifeq ($(MAKELEVEL), 0)
+ $(error This make needs to be started as a sub-make from the toplevel directory.)
+endif
+
+LISPV = org-version.el
+LISPI = org-install.el
+LISPA = $(LISPV) $(LISPI)
+LISPF = $(filter-out $(LISPA),$(sort $(wildcard *.el)))
+LISPC = $(filter-out $(LISPN:%el=%elc),$(LISPF:%el=%elc))
+_ORGCM_ = dirall single source slint1 slint2
+-include local.mk
+
+.PHONY: all compile compile-dirty \
+ $(_ORGCM_) $(_ORGCM_:%=compile-%) \
+ autoloads addcontrib \
+ install clean cleanauto cleanall cleanelc clean-install
+
+# do not clean here, done in toplevel make
+all compile compile-dirty:: autoloads
+ifeq ($(filter-out $(_ORGCM_),$(ORGCM)),)
+ $(MAKE) compile-$(ORGCM)
+else
+ $(error ORGCM has illegal value $(ORGCM) (valid: $(_ORGCM_)))
+endif
+
+compile-dirall: dirall
+compile-single: single $(LISPC)
+compile-source: source dirall
+compile-slint1: dirall slint1
+compile-slint2: source dirall slint1
+
+# internal
+dirall:
+ @$(info ==================== $@ ====================)
+ @$(ELCDIR)
+single:
+ @$(info ==================== $@ ====================)
+source: cleanelc
+ @$(info ==================== $@ ====================)
+ @$(foreach elc,$(LISPC),$(MAKE) $(elc) && $(RM) $(elc);)
+slint1:
+ @$(info ==================== $@ ====================)
+ @$(foreach elc,$(LISPC),$(RM) $(elc); $(MAKE) $(elc);)
+
+%.elc: %.el
+ @$(info Compiling single $(abspath $<)...)
+ -@$(ELC) $<
+
+addcontrib:
+ifneq ($(ORG_ADD_CONTRIB),)
+ $(CP) $(wildcard \
+ $(addsuffix .el, \
+ $(addprefix ../contrib/lisp/, \
+ $(basename \
+ $(notdir $(ORG_ADD_CONTRIB)))))) .
+endif
+
+autoloads: cleanauto addcontrib $(LISPI) $(LISPV)
+
+$(LISPV): $(LISPF)
+ @echo "org-version: $(ORGVERSION) ($(GITVERSION))"
+ @$(RM) $(@)
+ @$(MAKE_ORG_VERSION)
+
+$(LISPI): $(LISPV) $(LISPF)
+ @echo "org-install: $(ORGVERSION) ($(GITVERSION))"
+ @$(RM) $(@)
+ @$(MAKE_ORG_INSTALL)
+
+install: $(LISPF) compile
+ if [ ! -d $(DESTDIR)$(lispdir) ] ; then \
+ $(MKDIR) $(DESTDIR)$(lispdir) ; \
+ fi ;
+ $(CP) $(LISPC) $(LISPF) $(LISPA) $(DESTDIR)$(lispdir)
+
+cleanauto clean cleanall::
+ $(RM) $(LISPA) $(LISPA:%el=%elc)
+clean cleanall cleanelc::
+ $(RM) *.elc
+
+clean-install:
+ if [ -d $(DESTDIR)$(lispdir) ] ; then \
+ $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* ; \
+ fi ;
diff --git a/lisp/ob-C.el b/lisp/ob-C.el
new file mode 100644
index 0000000..ba50722
--- /dev/null
+++ b/lisp/ob-C.el
@@ -0,0 +1,195 @@
+;;; ob-C.el --- org-babel functions for C and similar languages
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating C code.
+;;
+;; very limited implementation:
+;; - currently only support :results output
+;; - not much in the way of error feedback
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'cc-mode)
+
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
+
+(defvar org-babel-default-header-args:C '())
+
+(defvar org-babel-C-compiler "gcc"
+ "Command used to compile a C source code file into an
+ executable.")
+
+(defvar org-babel-C++-compiler "g++"
+ "Command used to compile a C++ source code file into an
+ executable.")
+
+(defvar org-babel-c-variant nil
+ "Internal variable used to hold which type of C (e.g. C or C++)
+is currently being evaluated.")
+
+(defun org-babel-execute:cpp (body params)
+ "Execute BODY according to PARAMS. This function calls
+`org-babel-execute:C++'."
+ (org-babel-execute:C++ body params))
+
+(defun org-babel-execute:C++ (body params)
+ "Execute a block of C++ code with org-babel. This function is
+called by `org-babel-execute-src-block'."
+ (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
+
+(defun org-babel-expand-body:C++ (body params)
+ "Expand a block of C++ code with org-babel according to it's
+header arguments (calls `org-babel-C-expand')."
+ (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
+
+(defun org-babel-execute:C (body params)
+ "Execute a block of C code with org-babel. This function is
+called by `org-babel-execute-src-block'."
+ (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
+
+(defun org-babel-expand-body:c (body params)
+ "Expand a block of C code with org-babel according to it's
+header arguments (calls `org-babel-C-expand')."
+ (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params)))
+
+(defun org-babel-C-execute (body params)
+ "This function should only be called by `org-babel-execute:C'
+or `org-babel-execute:C++'."
+ (let* ((tmp-src-file (org-babel-temp-file
+ "C-src-"
+ (cond
+ ((equal org-babel-c-variant 'c) ".c")
+ ((equal org-babel-c-variant 'cpp) ".cpp"))))
+ (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
+ (cmdline (cdr (assoc :cmdline params)))
+ (flags (cdr (assoc :flags params)))
+ (full-body (org-babel-C-expand body params))
+ (compile
+ (progn
+ (with-temp-file tmp-src-file (insert full-body))
+ (org-babel-eval
+ (format "%s -o %s %s %s"
+ (cond
+ ((equal org-babel-c-variant 'c) org-babel-C-compiler)
+ ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler))
+ (org-babel-process-file-name tmp-bin-file)
+ (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-src-file)) ""))))
+ ((lambda (results)
+ (org-babel-reassemble-table
+ (if (member "vector" (cdr (assoc :result-params params)))
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))
+ (org-babel-read results))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+
+(defun org-babel-C-expand (body params)
+ "Expand a block of C or C++ code with org-babel according to
+it's header arguments."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (includes (or (cdr (assoc :includes params))
+ (org-babel-read (org-entry-get nil "includes" t))))
+ (defines (org-babel-read
+ (or (cdr (assoc :defines params))
+ (org-babel-read (org-entry-get nil "defines" t))))))
+ (mapconcat 'identity
+ (list
+ ;; includes
+ (mapconcat
+ (lambda (inc) (format "#include %s" inc))
+ (if (listp includes) includes (list includes)) "\n")
+ ;; defines
+ (mapconcat
+ (lambda (inc) (format "#define %s" inc))
+ (if (listp defines) defines (list defines)) "\n")
+ ;; variables
+ (mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; body
+ (if main-p
+ (org-babel-C-ensure-main-wrap body)
+ body) "\n") "\n")))
+
+(defun org-babel-C-ensure-main-wrap (body)
+ "Wrap body in a \"main\" function call if none exists."
+ (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
+ body
+ (format "int main() {\n%s\nreturn(0);\n}\n" body)))
+
+(defun org-babel-prep-session:C (session params)
+ "This function does nothing as C is a compiled language with no
+support for sessions"
+ (error "C is a compiled languages -- no support for sessions"))
+
+(defun org-babel-load-session:C (session body params)
+ "This function does nothing as C is a compiled language with no
+support for sessions"
+ (error "C is a compiled languages -- no support for sessions"))
+
+;; helper functions
+
+(defun org-babel-C-var-to-C (pair)
+ "Convert an elisp val into a string of C code specifying a var
+of the same value."
+ ;; TODO list support
+ (let ((var (car pair))
+ (val (cdr pair)))
+ (when (symbolp val)
+ (setq val (symbol-name val))
+ (when (= (length val) 1)
+ (setq val (string-to-char val))))
+ (cond
+ ((integerp val)
+ (format "int %S = %S;" var val))
+ ((floatp val)
+ (format "double %S = %S;" var val))
+ ((or (integerp val))
+ (format "char %S = '%S';" var val))
+ ((stringp val)
+ (format "char %S[%d] = \"%s\";"
+ var (+ 1 (length val)) val))
+ (t
+ (format "u32 %S = %S;" var val)))))
+
+
+(provide 'ob-C)
+
+
+
+;;; ob-C.el ends here
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
new file mode 100644
index 0000000..3dedb39
--- /dev/null
+++ b/lisp/ob-R.el
@@ -0,0 +1,375 @@
+;;; ob-R.el --- org-babel functions for R code evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research, R, statistics
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating R code
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function orgtbl-to-tsv "org-table" (table params))
+(declare-function R "ext:essd-r" (&optional start-args))
+(declare-function inferior-ess-send-input "ext:ess-inf" ())
+(declare-function ess-make-buffer-current "ext:ess-inf" ())
+(declare-function ess-eval-buffer "ext:ess-inf" (vis))
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-remove-if-not "org" (predicate seq))
+
+(defconst org-babel-header-args:R
+ '((width . :any)
+ (height . :any)
+ (bg . :any)
+ (units . :any)
+ (pointsize . :any)
+ (antialias . :any)
+ (quality . :any)
+ (compression . :any)
+ (res . :any)
+ (type . :any)
+ (family . :any)
+ (title . :any)
+ (fonts . :any)
+ (version . :any)
+ (paper . :any)
+ (encoding . :any)
+ (pagecentre . :any)
+ (colormodel . :any)
+ (useDingbats . :any)
+ (horizontal . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw org html latex code pp wrap)
+ (replace silent append prepend)
+ (output value graphics))))
+ "R-specific header arguments.")
+
+(defvar org-babel-default-header-args:R '())
+
+(defcustom org-babel-R-command "R --slave --no-save"
+ "Name of command to use for executing R code."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defvar ess-local-process-name) ; dynamically scoped
+(defun org-babel-edit-prep:R (info)
+ (let ((session (cdr (assoc :session (nth 2 info)))))
+ (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
+ (save-match-data (org-babel-R-initiate-session session nil)))))
+
+(defun org-babel-expand-body:R (body params &optional graphics-file)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((graphics-file
+ (or graphics-file (org-babel-R-graphical-output-file params))))
+ (mapconcat
+ #'identity
+ ((lambda (inside)
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "dev.off()"))
+ inside))
+ (append (org-babel-variable-assignments:R params)
+ (list body))) "\n")))
+
+(defun org-babel-execute:R (body params)
+ "Execute a block of R code.
+This function is called by `org-babel-execute-src-block'."
+ (save-excursion
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (session (org-babel-R-initiate-session
+ (cdr (assoc :session params)) params))
+ (colnames-p (cdr (assoc :colnames params)))
+ (rownames-p (cdr (assoc :rownames params)))
+ (graphics-file (org-babel-R-graphical-output-file params))
+ (full-body (org-babel-expand-body:R body params graphics-file))
+ (result
+ (org-babel-R-evaluate
+ session full-body result-type result-params
+ (or (equal "yes" colnames-p)
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) colnames-p))
+ (or (equal "yes" rownames-p)
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) rownames-p)))))
+ (if graphics-file nil result))))
+
+(defun org-babel-prep-session:R (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-R-initiate-session session params))
+ (var-lines (org-babel-variable-assignments:R params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:R (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:R session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:R (params)
+ "Return list of R statements assigning the block's variables."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapcar
+ (lambda (pair)
+ (org-babel-R-assign-elisp
+ (car pair) (cdr pair)
+ (equal "yes" (cdr (assoc :colnames params)))
+ (equal "yes" (cdr (assoc :rownames params)))))
+ (mapcar
+ (lambda (i)
+ (cons (car (nth i vars))
+ (org-babel-reassemble-table
+ (cdr (nth i vars))
+ (cdr (nth i (cdr (assoc :colname-names params))))
+ (cdr (nth i (cdr (assoc :rowname-names params)))))))
+ (org-number-sequence 0 (1- (length vars)))))))
+
+(defun org-babel-R-quote-tsv-field (s)
+ "Quote field S for export to R."
+ (if (stringp s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
+ (format "%S" s)))
+
+(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
+ "Construct R code assigning the elisp VALUE to a variable named NAME."
+ (if (listp value)
+ (let ((max (apply #'max (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (min (apply #'min (mapcar #'length (org-remove-if-not
+ #'sequencep value))))
+ (transition-file (org-babel-temp-file "R-import-")))
+ ;; ensure VALUE has an orgtbl structure (depth of at least 2)
+ (unless (listp (car value)) (setq value (list value)))
+ (with-temp-file transition-file
+ (insert
+ (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))
+ "\n"))
+ (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (header (if (or (eq (nth 1 value) 'hline) colnames-p)
+ "TRUE" "FALSE"))
+ (row-names (if rownames-p "1" "NULL")))
+ (if (= max min)
+ (format "%s <- read.table(\"%s\",
+ header=%s,
+ row.names=%s,
+ sep=\"\\t\",
+ as.is=TRUE)" name file header row-names)
+ (format "%s <- read.table(\"%s\",
+ header=%s,
+ row.names=%s,
+ sep=\"\\t\",
+ as.is=TRUE,
+ fill=TRUE,
+ col.names = paste(\"V\", seq_len(%d), sep =\"\"))"
+ name file header row-names max))))
+ (format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
+
+(defvar ess-ask-for-ess-directory) ; dynamically scoped
+(defun org-babel-R-initiate-session (session params)
+ "If there is not a current R process then create one."
+ (unless (string= session "none")
+ (let ((session (or session "*R*"))
+ (ess-ask-for-ess-directory
+ (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
+ (not (cdr (assoc :dir params))))))
+ (if (org-babel-comint-buffer-livep session)
+ session
+ (save-window-excursion
+ (require 'ess) (R)
+ (rename-buffer
+ (if (bufferp session)
+ (buffer-name session)
+ (if (stringp session)
+ session
+ (buffer-name))))
+ (current-buffer))))))
+
+(defun org-babel-R-associate-session (session)
+ "Associate R code buffer with an R session.
+Make SESSION be the inferior ESS process associated with the
+current code buffer."
+ (setq ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-make-buffer-current))
+
+(defun org-babel-R-graphical-output-file (params)
+ "Name of file to which R should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(defun org-babel-R-construct-graphics-device-call (out-file params)
+ "Construct the call to the graphics device."
+ (let ((devices
+ '((:bmp . "bmp")
+ (:jpg . "jpeg")
+ (:jpeg . "jpeg")
+ (:tex . "tikz")
+ (:tiff . "tiff")
+ (:png . "png")
+ (:svg . "svg")
+ (:pdf . "pdf")
+ (:ps . "postscript")
+ (:postscript . "postscript")))
+ (allowed-args '(:width :height :bg :units :pointsize
+ :antialias :quality :compression :res
+ :type :family :title :fonts :version
+ :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
+ (match-string 1 out-file)))
+ (extra-args (cdr (assq :R-dev-args params))) filearg args)
+ (setq device (or (and device (cdr (assq (intern (concat ":" device))
+ devices))) "png"))
+ (setq filearg
+ (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename"))
+ (setq args (mapconcat
+ (lambda (pair)
+ (if (member (car pair) allowed-args)
+ (format ",%s=%S"
+ (substring (symbol-name (car pair)) 1)
+ (cdr pair)) ""))
+ params ""))
+ (format "%s(%s=\"%s\"%s%s%s)"
+ device filearg out-file args
+ (if extra-args "," "") (or extra-args ""))))
+
+(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
+(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
+
+(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
+
+(defun org-babel-R-evaluate
+ (session body result-type result-params column-names-p row-names-p)
+ "Evaluate R code in BODY."
+ (if session
+ (org-babel-R-evaluate-session
+ session body result-type result-params column-names-p row-names-p)
+ (org-babel-R-evaluate-external-process
+ body result-type result-params column-names-p row-names-p)))
+
+(defun org-babel-R-evaluate-external-process
+ (body result-type result-params column-names-p row-names-p)
+ "Evaluate BODY in external R process.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (case result-type
+ (value
+ (let ((tmp-file (org-babel-temp-file "R-")))
+ (org-babel-eval org-babel-R-command
+ (format org-babel-R-write-object-command
+ (if row-names-p "TRUE" "FALSE")
+ (if column-names-p
+ (if row-names-p "NA" "TRUE")
+ "FALSE")
+ (format "{function ()\n{\n%s\n}}()" body)
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-R-process-value-result
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(16)))
+ column-names-p)))
+ (output (org-babel-eval org-babel-R-command body))))
+
+(defun org-babel-R-evaluate-session
+ (session body result-type result-params column-names-p row-names-p)
+ "Evaluate BODY in SESSION.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (case result-type
+ (value
+ (with-temp-buffer
+ (insert (org-babel-chomp body))
+ (let ((ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-eval-visibly-p nil))
+ (ess-eval-buffer nil)))
+ (let ((tmp-file (org-babel-temp-file "R-")))
+ (org-babel-comint-eval-invisibly-and-wait-for-file
+ session tmp-file
+ (format org-babel-R-write-object-command
+ (if row-names-p "TRUE" "FALSE")
+ (if column-names-p
+ (if row-names-p "NA" "TRUE")
+ "FALSE")
+ ".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-R-process-value-result
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(16)))
+ column-names-p)))
+ (output
+ (mapconcat
+ #'org-babel-chomp
+ (butlast
+ (delq nil
+ (mapcar
+ (lambda (line) (when (> (length line) 0) line))
+ (mapcar
+ (lambda (line) ;; cleanup extra prompts left in output
+ (if (string-match
+ "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ (substring line (match-end 1))
+ line))
+ (org-babel-comint-with-output (session org-babel-R-eoe-output)
+ (insert (mapconcat #'org-babel-chomp
+ (list body org-babel-R-eoe-indicator)
+ "\n"))
+ (inferior-ess-send-input)))))) "\n"))))
+
+(defun org-babel-R-process-value-result (result column-names-p)
+ "R-specific processing of return value.
+Insert hline if column names in output have been requested."
+ (if column-names-p
+ (cons (car result) (cons 'hline (cdr result)))
+ result))
+
+(provide 'ob-R)
+
+
+
+;;; ob-R.el ends here
diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el
new file mode 100644
index 0000000..a3c5e3d
--- /dev/null
+++ b/lisp/ob-asymptote.el
@@ -0,0 +1,150 @@
+;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating asymptote source code.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in asymptote
+;;
+;; 2) we are generally only going to return results of type "file"
+;;
+;; 3) we are adding the "file" and "cmdline" header arguments, if file
+;; is omitted then the -V option is passed to the asy command for
+;; interactive viewing
+
+;;; Requirements:
+
+;; - The asymptote program :: http://asymptote.sourceforge.net/
+;;
+;; - asy-mode :: Major mode for editing asymptote files
+
+;;; Code:
+(require 'ob)
+(eval-when-compile (require 'cl))
+
+(declare-function orgtbl-to-generic "org-table" (table params))
+(declare-function org-combine-plists "org" (&rest plists))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
+
+(defvar org-babel-default-header-args:asymptote
+ '((:results . "file") (:exports . "results"))
+ "Default arguments when evaluating an Asymptote source block.")
+
+(defun org-babel-execute:asymptote (body params)
+ "Execute a block of Asymptote code.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (out-file (cdr (assoc :file params)))
+ (format (or (and out-file
+ (string-match ".+\\.\\(.+\\)" out-file)
+ (match-string 1 out-file))
+ "pdf"))
+ (cmdline (cdr (assoc :cmdline params)))
+ (in-file (org-babel-temp-file "asymptote-"))
+ (cmd
+ (concat "asy "
+ (if out-file
+ (concat
+ "-globalwrite -f " format
+ " -o " (org-babel-process-file-name out-file))
+ "-V")
+ " " cmdline
+ " " (org-babel-process-file-name in-file))))
+ (with-temp-file in-file
+ (insert (org-babel-expand-body:generic
+ body params
+ (org-babel-variable-assignments:asymptote params))))
+ (message cmd) (shell-command cmd)
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:asymptote (session params)
+ "Return an error if the :session header argument is set.
+Asymptote does not support sessions"
+ (error "Asymptote does not support sessions"))
+
+(defun org-babel-variable-assignments:asymptote (params)
+ "Return list of asymptote statements assigning the block's variables."
+ (mapcar #'org-babel-asymptote-var-to-asymptote
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-asymptote-var-to-asymptote (pair)
+ "Convert an elisp value into an Asymptote variable.
+The elisp value PAIR is converted into Asymptote code specifying
+a variable of the same value."
+ (let ((var (car pair))
+ (val (let ((v (cdr pair)))
+ (if (symbolp v) (symbol-name v) v))))
+ (cond
+ ((integerp val)
+ (format "int %S=%S;" var val))
+ ((floatp val)
+ (format "real %S=%S;" var val))
+ ((stringp val)
+ (format "string %S=\"%s\";" var val))
+ ((and (listp val) (not (listp (car val))))
+ (let* ((type (org-babel-asymptote-define-type val))
+ (fmt (if (eq 'string type) "\"%s\"" "%s"))
+ (vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
+ (format "%s[] %S={%s};" type var vect)))
+ ((listp val)
+ (let* ((type (org-babel-asymptote-define-type val))
+ (fmt (if (eq 'string type) "\"%s\"" "%s"))
+ (array (mapconcat (lambda (row)
+ (concat "{"
+ (mapconcat (lambda (e) (format fmt e))
+ row ", ")
+ "}"))
+ val ",")))
+ (format "%S[][] %S={%s};" type var array))))))
+
+(defun org-babel-asymptote-define-type (data)
+ "Determine type of DATA.
+
+DATA is a list. Return type as a symbol.
+
+The type is `string' if any element in DATA is
+a string. Otherwise, it is either `real', if some elements are
+floats, or `int'."
+ (let* ((type 'int)
+ find-type ; for byte-compiler
+ (find-type
+ (function
+ (lambda (row)
+ (catch 'exit
+ (mapc (lambda (el)
+ (cond ((listp el) (funcall find-type el))
+ ((stringp el) (throw 'exit (setq type 'string)))
+ ((floatp el) (setq type 'real))))
+ row))))))
+ (funcall find-type data) type))
+
+(provide 'ob-asymptote)
+
+
+
+;;; ob-asymptote.el ends here
diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el
new file mode 100644
index 0000000..6e13996
--- /dev/null
+++ b/lisp/ob-awk.el
@@ -0,0 +1,117 @@
+;;; ob-awk.el --- org-babel functions for awk evaluation
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Babel's awk can use special header argument:
+;;
+;; - :in-file takes a path to a file of data to be processed by awk
+;;
+;; - :stdin takes an Org-mode data or code block reference, the value
+;; of which will be passed to the awk process through STDIN
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'org-compat)
+(eval-when-compile (require 'cl))
+
+(declare-function org-babel-ref-resolve "ob-ref" (ref))
+(declare-function orgtbl-to-generic "org-table" (table params))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk"))
+
+(defvar org-babel-awk-command "awk"
+ "Name of the awk executable command.")
+
+(defun org-babel-expand-body:awk (body params &optional processed-params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
+ (setf body (replace-regexp-in-string
+ (regexp-quote (format "$%s" (car pair))) (cdr pair) body)))
+ body)
+
+(defun org-babel-execute:awk (body params)
+ "Execute a block of Awk code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Awk source code block")
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (cmd-line (cdr (assoc :cmd-line params)))
+ (in-file (cdr (assoc :in-file params)))
+ (full-body (org-babel-expand-body:awk body params))
+ (code-file ((lambda (file) (with-temp-file file (insert full-body)) file)
+ (org-babel-temp-file "awk-")))
+ (stdin ((lambda (stdin)
+ (when stdin
+ (let ((tmp (org-babel-temp-file "awk-stdin-"))
+ (res (org-babel-ref-resolve stdin)))
+ (with-temp-file tmp
+ (insert (org-babel-awk-var-to-awk res)))
+ tmp)))
+ (cdr (assoc :stdin params))))
+ (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
+ "-f" code-file
+ cmd-line
+ in-file))
+ " ")))
+ (org-babel-reassemble-table
+ ((lambda (results)
+ (when results
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "output" result-params))
+ results
+ (let ((tmp (org-babel-temp-file "awk-results-")))
+ (with-temp-file tmp (insert results))
+ (org-babel-import-elisp-from-file tmp)))))
+ (cond
+ (stdin (with-temp-buffer
+ (call-process-shell-command cmd stdin (current-buffer))
+ (buffer-string)))
+ (t (org-babel-eval cmd ""))))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+(defun org-babel-awk-var-to-awk (var &optional sep)
+ "Return a printed value of VAR suitable for parsing with awk."
+ (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
+ (cond
+ ((and (listp var) (listp (car var)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
+ ((listp var)
+ (mapconcat echo-var var "\n"))
+ (t (funcall echo-var var)))))
+
+(defun org-babel-awk-table-or-string (results)
+ "If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+(provide 'ob-awk)
+
+
+
+;;; ob-awk.el ends here
diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el
new file mode 100644
index 0000000..c79d0b5
--- /dev/null
+++ b/lisp/ob-calc.el
@@ -0,0 +1,108 @@
+;;; ob-calc.el --- org-babel functions for calc code evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating calc code
+
+;;; Code:
+(require 'ob)
+(require 'calc)
+(unless (featurep 'xemacs)
+ (require 'calc-trail)
+ (require 'calc-store))
+(eval-when-compile (require 'ob-comint))
+
+(declare-function calc-store-into "calc-store" (&optional var))
+(declare-function calc-recall "calc-store" (&optional var))
+(declare-function math-evaluate-expr "calc-ext" (x))
+
+(defvar org-babel-default-header-args:calc nil
+ "Default arguments for evaluating an calc source block.")
+
+(defun org-babel-expand-body:calc (body params)
+ "Expand BODY according to PARAMS, return the expanded body." body)
+
+(defun org-babel-execute:calc (body params)
+ "Execute a block of calc code with Babel."
+ (unless (get-buffer "*Calculator*")
+ (save-window-excursion (calc) (calc-quit)))
+ (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (var-syms (mapcar #'car vars))
+ (var-names (mapcar #'symbol-name var-syms)))
+ (mapc
+ (lambda (pair)
+ (calc-push-list (list (cdr pair)))
+ (calc-store-into (car pair)))
+ vars)
+ (mapc
+ (lambda (line)
+ (when (> (length line) 0)
+ (cond
+ ;; simple variable name
+ ((member line var-names) (calc-recall (intern line)))
+ ;; stack operation
+ ((string= "'" (substring line 0 1))
+ (funcall (lookup-key calc-mode-map (substring line 1)) nil))
+ ;; complex expression
+ (t
+ (calc-push-list
+ (list ((lambda (res)
+ (cond
+ ((numberp res) res)
+ ((math-read-number res) (math-read-number res))
+ ((listp res) (error "Calc error \"%s\" on input \"%s\""
+ (cadr res) line))
+ (t (replace-regexp-in-string
+ "'" ""
+ (calc-eval
+ (math-evaluate-expr
+ ;; resolve user variables, calc built in
+ ;; variables are handled automatically
+ ;; upstream by calc
+ (mapcar #'org-babel-calc-maybe-resolve-var
+ ;; parse line into calc objects
+ (car (math-read-exprs line)))))))))
+ (calc-eval line))))))))
+ (mapcar #'org-babel-trim
+ (split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
+ (save-excursion
+ (with-current-buffer (get-buffer "*Calculator*")
+ (calc-eval (calc-top 1)))))
+
+(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
+(defun org-babel-calc-maybe-resolve-var (el)
+ (if (consp el)
+ (if (and (equal 'var (car el)) (member (cadr el) var-syms))
+ (progn
+ (calc-recall (cadr el))
+ (prog1 (calc-top 1)
+ (calc-pop 1)))
+ (mapcar #'org-babel-calc-maybe-resolve-var el))
+ el))
+
+(provide 'ob-calc)
+
+
+
+;;; ob-calc.el ends here
diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
new file mode 100644
index 0000000..f389404
--- /dev/null
+++ b/lisp/ob-clojure.el
@@ -0,0 +1,96 @@
+;;; ob-clojure.el --- org-babel functions for clojure evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Joel Boehland
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; support for evaluating clojure code, relies on slime for all eval
+
+;;; Requirements:
+
+;;; - clojure (at least 1.2.0)
+;;; - clojure-mode
+;;; - slime
+
+;;; By far, the best way to install these components is by following
+;;; the directions as set out by Phil Hagelberg (Technomancy) on the
+;;; web page: http://technomancy.us/126
+
+;;; Code:
+(require 'ob)
+
+(declare-function slime-eval "ext:slime" (sexp &optional package))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
+
+(defvar org-babel-default-header-args:clojure '())
+(defvar org-babel-header-args:clojure '((package . :any)))
+
+(defun org-babel-expand-body:clojure (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (print-level nil) (print-length nil)
+ (body (org-babel-trim
+ (if (> (length vars) 0)
+ (concat "(let ["
+ (mapconcat
+ (lambda (var)
+ (format "%S (quote %S)" (car var) (cdr var)))
+ vars "\n ")
+ "]\n" body ")")
+ body))))
+ (cond ((or (member "code" result-params) (member "pp" result-params))
+ (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] "
+ "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
+ "(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
+ "(str org-mode-print-catcher)))")
+ (if (member "code" result-params) "code" "simple") body))
+ ;; if (:results output), collect printed output
+ ((member "output" result-params)
+ (format "(clojure.core/with-out-str %s)" body))
+ (t body))))
+
+(defun org-babel-execute:clojure (body params)
+ "Execute a block of Clojure code with Babel."
+ (require 'slime)
+ (with-temp-buffer
+ (insert (org-babel-expand-body:clojure body params))
+ ((lambda (result)
+ (let ((result-params (cdr (assoc :result-params params))))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params))
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))
+ (slime-eval
+ `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties (point-min) (point-max)))
+ (cdr (assoc :package params))))))
+
+(provide 'ob-clojure)
+
+
+
+;;; ob-clojure.el ends here
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
new file mode 100644
index 0000000..ba3b99d
--- /dev/null
+++ b/lisp/ob-comint.el
@@ -0,0 +1,166 @@
+;;; ob-comint.el --- org-babel functions for interaction with comint buffers
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, comint
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These functions build on comint to ease the sending and receiving
+;; of commands and results from comint buffers.
+
+;; Note that the buffers in this file are analogous to sessions in
+;; org-babel at large.
+
+;;; Code:
+(require 'ob)
+(require 'org-compat)
+(require 'comint)
+(eval-when-compile (require 'cl))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
+(declare-function tramp-flush-directory-property "tramp" (vec directory))
+
+(defun org-babel-comint-buffer-livep (buffer)
+ "Check if BUFFER is a comint buffer with a live process."
+ (let ((buffer (if buffer (get-buffer buffer))))
+ (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer)))
+
+(defmacro org-babel-comint-in-buffer (buffer &rest body)
+ "Check BUFFER and execute BODY.
+BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
+executed inside the protection of `save-excursion' and
+`save-match-data'."
+ (declare (indent 1))
+ `(save-excursion
+ (save-match-data
+ (unless (org-babel-comint-buffer-livep ,buffer)
+ (error "Buffer %s does not exist or has no process" ,buffer))
+ (set-buffer ,buffer)
+ ,@body)))
+(def-edebug-spec org-babel-comint-in-buffer (form body))
+
+(defmacro org-babel-comint-with-output (meta &rest body)
+ "Evaluate BODY in BUFFER and return process output.
+Will wait until EOE-INDICATOR appears in the output, then return
+all process output. If REMOVE-ECHO and FULL-BODY are present and
+non-nil, then strip echo'd body from the returned output. META
+should be a list containing the following where the last two
+elements are optional.
+
+ (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY)
+
+This macro ensures that the filter is removed in case of an error
+or user `keyboard-quit' during execution of body."
+ (declare (indent 1))
+ (let ((buffer (car meta))
+ (eoe-indicator (cadr meta))
+ (remove-echo (cadr (cdr meta)))
+ (full-body (cadr (cdr (cdr meta)))))
+ `(org-babel-comint-in-buffer ,buffer
+ (let ((string-buffer "") dangling-text raw)
+ ;; setup filter
+ (setq comint-output-filter-functions
+ (cons (lambda (text) (setq string-buffer (concat string-buffer text)))
+ comint-output-filter-functions))
+ (unwind-protect
+ (progn
+ ;; got located, and save dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((start (point))
+ (end (point-max)))
+ (setq dangling-text (buffer-substring start end))
+ (delete-region start end))
+ ;; pass FULL-BODY to process
+ ,@body
+ ;; wait for end-of-evaluation indicator
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ ;; thought the following this would allow async
+ ;; background running, but I was wrong...
+ ;; (run-with-timer .5 .5 'accept-process-output
+ ;; (get-buffer-process (current-buffer)))
+ )
+ ;; replace cut dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert dangling-text))
+ ;; remove filter
+ (setq comint-output-filter-functions
+ (cdr comint-output-filter-functions)))
+ ;; remove echo'd FULL-BODY from input
+ (if (and ,remove-echo ,full-body
+ (string-match
+ (replace-regexp-in-string
+ "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
+ string-buffer))
+ (setq raw (substring string-buffer (match-end 0))))
+ (split-string string-buffer comint-prompt-regexp)))))
+(def-edebug-spec org-babel-comint-with-output (form body))
+
+(defun org-babel-comint-input-command (buffer cmd)
+ "Pass CMD to BUFFER.
+The input will not be echoed."
+ (org-babel-comint-in-buffer buffer
+ (goto-char (process-mark (get-buffer-process buffer)))
+ (insert cmd)
+ (comint-send-input)
+ (org-babel-comint-wait-for-output buffer)))
+
+(defun org-babel-comint-wait-for-output (buffer)
+ "Wait until output arrives from BUFFER.
+Note: this is only safe when waiting for the result of a single
+statement (not large blocks of code)."
+ (org-babel-comint-in-buffer buffer
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (and (re-search-forward comint-prompt-regexp nil t)
+ (goto-char (match-beginning 0))
+ (string= (face-name (face-at-point))
+ "comint-highlight-prompt"))))
+ (accept-process-output (get-buffer-process buffer)))))
+
+(defun org-babel-comint-eval-invisibly-and-wait-for-file
+ (buffer file string &optional period)
+ "Evaluate STRING in BUFFER invisibly.
+Don't return until FILE exists. Code in STRING must ensure that
+FILE exists at end of evaluation."
+ (unless (org-babel-comint-buffer-livep buffer)
+ (error "Buffer %s does not exist or has no process" buffer))
+ (if (file-exists-p file) (delete-file file))
+ (process-send-string
+ (get-buffer-process buffer)
+ (if (string-match "\n$" string) string (concat string "\n")))
+ ;; From Tramp 2.1.19 the following cache flush is not necessary
+ (if (file-remote-p default-directory)
+ (let (v)
+ (with-parsed-tramp-file-name default-directory nil
+ (tramp-flush-directory-property v ""))))
+ (while (not (file-exists-p file)) (sit-for (or period 0.25))))
+
+(provide 'ob-comint)
+
+
+
+;;; ob-comint.el ends here
diff --git a/lisp/ob-css.el b/lisp/ob-css.el
new file mode 100644
index 0000000..6259ebc
--- /dev/null
+++ b/lisp/ob-css.el
@@ -0,0 +1,48 @@
+;;; ob-css.el --- org-babel functions for css evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Since CSS can't be executed, this file exists solely for tangling
+;; CSS from org-mode files.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-default-header-args:css '())
+
+(defun org-babel-execute:css (body params)
+ "Execute a block of CSS code.
+This function is called by `org-babel-execute-src-block'."
+ body)
+
+(defun org-babel-prep-session:css (session params)
+ "Return an error if the :session header argument is set.
+CSS does not support sessions."
+ (error "CSS sessions are nonsensical"))
+
+(provide 'ob-css)
+
+
+
+;;; ob-css.el ends here
diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el
new file mode 100644
index 0000000..ae7794b
--- /dev/null
+++ b/lisp/ob-ditaa.el
@@ -0,0 +1,91 @@
+;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating ditaa source code.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in ditaa
+;;
+;; 2) we are generally only going to return results of type "file"
+;;
+;; 3) we are adding the "file" and "cmdline" header arguments
+;;
+;; 4) there are no variables (at least for now)
+;;
+;; 5) it depends on a variable defined in org-exp-blocks (namely
+;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded
+
+;;; Code:
+(require 'ob)
+
+(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks
+
+(defvar org-babel-default-header-args:ditaa
+ '((:results . "file")
+ (:exports . "results")
+ (:java . "-Dfile.encoding=UTF-8"))
+ "Default arguments for evaluating a ditaa source block.")
+
+(defcustom org-ditaa-jar-option "-jar"
+ "Option for the ditaa jar file.
+Do not leave leading or trailing spaces in this string."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-execute:ditaa (body params)
+ "Execute a block of Ditaa code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (out-file ((lambda (el)
+ (or el
+ (error
+ "ditaa code block requires :file header argument")))
+ (cdr (assoc :file params))))
+ (cmdline (cdr (assoc :cmdline params)))
+ (java (cdr (assoc :java params)))
+ (in-file (org-babel-temp-file "ditaa-"))
+ (cmd (concat "java " java " " org-ditaa-jar-option " "
+ (shell-quote-argument
+ (expand-file-name org-ditaa-jar-path))
+ " " cmdline
+ " " (org-babel-process-file-name in-file)
+ " " (org-babel-process-file-name out-file))))
+ (unless (file-exists-p org-ditaa-jar-path)
+ (error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
+ (with-temp-file in-file (insert body))
+ (message cmd) (shell-command cmd)
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:ditaa (session params)
+ "Return an error because ditaa does not support sessions."
+ (error "Ditaa does not support sessions"))
+
+(provide 'ob-ditaa)
+
+
+
+;;; ob-ditaa.el ends here
diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el
new file mode 100644
index 0000000..99748b0
--- /dev/null
+++ b/lisp/ob-dot.el
@@ -0,0 +1,90 @@
+;;; ob-dot.el --- org-babel functions for dot evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating dot source code.
+;;
+;; For information on dot see http://www.graphviz.org/
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in dot
+;;
+;; 2) we are generally only going to return results of type "file"
+;;
+;; 3) we are adding the "file" and "cmdline" header arguments
+;;
+;; 4) there are no variables (at least for now)
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-default-header-args:dot
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating a dot source block.")
+
+(defun org-babel-expand-body:dot (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapc
+ (lambda (pair)
+ (let ((name (symbol-name (car pair)))
+ (value (cdr pair)))
+ (setq body
+ (replace-regexp-in-string
+ (concat "\$" (regexp-quote name))
+ (if (stringp value) value (format "%S" value))
+ body))))
+ vars)
+ body))
+
+(defun org-babel-execute:dot (body params)
+ "Execute a block of Dot code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (out-file (cdr (or (assoc :file params)
+ (error "You need to specify a :file parameter"))))
+ (cmdline (or (cdr (assoc :cmdline params))
+ (format "-T%s" (file-name-extension out-file))))
+ (cmd (or (cdr (assoc :cmd params)) "dot"))
+ (in-file (org-babel-temp-file "dot-")))
+ (with-temp-file in-file
+ (insert (org-babel-expand-body:dot body params)))
+ (org-babel-eval
+ (concat cmd
+ " " (org-babel-process-file-name in-file)
+ " " cmdline
+ " -o " (org-babel-process-file-name out-file)) "")
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:dot (session params)
+ "Return an error because Dot does not support sessions."
+ (error "Dot does not support sessions"))
+
+(provide 'ob-dot)
+
+
+
+;;; ob-dot.el ends here
diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el
new file mode 100644
index 0000000..d83ca24
--- /dev/null
+++ b/lisp/ob-emacs-lisp.el
@@ -0,0 +1,80 @@
+;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating emacs-lisp code
+
+;;; Code:
+(require 'ob)
+(eval-when-compile (require 'ob-comint))
+
+(defvar org-babel-default-header-args:emacs-lisp
+ '((:hlines . "yes") (:colnames . "no"))
+ "Default arguments for evaluating an emacs-lisp source block.")
+
+(declare-function orgtbl-to-generic "org-table" (table params))
+
+(defun org-babel-expand-body:emacs-lisp (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (print-level nil) (print-length nil)
+ (body (if (> (length vars) 0)
+ (concat "(let ("
+ (mapconcat
+ (lambda (var)
+ (format "%S" (print `(,(car var) ',(cdr var)))))
+ vars "\n ")
+ ")\n" body "\n)")
+ (concat body "\n"))))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (concat "(pp " body ")") body)))
+
+(defun org-babel-execute:emacs-lisp (body params)
+ "Execute a block of emacs-lisp code with Babel."
+ (save-window-excursion
+ ((lambda (result)
+ (if (or (member "scalar" (cdr (assoc :result-params params)))
+ (member "verbatim" (cdr (assoc :result-params params))))
+ (let ((print-level nil)
+ (print-length nil))
+ (format "%S" result))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))
+ (eval (read (format (if (member "output"
+ (cdr (assoc :result-params params)))
+ "(with-output-to-string %s)"
+ "(progn %s)")
+ (org-babel-expand-body:emacs-lisp body params)))))))
+
+(provide 'ob-emacs-lisp)
+
+
+
+;;; ob-emacs-lisp.el ends here
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
new file mode 100644
index 0000000..ddad067
--- /dev/null
+++ b/lisp/ob-eval.el
@@ -0,0 +1,261 @@
+;;; ob-eval.el --- org-babel functions for external code evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, comint
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These functions build existing Emacs support for executing external
+;; shell commands.
+
+;;; Code:
+(eval-when-compile (require 'cl))
+
+(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
+
+(defun org-babel-eval-error-notify (exit-code stderr)
+ "Open a buffer to display STDERR and a message with the value of EXIT-CODE."
+ (let ((buf (get-buffer-create org-babel-error-buffer-name)))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (save-excursion (insert stderr)))
+ (display-buffer buf))
+ (message "Babel evaluation exited with code %S" exit-code))
+
+(defun org-babel-eval (cmd body)
+ "Run CMD on BODY.
+If CMD succeeds then return its results, otherwise display
+STDERR with `org-babel-eval-error-notify'."
+ (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code)
+ (with-current-buffer err-buff (erase-buffer))
+ (with-temp-buffer
+ (insert body)
+ (setq exit-code
+ (org-babel-shell-command-on-region
+ (point-min) (point-max) cmd t 'replace err-buff))
+ (if (or (not (numberp exit-code)) (> exit-code 0))
+ (progn
+ (with-current-buffer err-buff
+ (org-babel-eval-error-notify exit-code (buffer-string)))
+ nil)
+ (buffer-string)))))
+
+(defun org-babel-eval-read-file (file)
+ "Return the contents of FILE as a string."
+ (with-temp-buffer (insert-file-contents file)
+ (buffer-string)))
+
+(defun org-babel-shell-command-on-region (start end command
+ &optional output-buffer replace
+ error-buffer display-error-buffer)
+ "Execute COMMAND in an inferior shell with region as input.
+
+Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
+
+Normally display output (if any) in temp buffer `*Shell Command Output*';
+Prefix arg means replace the region with it. Return the exit code of
+COMMAND.
+
+To specify a coding system for converting non-ASCII characters in
+the input and output to the shell command, use
+\\[universal-coding-system-argument] before this command. By
+default, the input (from the current buffer) is encoded in the
+same coding system that will be used to save the file,
+`buffer-file-coding-system'. If the output is going to replace
+the region, then it is decoded from that same coding system.
+
+The noninteractive arguments are START, END, COMMAND,
+OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
+Noninteractive callers can specify coding systems by binding
+`coding-system-for-read' and `coding-system-for-write'.
+
+If the command generates output, the output may be displayed
+in the echo area or in a buffer.
+If the output is short enough to display in the echo area
+\(determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), it is shown there. Otherwise
+it is displayed in the buffer `*Shell Command Output*'. The output
+is available in that buffer in both cases.
+
+If there is output and an error, a message about the error
+appears at the end of the output.
+
+If there is no output, or if output is inserted in the current buffer,
+then `*Shell Command Output*' is deleted.
+
+If the optional fourth argument OUTPUT-BUFFER is non-nil,
+that says to put the output in some other buffer.
+If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
+If OUTPUT-BUFFER is not a buffer and not nil,
+insert output in the current buffer.
+In either case, the output is inserted after point (leaving mark after it).
+
+If REPLACE, the optional fifth argument, is non-nil, that means insert
+the output in place of text from START to END, putting point and mark
+around it.
+
+If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
+or buffer name to which to direct the command's standard error output.
+If it is nil, error output is mingled with regular output.
+If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
+were any errors. (This is always t, interactively.)
+In an interactive call, the variable `shell-command-default-error-buffer'
+specifies the value of ERROR-BUFFER."
+ (interactive (let (string)
+ (unless (mark)
+ (error "The mark is not set now, so there is no region"))
+ ;; Do this before calling region-beginning
+ ;; and region-end, in case subprocess output
+ ;; relocates them while we are in the minibuffer.
+ (setq string (read-shell-command "Shell command on region: "))
+ ;; call-interactively recognizes region-beginning and
+ ;; region-end specially, leaving them in the history.
+ (list (region-beginning) (region-end)
+ string
+ current-prefix-arg
+ current-prefix-arg
+ shell-command-default-error-buffer
+ t)))
+ (let ((error-file
+ (if error-buffer
+ (make-temp-file
+ (expand-file-name "scor"
+ (if (featurep 'xemacs)
+ (temp-directory)
+ temporary-file-directory)))
+ nil))
+ exit-status)
+ (if (or replace
+ (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer)))))
+ ;; Replace specified region with output from command.
+ (let ((swap (and replace (< start end))))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (goto-char start)
+ (and replace (push-mark (point) 'nomsg))
+ (setq exit-status
+ (call-process-region start end shell-file-name t
+ (if error-file
+ (list output-buffer error-file)
+ t)
+ nil shell-command-switch command))
+ ;; It is rude to delete a buffer which the command is not using.
+ ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ ;; (kill-buffer shell-buffer)))
+ ;; Don't muck with mark unless REPLACE says we should.
+ (and replace swap (exchange-point-and-mark)))
+ ;; No prefix argument: put the output in a temp buffer,
+ ;; replacing its entire contents.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*"))))
+ (unwind-protect
+ (if (eq buffer (current-buffer))
+ ;; If the input is the same buffer as the output,
+ ;; delete everything but the specified region,
+ ;; then replace that region with the output.
+ (progn (setq buffer-read-only nil)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
+ (setq exit-status
+ (call-process-region (point-min) (point-max)
+ shell-file-name t
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch
+ command)))
+ ;; Clear the output buffer, then run the command with
+ ;; output there.
+ (let ((directory default-directory))
+ (with-current-buffer buffer
+ (setq buffer-read-only nil)
+ (if (not output-buffer)
+ (setq default-directory directory))
+ (erase-buffer)))
+ (setq exit-status
+ (call-process-region start end shell-file-name nil
+ (if error-file
+ (list buffer error-file)
+ buffer)
+ nil shell-command-switch command)))
+ ;; Report the output.
+ (with-current-buffer buffer
+ (setq mode-line-process
+ (cond ((null exit-status)
+ " - Error")
+ ((stringp exit-status)
+ (format " - Signal [%s]" exit-status))
+ ((not (equal 0 exit-status))
+ (format " - Exit [%d]" exit-status)))))
+ (if (with-current-buffer buffer (> (point-max) (point-min)))
+ ;; There's some output, display it
+ (display-message-or-buffer buffer)
+ ;; No output; error?
+ (let ((output
+ (if (and error-file
+ (< 0 (nth 7 (file-attributes error-file))))
+ "some error output"
+ "no output")))
+ (cond ((null exit-status)
+ (message "(Shell command failed with error)"))
+ ((equal 0 exit-status)
+ (message "(Shell command succeeded with %s)"
+ output))
+ ((stringp exit-status)
+ (message "(Shell command killed by signal %s)"
+ exit-status))
+ (t
+ (message "(Shell command failed with code %d and %s)"
+ exit-status output))))
+ ;; Don't kill: there might be useful info in the undo-log.
+ ;; (kill-buffer buffer)
+ ))))
+
+ (when (and error-file (file-exists-p error-file))
+ (if (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (and display-error-buffer
+ (display-buffer (current-buffer)))))
+ (delete-file error-file))
+ exit-status))
+
+(defun org-babel-eval-wipe-error-buffer ()
+ "Delete the contents of the Org code block error buffer.
+This buffer is named by `org-babel-error-buffer-name'."
+ (when (get-buffer org-babel-error-buffer-name)
+ (with-current-buffer org-babel-error-buffer-name
+ (delete-region (point-min) (point-max)))))
+
+(provide 'ob-eval)
+
+
+
+;;; ob-eval.el ends here
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
new file mode 100644
index 0000000..d17fd34
--- /dev/null
+++ b/lisp/ob-exp.el
@@ -0,0 +1,328 @@
+;;; ob-exp.el --- Exportation of org-babel source blocks
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(require 'ob)
+(require 'org-exp-blocks)
+(eval-when-compile
+ (require 'cl))
+
+(defvar obe-marker nil)
+(defvar org-current-export-file)
+(defvar org-babel-lob-one-liner-regexp)
+(defvar org-babel-ref-split-regexp)
+(defvar org-list-forbidden-blocks)
+
+(declare-function org-babel-lob-get-info "ob-lob" ())
+(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
+(declare-function org-heading-components "org" ())
+(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-in-verbatim-emphasis "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
+
+(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
+(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
+
+(defcustom org-export-babel-evaluate t
+ "Switch controlling code evaluation during export.
+When set to nil no code will be evaluated as part of the export
+process."
+ :group 'org-babel
+ :version "24.1"
+ :type 'boolean)
+(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
+
+(defun org-babel-exp-get-export-buffer ()
+ "Return the current export buffer if possible."
+ (cond
+ ((bufferp org-current-export-file) org-current-export-file)
+ (org-current-export-file (get-file-buffer org-current-export-file))
+ ('otherwise
+ (error "Requested export buffer when `org-current-export-file' is nil"))))
+
+(defmacro org-babel-exp-in-export-file (lang &rest body)
+ (declare (indent 1))
+ `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
+ (heading (nth 4 (ignore-errors (org-heading-components))))
+ (export-buffer (current-buffer))
+ (original-buffer (org-babel-exp-get-export-buffer)) results)
+ (when original-buffer
+ ;; resolve parameters in the original file so that
+ ;; headline and file-wide parameters are included, attempt
+ ;; to go to the same heading in the original file
+ (set-buffer original-buffer)
+ (save-restriction
+ (when heading
+ (condition-case nil
+ (let ((org-link-search-inhibit-query t))
+ (org-link-search heading))
+ (error (when heading
+ (goto-char (point-min))
+ (re-search-forward (regexp-quote heading) nil t)))))
+ (setq results ,@body))
+ (set-buffer export-buffer)
+ results)))
+(def-edebug-spec org-babel-exp-in-export-file (form body))
+
+(defun org-babel-exp-src-block (body &rest headers)
+ "Process source block for export.
+Depending on the 'export' headers argument in replace the source
+code block with...
+
+both ---- display the code and the results
+
+code ---- the default, display the code inside the block but do
+ not process
+
+results - just like none only the block is run on export ensuring
+ that it's results are present in the org-mode buffer
+
+none ----- do not display either code or results upon export"
+ (interactive)
+ (unless noninteractive (message "org-babel-exp processing..."))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (lang (nth 0 info))
+ (raw-params (nth 2 info)) hash)
+ ;; bail if we couldn't get any info from the block
+ (when info
+ ;; if we're actually going to need the parameters
+ (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
+ (org-babel-exp-in-export-file lang
+ (setf (nth 2 info)
+ (org-babel-process-params
+ (org-babel-merge-params
+ org-babel-default-header-args
+ (org-babel-params-from-properties lang)
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ raw-params))))
+ (setf hash (org-babel-sha1-hash info)))
+ (org-babel-exp-do-export info 'block hash)))))
+
+(defcustom org-babel-exp-call-line-template
+ ""
+ "Template used to export call lines.
+This template may be customized to include the call line name
+with any export markup. The template is filled out using
+`org-fill-template', and the following %keys may be used.
+
+ line --- call line
+
+An example value would be \"\\n: call: %line\" to export the call line
+wrapped in a verbatim environment.
+
+Note: the results are inserted separately after the contents of
+this template."
+ :group 'org-babel
+ :type 'string)
+
+(defvar org-babel-default-lob-header-args)
+(defun org-babel-exp-non-block-elements (start end)
+ "Process inline source and call lines between START and END for export."
+ (interactive)
+ (save-excursion
+ (goto-char start)
+ (unless (markerp end)
+ (let ((m (make-marker)))
+ (set-marker m end (current-buffer))
+ (setq end m)))
+ (let ((rx (concat "\\(" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)")))
+ (while (and (< (point) (marker-position end))
+ (re-search-forward rx end t))
+ (if (save-excursion
+ (goto-char (match-beginning 0))
+ (looking-at org-babel-inline-src-block-regexp))
+ (progn
+ (forward-char 1)
+ (let* ((info (save-match-data
+ (org-babel-parse-inline-src-block-match)))
+ (params (nth 2 info)))
+ (save-match-data
+ (goto-char (match-beginning 2))
+ (unless (org-babel-in-example-or-verbatim)
+ ;; expand noweb references in the original file
+ (setf (nth 1 info)
+ (if (and (cdr (assoc :noweb params))
+ (string= "yes" (cdr (assoc :noweb params))))
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (let ((code-replacement (save-match-data
+ (org-babel-exp-do-export
+ info 'inline))))
+ (if code-replacement
+ (progn (replace-match code-replacement nil nil nil 1)
+ (delete-char 1))
+ (org-babel-examplize-region (match-beginning 1)
+ (match-end 1))
+ (forward-char 2)))))))
+ (unless (org-babel-in-example-or-verbatim)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (inlinep (match-string 11))
+ (inline-start (match-end 11))
+ (inline-end (match-end 0))
+ (results (save-match-data
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (org-babel-params-from-properties)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat ":var results="
+ (mapconcat #'identity
+ (butlast lob-info)
+ " ")))))
+ "" nil (car (last lob-info)))
+ 'lob)))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
+ (if inlinep
+ (save-excursion
+ (goto-char inline-start)
+ (delete-region inline-start inline-end)
+ (insert rep))
+ (replace-match rep t t)))))))))
+
+(defun org-babel-in-example-or-verbatim ()
+ "Return true if point is in example or verbatim code.
+Example and verbatim code include escaped portions of
+an org-mode buffer code that should be treated as normal
+org-mode text."
+ (or (save-match-data
+ (save-excursion
+ (goto-char (point-at-bol))
+ (looking-at "[ \t]*:[ \t]")))
+ (org-in-verbatim-emphasis)
+ (org-in-block-p org-list-forbidden-blocks)
+ (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
+
+(defun org-babel-exp-do-export (info type &optional hash)
+ "Return a string with the exported content of a code block.
+The function respects the value of the :exports header argument."
+ (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
+ (when (not (and session (equal "none" session)))
+ (org-babel-exp-results info type 'silent)))))
+ (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
+ (case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
+ ('none (funcall silently) (funcall clean) "")
+ ('code (funcall silently) (funcall clean) (org-babel-exp-code info))
+ ('results (org-babel-exp-results info type nil hash) "")
+ ('both (org-babel-exp-results info type nil hash)
+ (org-babel-exp-code info)))))
+
+(defcustom org-babel-exp-code-template
+ "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ "Template used to export the body of code blocks.
+This template may be customized to include additional information
+such as the code block name, or the values of particular header
+arguments. The template is filled out using `org-fill-template',
+and the following %keys may be used.
+
+ lang ------ the language of the code block
+ name ------ the name of the code block
+ body ------ the body of the code block
+ flags ----- the flags passed to the code block
+
+In addition to the keys mentioned above, every header argument
+defined for the code block may be used as a key and will be
+replaced with its value."
+ :group 'org-babel
+ :type 'string)
+
+(defun org-babel-exp-code (info)
+ "Return the original code block formatted for export."
+ (setf (nth 1 info)
+ (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
+ (replace-regexp-in-string
+ (org-babel-noweb-wrap) "" (nth 1 info))
+ (if (org-babel-noweb-p (nth 2 info) :export)
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info))))
+ (org-fill-template
+ org-babel-exp-code-template
+ `(("lang" . ,(nth 0 info))
+ ("body" . ,(if (string= (nth 0 info) "org")
+ (replace-regexp-in-string "^" "," (nth 1 info))
+ (nth 1 info)))
+ ,@(mapcar (lambda (pair)
+ (cons (substring (symbol-name (car pair)) 1)
+ (format "%S" (cdr pair))))
+ (nth 2 info))
+ ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
+ ("name" . ,(or (nth 4 info) "")))))
+
+(defun org-babel-exp-results (info type &optional silent hash)
+ "Evaluate and return the results of the current code block for export.
+Results are prepared in a manner suitable for export by org-mode.
+This function is called by `org-babel-exp-do-export'. The code
+block will be evaluated. Optional argument SILENT can be used to
+inhibit insertion of results into the buffer."
+ (when (and org-export-babel-evaluate
+ (not (and hash (equal hash (org-babel-current-result-hash)))))
+ (let ((lang (nth 0 info))
+ (body (if (org-babel-noweb-p (nth 2 info) :eval)
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (info (copy-sequence info)))
+ ;; skip code blocks which we can't evaluate
+ (when (fboundp (intern (concat "org-babel-execute:" lang)))
+ (org-babel-eval-wipe-error-buffer)
+ (prog1 nil
+ (setf (nth 1 info) body)
+ (setf (nth 2 info)
+ (org-babel-exp-in-export-file lang
+ (org-babel-process-params
+ (org-babel-merge-params
+ (nth 2 info)
+ `((:results . ,(if silent "silent" "replace")))))))
+ (cond
+ ((equal type 'block)
+ (org-babel-execute-src-block nil info))
+ ((equal type 'inline)
+ ;; position the point on the inline source block allowing
+ ;; `org-babel-insert-result' to check that the block is
+ ;; inline
+ (re-search-backward "[ \f\t\n\r\v]" nil t)
+ (re-search-forward org-babel-inline-src-block-regexp nil t)
+ (re-search-backward "src_" nil t)
+ (org-babel-execute-src-block nil info))
+ ((equal type 'lob)
+ (save-excursion
+ (re-search-backward org-babel-lob-one-liner-regexp nil t)
+ (org-babel-execute-src-block nil info)))))))))
+
+(provide 'ob-exp)
+
+
+
+;;; ob-exp.el ends here
diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el
new file mode 100644
index 0000000..7f2d1a8
--- /dev/null
+++ b/lisp/ob-fortran.el
@@ -0,0 +1,162 @@
+;;; ob-fortran.el --- org-babel functions for fortran
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Authors: Sergey Litvinov
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research, fortran
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating fortran code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'cc-mode)
+
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
+
+(defvar org-babel-default-header-args:fortran '())
+
+(defvar org-babel-fortran-compiler "gfortran"
+ "fortran command used to compile a fortran source code file into an
+ executable.")
+
+(defun org-babel-execute:fortran (body params)
+ "This function should only be called by `org-babel-execute:fortran'"
+ (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
+ (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
+ (cmdline (cdr (assoc :cmdline params)))
+ (flags (cdr (assoc :flags params)))
+ (full-body (org-babel-expand-body:fortran body params))
+ (compile
+ (progn
+ (with-temp-file tmp-src-file (insert full-body))
+ (org-babel-eval
+ (format "%s -o %s %s %s"
+ org-babel-fortran-compiler
+ (org-babel-process-file-name tmp-bin-file)
+ (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-src-file)) ""))))
+ ((lambda (results)
+ (org-babel-reassemble-table
+ (if (member "vector" (cdr (assoc :result-params params)))
+ (let ((tmp-file (org-babel-temp-file "f-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))
+ (org-babel-read results))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+
+(defun org-babel-expand-body:fortran (body params)
+ "Expand a block of fortran or fortran code with org-babel according to
+it's header arguments."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (main-p (not (string= (cdr (assoc :main params)) "no")))
+ (includes (or (cdr (assoc :includes params))
+ (org-babel-read (org-entry-get nil "includes" t))))
+ (defines (org-babel-read
+ (or (cdr (assoc :defines params))
+ (org-babel-read (org-entry-get nil "defines" t))))))
+ (mapconcat 'identity
+ (list
+ ;; includes
+ (mapconcat
+ (lambda (inc) (format "#include %s" inc))
+ (if (listp includes) includes (list includes)) "\n")
+ ;; defines
+ (mapconcat
+ (lambda (inc) (format "#define %s" inc))
+ (if (listp defines) defines (list defines)) "\n")
+ ;; body
+ (if main-p
+ (org-babel-fortran-ensure-main-wrap
+ (concat
+ ;; variables
+ (mapconcat 'org-babel-fortran-var-to-fortran vars "\n")
+ body) params)
+ body) "\n") "\n")))
+
+(defun org-babel-fortran-ensure-main-wrap (body params)
+ "Wrap body in a \"program ... end program\" block if none exists."
+ (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if vars (error "Cannot use :vars if 'program' statement is present"))
+ body)
+ (format "program main\n%s\nend program main\n" body)))
+
+(defun org-babel-prep-session:fortran (session params)
+ "This function does nothing as fortran is a compiled language with no
+support for sessions"
+ (error "Fortran is a compiled languages -- no support for sessions"))
+
+(defun org-babel-load-session:fortran (session body params)
+ "This function does nothing as fortran is a compiled language with no
+support for sessions"
+ (error "Fortran is a compiled languages -- no support for sessions"))
+
+;; helper functions
+
+(defun org-babel-fortran-var-to-fortran (pair)
+ "Convert an elisp val into a string of fortran code specifying a var
+of the same value."
+ ;; TODO list support
+ (let ((var (car pair))
+ (val (cdr pair)))
+ (when (symbolp val)
+ (setq val (symbol-name val))
+ (when (= (length val) 1)
+ (setq val (string-to-char val))))
+ (cond
+ ((integerp val)
+ (format "integer, parameter :: %S = %S\n" var val))
+ ((floatp val)
+ (format "real, parameter :: %S = %S\n" var val))
+ ((or (integerp val))
+ (format "character, parameter :: %S = '%S'\n" var val))
+ ((stringp val)
+ (format "character(len=%d), parameter :: %S = '%s'\n"
+ (length val) var val))
+ ((listp val)
+ (format "real, parameter :: %S(%d) = %s\n"
+ var (length val) (org-babel-fortran-transform-list val)))
+ (t
+ (error (format "the type of parameter %s is not supported by ob-fortran"
+ var))))))
+
+(defun org-babel-fortran-transform-list (val)
+ "Return a fortran representation of enclose syntactic lists."
+ (if (listp val)
+ (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)")
+ (format "%S" val)))
+
+(provide 'ob-fortran)
+
+;;; ob-fortran.el ends here
diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el
new file mode 100644
index 0000000..55c4153
--- /dev/null
+++ b/lisp/ob-gnuplot.el
@@ -0,0 +1,236 @@
+;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating gnuplot source code.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) we are generally only going to return results of type "file"
+;;
+;; 2) we are adding the "file" and "cmdline" header arguments
+
+;;; Requirements:
+
+;; - gnuplot :: http://www.gnuplot.info/
+;;
+;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(eval-when-compile (require 'cl))
+
+(declare-function org-time-string-to-time "org" (s))
+(declare-function org-combine-plists "org" (&rest plists))
+(declare-function orgtbl-to-generic "org-table" (table params))
+(declare-function gnuplot-mode "ext:gnuplot-mode" ())
+(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt))
+(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ())
+
+(defvar org-babel-default-header-args:gnuplot
+ '((:results . "file") (:exports . "results") (:session . nil))
+ "Default arguments to use when evaluating a gnuplot source block.")
+
+(defvar org-babel-gnuplot-timestamp-fmt nil)
+
+(defun org-babel-gnuplot-process-vars (params)
+ "Extract variables from PARAMS and process the variables.
+Dumps all vectors into files and returns an association list
+of variable names and the related value to be used in the gnuplot
+code."
+ (mapcar
+ (lambda (pair)
+ (cons
+ (car pair) ;; variable name
+ (if (listp (cdr pair)) ;; variable value
+ (org-babel-gnuplot-table-to-data
+ (cdr pair) (org-babel-temp-file "gnuplot-") params)
+ (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-expand-body:gnuplot (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (save-window-excursion
+ (let* ((vars (org-babel-gnuplot-process-vars params))
+ (out-file (cdr (assoc :file params)))
+ (term (or (cdr (assoc :term params))
+ (when out-file (file-name-extension out-file))))
+ (cmdline (cdr (assoc :cmdline params)))
+ (title (plist-get params :title))
+ (lines (plist-get params :line))
+ (sets (plist-get params :set))
+ (x-labels (plist-get params :xlabels))
+ (y-labels (plist-get params :ylabels))
+ (timefmt (plist-get params :timefmt))
+ (time-ind (or (plist-get params :timeind)
+ (when timefmt 1)))
+ (add-to-body (lambda (text) (setq body (concat text "\n" body))))
+ output)
+ ;; append header argument settings to body
+ (when title (funcall add-to-body (format "set title '%s'" title))) ;; title
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
+ (when sets
+ (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
+ (when x-labels
+ (funcall add-to-body
+ (format "set xtics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ x-labels ", "))))
+ (when y-labels
+ (funcall add-to-body
+ (format "set ytics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ y-labels ", "))))
+ (when time-ind
+ (funcall add-to-body "set xdata time")
+ (funcall add-to-body (concat "set timefmt \""
+ (or timefmt
+ "%Y-%m-%d-%H:%M:%S") "\"")))
+ (when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
+ (when term (funcall add-to-body (format "set term %s" term)))
+ ;; insert variables into code body: this should happen last
+ ;; placing the variables at the *top* of the code in case their
+ ;; values are used later
+ (funcall add-to-body (mapconcat #'identity
+ (org-babel-variable-assignments:gnuplot params)
+ "\n"))
+ ;; replace any variable names preceded by '$' with the actual
+ ;; value of the variable
+ (mapc (lambda (pair)
+ (setq body (replace-regexp-in-string
+ (format "\\$%s" (car pair)) (cdr pair) body)))
+ vars))
+ body))
+
+(defun org-babel-execute:gnuplot (body params)
+ "Execute a block of Gnuplot code.
+This function is called by `org-babel-execute-src-block'."
+ (require 'gnuplot)
+ (let ((session (cdr (assoc :session params)))
+ (result-type (cdr (assoc :results params)))
+ (out-file (cdr (assoc :file params)))
+ (body (org-babel-expand-body:gnuplot body params))
+ output)
+ (save-window-excursion
+ ;; evaluate the code body with gnuplot
+ (if (string= session "none")
+ (let ((script-file (org-babel-temp-file "gnuplot-script-")))
+ (with-temp-file script-file
+ (insert (concat body "\n")))
+ (message "gnuplot \"%s\"" script-file)
+ (setq output
+ (shell-command-to-string
+ (format
+ "gnuplot \"%s\""
+ (org-babel-process-file-name
+ script-file
+ (if (member system-type '(cygwin windows-nt ms-dos))
+ t nil)))))
+ (message output))
+ (with-temp-buffer
+ (insert (concat body "\n"))
+ (gnuplot-mode)
+ (gnuplot-send-buffer-to-gnuplot)))
+ (if (member "output" (split-string result-type))
+ output
+ nil)))) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:gnuplot (session params)
+ "Prepare SESSION according to the header arguments in PARAMS."
+ (let* ((session (org-babel-gnuplot-initiate-session session))
+ (var-lines (org-babel-variable-assignments:gnuplot params)))
+ (message "%S" session)
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var-line)
+ (insert var-line) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1) (goto-char (point-max))) var-lines))
+ session))
+
+(defun org-babel-load-session:gnuplot (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:gnuplot session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+(defun org-babel-variable-assignments:gnuplot (params)
+ "Return list of gnuplot statements assigning the block's variables."
+ (mapcar
+ (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair)))
+ (org-babel-gnuplot-process-vars params)))
+
+(defvar gnuplot-buffer)
+(defun org-babel-gnuplot-initiate-session (&optional session params)
+ "Initiate a gnuplot session.
+If there is not a current inferior-process-buffer in SESSION
+then create one. Return the initialized session. The current
+`gnuplot-mode' doesn't provide support for multiple sessions."
+ (require 'gnuplot)
+ (unless (string= session "none")
+ (save-window-excursion
+ (gnuplot-send-string-to-gnuplot "" "line")
+ gnuplot-buffer)))
+
+(defun org-babel-gnuplot-quote-timestamp-field (s)
+ "Convert S from timestamp to Unix time and export to gnuplot."
+ (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s)))
+
+(defvar org-table-number-regexp)
+(defvar org-ts-regexp3)
+(defun org-babel-gnuplot-quote-tsv-field (s)
+ "Quote S for export to gnuplot."
+ (unless (stringp s)
+ (setq s (format "%s" s)))
+ (if (string-match org-table-number-regexp s) s
+ (if (string-match org-ts-regexp3 s)
+ (org-babel-gnuplot-quote-timestamp-field s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
+
+(defun org-babel-gnuplot-table-to-data (table data-file params)
+ "Export TABLE to DATA-FILE in a format readable by gnuplot.
+Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
+ (with-temp-file data-file
+ (make-local-variable 'org-babel-gnuplot-timestamp-fmt)
+ (setq org-babel-gnuplot-timestamp-fmt (or
+ (plist-get params :timefmt)
+ "%Y-%m-%d-%H:%M:%S"))
+ (insert (orgtbl-to-generic
+ table
+ (org-combine-plists
+ '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
+ params))))
+ data-file)
+
+(provide 'ob-gnuplot)
+
+
+
+;;; ob-gnuplot.el ends here
diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el
new file mode 100644
index 0000000..1588f99
--- /dev/null
+++ b/lisp/ob-haskell.el
@@ -0,0 +1,217 @@
+;;; ob-haskell.el --- org-babel functions for haskell evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating haskell source code. This one will
+;; be sort of tricky because haskell programs must be compiled before
+;; they can be run, but haskell code can also be run through an
+;; interactive interpreter.
+;;
+;; For now lets only allow evaluation using the haskell interpreter.
+
+;;; Requirements:
+
+;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
+;;
+;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode
+;;
+;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/
+
+;;; Code:
+(require 'ob)
+(require 'ob-comint)
+(require 'comint)
+(eval-when-compile (require 'cl))
+
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function haskell-mode "ext:haskell-mode" ())
+(declare-function run-haskell "ext:inf-haskell" (&optional arg))
+(declare-function inferior-haskell-load-file
+ "ext:inf-haskell" (&optional reload))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
+
+(defvar org-babel-default-header-args:haskell '())
+
+(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
+
+(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"")
+
+(defun org-babel-execute:haskell (body params)
+ "Execute a block of Haskell code."
+ (let* ((session (cdr (assoc :session params)))
+ (vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params
+ (org-babel-variable-assignments:haskell params)))
+ (session (org-babel-haskell-initiate-session session params))
+ (raw (org-babel-comint-with-output
+ (session org-babel-haskell-eoe t full-body)
+ (insert (org-babel-trim full-body))
+ (comint-send-input nil t)
+ (insert org-babel-haskell-eoe)
+ (comint-send-input nil t)))
+ (results (mapcar
+ #'org-babel-haskell-read-string
+ (cdr (member org-babel-haskell-eoe
+ (reverse (mapcar #'org-babel-trim raw)))))))
+ (org-babel-reassemble-table
+ (cond
+ ((equal result-type 'output)
+ (mapconcat #'identity (reverse (cdr results)) "\n"))
+ ((equal result-type 'value)
+ (org-babel-haskell-table-or-string (car results))))
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colname-names params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rowname-names params))))))
+
+(defun org-babel-haskell-read-string (string)
+ "Strip \\\"s from around a haskell string."
+ (if (string-match "^\"\\([^\000]+\\)\"$" string)
+ (match-string 1 string)
+ string))
+
+(defun org-babel-haskell-initiate-session (&optional session params)
+ "Initiate a haskell session.
+If there is not a current inferior-process-buffer in SESSION
+then create one. Return the initialized session."
+ (require 'inf-haskell)
+ (or (get-buffer "*haskell*")
+ (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer))))
+
+(defun org-babel-load-session:haskell (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let* ((buffer (org-babel-prep-session:haskell session params))
+ (load-file (concat (org-babel-temp-file "haskell-load-") ".hs")))
+ (with-temp-buffer
+ (insert body) (write-file load-file)
+ (haskell-mode) (inferior-haskell-load-file))
+ buffer)))
+
+(defun org-babel-prep-session:haskell (session params)
+ "Prepare SESSION according to the header arguments in PARAMS."
+ (save-window-excursion
+ (let ((buffer (org-babel-haskell-initiate-session session)))
+ (org-babel-comint-in-buffer buffer
+ (mapc (lambda (line)
+ (insert line)
+ (comint-send-input nil t))
+ (org-babel-variable-assignments:haskell params)))
+ (current-buffer))))
+
+(defun org-babel-variable-assignments:haskell (params)
+ "Return list of haskell statements assigning the block's variables."
+ (mapcar (lambda (pair)
+ (format "let %s = %s"
+ (car pair)
+ (org-babel-haskell-var-to-haskell (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-haskell-table-or-string (results)
+ "Convert RESULTS to an Emacs-lisp table or string.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+(defun org-babel-haskell-var-to-haskell (var)
+ "Convert an elisp value VAR into a haskell variable.
+The elisp VAR is converted to a string of haskell source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]")
+ (format "%S" var)))
+
+(defvar org-src-preserve-indentation)
+(defun org-babel-haskell-export-to-lhs (&optional arg)
+ "Export to a .lhs file with all haskell code blocks escaped.
+When called with a prefix argument the resulting
+.lhs file will be exported to a .tex file. This function will
+create two new files, base-name.lhs and base-name.tex where
+base-name is the name of the current org-mode file.
+
+Note that all standard Babel literate programming
+constructs (header arguments, no-web syntax etc...) are ignored."
+ (interactive "P")
+ (let* ((contents (buffer-string))
+ (haskell-regexp
+ (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]"
+ "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*"))
+ (base-name (file-name-sans-extension (buffer-file-name)))
+ (tmp-file (org-babel-temp-file "haskell-"))
+ (tmp-org-file (concat tmp-file ".org"))
+ (tmp-tex-file (concat tmp-file ".tex"))
+ (lhs-file (concat base-name ".lhs"))
+ (tex-file (concat base-name ".tex"))
+ (command (concat org-babel-haskell-lhs2tex-command
+ " " (org-babel-process-file-name lhs-file)
+ " > " (org-babel-process-file-name tex-file)))
+ (preserve-indentp org-src-preserve-indentation)
+ indentation)
+ ;; escape haskell source-code blocks
+ (with-temp-file tmp-org-file
+ (insert contents)
+ (goto-char (point-min))
+ (while (re-search-forward haskell-regexp nil t)
+ (save-match-data (setq indentation (length (match-string 1))))
+ (replace-match (save-match-data
+ (concat
+ "#+begin_latex\n\\begin{code}\n"
+ (if (or preserve-indentp
+ (string-match "-i" (match-string 2)))
+ (match-string 3)
+ (org-remove-indentation (match-string 3)))
+ "\n\\end{code}\n#+end_latex\n"))
+ t t)
+ (indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
+ (save-excursion
+ ;; export to latex w/org and save as .lhs
+ (find-file tmp-org-file) (funcall 'org-export-as-latex nil)
+ (kill-buffer nil)
+ (delete-file tmp-org-file)
+ (find-file tmp-tex-file)
+ (goto-char (point-min)) (forward-line 2)
+ (insert "%include polycode.fmt\n")
+ ;; ensure all \begin/end{code} statements start at the first column
+ (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t)
+ (replace-match (save-match-data (org-remove-indentation (match-string 0)))
+ t t))
+ (setq contents (buffer-string))
+ (save-buffer) (kill-buffer nil))
+ (delete-file tmp-tex-file)
+ ;; save org exported latex to a .lhs file
+ (with-temp-file lhs-file (insert contents))
+ (if (not arg)
+ (find-file lhs-file)
+ ;; process .lhs file with lhs2tex
+ (message "running %s" command) (shell-command command) (find-file tex-file))))
+
+(provide 'ob-haskell)
+
+
+
+;;; ob-haskell.el ends here
diff --git a/lisp/ob-io.el b/lisp/ob-io.el
new file mode 100644
index 0000000..2064826
--- /dev/null
+++ b/lisp/ob-io.el
@@ -0,0 +1,122 @@
+;;; ob-io.el --- org-babel functions for Io evaluation
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Andrzej Lichnerowicz
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Currently only supports the external execution. No session support yet.
+;; :results output -- runs in scripting mode
+;; :results output repl -- runs in repl mode
+
+;;; Requirements:
+;; - Io language :: http://iolanguage.org/
+;; - Io major mode :: Can be installed from Io sources
+;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
+(defvar org-babel-default-header-args:io '())
+(defvar org-babel-io-command "io"
+ "Name of the command to use for executing Io code.")
+
+
+(defun org-babel-execute:io (body params)
+ "Execute a block of Io code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Io source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-io-initiate-session (nth 0 processed-params)))
+ (vars (nth 1 processed-params))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-io-evaluate
+ session full-body result-type result-params)))
+
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+
+(defun org-babel-io-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+
+(defvar org-babel-io-wrapper-method
+ "(
+%s
+) asString print
+")
+
+
+(defun org-babel-io-evaluate (session body &optional result-type result-params)
+ "Evaluate BODY in external Io process.
+If RESULT-TYPE equals 'output then return standard output as a string.
+If RESULT-TYPE equals 'value then return the value of the last statement
+in BODY as elisp."
+ (when session (error "Sessions are not (yet) supported for Io"))
+ (case result-type
+ (output
+ (if (member "repl" result-params)
+ (org-babel-eval org-babel-io-command body)
+ (let ((src-file (org-babel-temp-file "io-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))))
+ (value (let* ((src-file (org-babel-temp-file "io-"))
+ (wrapper (format org-babel-io-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ ((lambda (raw)
+ (if (member "code" result-params)
+ raw
+ (org-babel-io-table-or-string raw)))
+ (org-babel-eval
+ (concat org-babel-io-command " " src-file) ""))))))
+
+
+(defun org-babel-prep-session:io (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Io"))
+
+(defun org-babel-io-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Io."
+ nil)
+
+(provide 'ob-io)
+
+
+
+;;; ob-io.el ends here
diff --git a/lisp/ob-java.el b/lisp/ob-java.el
new file mode 100644
index 0000000..75afda1
--- /dev/null
+++ b/lisp/ob-java.el
@@ -0,0 +1,77 @@
+;;; ob-java.el --- org-babel functions for java evaluation
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Currently this only supports the external compilation and execution
+;; of java code blocks (i.e., no session support).
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
+
+(defvar org-babel-java-command "java"
+ "Name of the java command.")
+
+(defvar org-babel-java-compiler "javac"
+ "Name of the java compiler.")
+
+(defun org-babel-execute:java (body params)
+ (let* ((classname (or (cdr (assoc :classname params))
+ (error
+ "Can't compile a java block without a classname")))
+ (packagename (file-name-directory classname))
+ (src-file (concat classname ".java"))
+ (cmpflag (or (cdr (assoc :cmpflag params)) ""))
+ (cmdline (or (cdr (assoc :cmdline params)) ""))
+ (full-body (org-babel-expand-body:generic body params))
+ (compile
+ (progn (with-temp-file src-file (insert full-body))
+ (org-babel-eval
+ (concat org-babel-java-compiler
+ " " cmpflag " " src-file) ""))))
+ ;; created package-name directories if missing
+ (unless (or (not packagename) (file-exists-p packagename))
+ (make-directory packagename 'parents))
+ ((lambda (results)
+ (org-babel-reassemble-table
+ (if (member "vector" (cdr (assoc :result-params params)))
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))
+ (org-babel-read results))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ (org-babel-eval (concat org-babel-java-command
+ " " cmdline " " classname) ""))))
+
+(provide 'ob-java)
+
+
+
+;;; ob-java.el ends here
diff --git a/lisp/ob-js.el b/lisp/ob-js.el
new file mode 100644
index 0000000..2138172
--- /dev/null
+++ b/lisp/ob-js.el
@@ -0,0 +1,163 @@
+;;; ob-js.el --- org-babel functions for Javascript
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, js
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Now working with SBCL for both session and external evaluation.
+;;
+;; This certainly isn't optimally robust, but it seems to be working
+;; for the basic use cases.
+
+;;; Requirements:
+
+;; - a non-browser javascript engine such as node.js http://nodejs.org/
+;; or mozrepl http://wiki.github.com/bard/mozrepl/
+;;
+;; - for session based evaluation mozrepl and moz.el are required see
+;; http://wiki.github.com/bard/mozrepl/emacs-integration for
+;; configuration instructions
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function run-mozilla "ext:moz" (arg))
+
+(defvar org-babel-default-header-args:js '()
+ "Default header arguments for js code blocks.")
+
+(defvar org-babel-js-eoe "org-babel-js-eoe"
+ "String to indicate that evaluation has completed.")
+
+(defcustom org-babel-js-cmd "node"
+ "Name of command used to evaluate js blocks."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defvar org-babel-js-function-wrapper
+ "require('sys').print(require('sys').inspect(function(){%s}()));"
+ "Javascript code to print value of body.")
+
+(defun org-babel-execute:js (body params)
+ "Execute a block of Javascript code with org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:js params))))
+ (org-babel-js-read
+ (if (not (string= (cdr (assoc :session params)) "none"))
+ ;; session evaluation
+ (let ((session (org-babel-prep-session:js
+ (cdr (assoc :session params)) params)))
+ (nth 1
+ (org-babel-comint-with-output
+ (session (format "%S" org-babel-js-eoe) t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (list body (format "%S" org-babel-js-eoe))))))
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "js-script-")))
+ (with-temp-file script-file
+ (insert
+ ;; return the value or the output
+ (if (string= result-type "value")
+ (format org-babel-js-function-wrapper full-body)
+ full-body)))
+ (org-babel-eval
+ (format "%s %s" org-babel-js-cmd
+ (org-babel-process-file-name script-file)) ""))))))
+
+(defun org-babel-js-read (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-read
+ (if (and (stringp results) (string-match "^\\[.+\\]$" results))
+ (org-babel-read
+ (concat "'"
+ (replace-regexp-in-string
+ "\\[" "(" (replace-regexp-in-string
+ "\\]" ")" (replace-regexp-in-string
+ ", " " " (replace-regexp-in-string
+ "'" "\"" results))))))
+ results)))
+
+(defun org-babel-js-var-to-js (var)
+ "Convert VAR into a js variable.
+Convert an elisp value into a string of js source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]")
+ (format "%S" var)))
+
+(defun org-babel-prep-session:js (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-js-initiate-session session))
+ (var-lines (org-babel-variable-assignments:js params)))
+ (when session
+ (org-babel-comint-in-buffer session
+ (sit-for .5) (goto-char (point-max))
+ (mapc (lambda (var)
+ (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1) (goto-char (point-max))) var-lines)))
+ session))
+
+(defun org-babel-variable-assignments:js (params)
+ "Return list of Javascript statements assigning the block's variables."
+ (mapcar
+ (lambda (pair) (format "var %s=%s;"
+ (car pair) (org-babel-js-var-to-js (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-js-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (unless (string= session "none")
+ (cond
+ ((string= "mozrepl" org-babel-js-cmd)
+ (require 'moz)
+ (let ((session-buffer (save-window-excursion
+ (run-mozilla nil)
+ (rename-buffer session)
+ (current-buffer))))
+ (if (org-babel-comint-buffer-livep session-buffer)
+ (progn (sit-for .25) session-buffer)
+ (sit-for .5)
+ (org-babel-js-initiate-session session))))
+ ((string= "node" org-babel-js-cmd )
+ (error "Session evaluation with node.js is not supported"))
+ (t
+ (error "Sessions are only supported with mozrepl add \":cmd mozrepl\"")))))
+
+(provide 'ob-js)
+
+
+
+;;; ob-js.el ends here
diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el
new file mode 100644
index 0000000..759bef3
--- /dev/null
+++ b/lisp/ob-keys.el
@@ -0,0 +1,103 @@
+;;; ob-keys.el --- key bindings for org-babel
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Add org-babel keybindings to the org-mode keymap for exposing
+;; org-babel functions. These will all share a common prefix. See
+;; the value of `org-babel-key-bindings' for a list of interactive
+;; functions and their associated keys.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-key-prefix "\C-c\C-v"
+ "The key prefix for Babel interactive key-bindings.
+See `org-babel-key-bindings' for the list of interactive babel
+functions which are assigned key bindings, and see
+`org-babel-map' for the actual babel keymap.")
+
+(defvar org-babel-map (make-sparse-keymap)
+ "The keymap for interactive Babel functions.")
+
+;;;###autoload
+(defun org-babel-describe-bindings ()
+ "Describe all keybindings behind `org-babel-key-prefix'."
+ (interactive)
+ (describe-bindings org-babel-key-prefix))
+
+(defvar org-babel-key-bindings
+ '(("p" . org-babel-previous-src-block)
+ ("\C-p" . org-babel-previous-src-block)
+ ("n" . org-babel-next-src-block)
+ ("\C-n" . org-babel-next-src-block)
+ ("e" . org-babel-execute-maybe)
+ ("\C-e" . org-babel-execute-maybe)
+ ("o" . org-babel-open-src-block-result)
+ ("\C-o" . org-babel-open-src-block-result)
+ ("\C-v" . org-babel-expand-src-block)
+ ("v" . org-babel-expand-src-block)
+ ("u" . org-babel-goto-src-block-head)
+ ("\C-u" . org-babel-goto-src-block-head)
+ ("g" . org-babel-goto-named-src-block)
+ ("r" . org-babel-goto-named-result)
+ ("\C-r" . org-babel-goto-named-result)
+ ("\C-b" . org-babel-execute-buffer)
+ ("b" . org-babel-execute-buffer)
+ ("\C-s" . org-babel-execute-subtree)
+ ("s" . org-babel-execute-subtree)
+ ("\C-d" . org-babel-demarcate-block)
+ ("d" . org-babel-demarcate-block)
+ ("\C-t" . org-babel-tangle)
+ ("t" . org-babel-tangle)
+ ("\C-f" . org-babel-tangle-file)
+ ("f" . org-babel-tangle-file)
+ ("\C-c" . org-babel-check-src-block)
+ ("c" . org-babel-check-src-block)
+ ("\C-j" . org-babel-insert-header-arg)
+ ("j" . org-babel-insert-header-arg)
+ ("\C-l" . org-babel-load-in-session)
+ ("l" . org-babel-load-in-session)
+ ("\C-i" . org-babel-lob-ingest)
+ ("i" . org-babel-lob-ingest)
+ ("\C-I" . org-babel-view-src-block-info)
+ ("I" . org-babel-view-src-block-info)
+ ("\C-z" . org-babel-switch-to-session)
+ ("z" . org-babel-switch-to-session-with-code)
+ ("\C-a" . org-babel-sha1-hash)
+ ("a" . org-babel-sha1-hash)
+ ("h" . org-babel-describe-bindings)
+ ("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
+ ("x" . org-babel-do-key-sequence-in-edit-buffer)
+ ("\C-\M-h" . org-babel-mark-block))
+ "Alist of key bindings and interactive Babel functions.
+This list associates interactive Babel functions
+with keys. Each element of this list will add an entry to the
+`org-babel-map' using the letter key which is the `car' of the
+a-list placed behind the generic `org-babel-key-prefix'.")
+
+(provide 'ob-keys)
+
+
+
+;;; ob-keys.el ends here
diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el
new file mode 100644
index 0000000..43f673e
--- /dev/null
+++ b/lisp/ob-latex.el
@@ -0,0 +1,200 @@
+;;; ob-latex.el --- org-babel functions for latex "evaluation"
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating LaTeX source code.
+;;
+;; Currently on evaluation this returns raw LaTeX code, unless a :file
+;; header argument is given in which case small png or pdf files will
+;; be created directly form the latex source code.
+
+;;; Code:
+(require 'ob)
+
+(declare-function org-create-formula-image "org" (string tofile options buffer))
+(declare-function org-splice-latex-header "org"
+ (tpl def-pkg pkg snippets-p &optional extra))
+(declare-function org-export-latex-fix-inputenc "org-latex" ())
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
+
+(defvar org-format-latex-header)
+(defvar org-format-latex-header-extra)
+(defvar org-export-latex-packages-alist)
+(defvar org-export-latex-default-packages-alist)
+(defvar org-export-pdf-logfiles)
+(defvar org-latex-to-pdf-process)
+(defvar org-export-pdf-remove-logfiles)
+(defvar org-format-latex-options)
+(defvar org-export-latex-packages-alist)
+
+(defvar org-babel-default-header-args:latex
+ '((:results . "latex") (:exports . "results"))
+ "Default arguments to use when evaluating a LaTeX source block.")
+
+(defun org-babel-expand-body:latex (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (mapc (lambda (pair) ;; replace variables
+ (setq body
+ (replace-regexp-in-string
+ (regexp-quote (format "%S" (car pair)))
+ (if (stringp (cdr pair))
+ (cdr pair) (format "%S" (cdr pair)))
+ body))) (mapcar #'cdr (org-babel-get-header params :var)))
+ (org-babel-trim body))
+
+(defun org-babel-execute:latex (body params)
+ "Execute a block of Latex code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (setq body (org-babel-expand-body:latex body params))
+ (if (cdr (assoc :file params))
+ (let* ((out-file (cdr (assoc :file params)))
+ (tex-file (org-babel-temp-file "latex-" ".tex"))
+ (border (cdr (assoc :border params)))
+ (imagemagick (cdr (assoc :imagemagick params)))
+ (im-in-options (cdr (assoc :iminoptions params)))
+ (im-out-options (cdr (assoc :imoutoptions params)))
+ (pdfpng (cdr (assoc :pdfpng params)))
+ (fit (or (cdr (assoc :fit params)) border))
+ (height (and fit (cdr (assoc :pdfheight params))))
+ (width (and fit (cdr (assoc :pdfwidth params))))
+ (headers (cdr (assoc :headers params)))
+ (in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
+ (org-export-latex-packages-alist
+ (append (cdr (assoc :packages params))
+ org-export-latex-packages-alist)))
+ (cond
+ ((and (string-match "\\.png$" out-file) (not imagemagick))
+ (org-create-formula-image
+ body out-file org-format-latex-options in-buffer))
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
+ (require 'org-latex)
+ (with-temp-file tex-file
+ (insert
+ (org-splice-latex-header
+ org-format-latex-header
+ (delq
+ nil
+ (mapcar
+ (lambda (el)
+ (unless (and (listp el) (string= "hyperref" (cadr el)))
+ el))
+ org-export-latex-default-packages-alist))
+ org-export-latex-packages-alist
+ org-format-latex-header-extra)
+ (if fit "\n\\usepackage[active, tightpage]{preview}\n" "")
+ (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "")
+ (if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
+ (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "")
+ (if headers
+ (concat "\n"
+ (if (listp headers)
+ (mapconcat #'identity headers "\n")
+ headers) "\n")
+ "")
+ (if org-format-latex-header-extra
+ (concat "\n" org-format-latex-header-extra)
+ "")
+ (if fit
+ (concat "\n\\begin{document}\n\\begin{preview}\n" body
+ "\n\\end{preview}\n\\end{document}\n")
+ (concat "\n\\begin{document}\n" body "\n\\end{document}\n")))
+ (org-export-latex-fix-inputenc))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
+ (cond
+ ((string-match "\\.pdf$" out-file)
+ (rename-file transient-pdf-file out-file))
+ (imagemagick
+ (convert-pdf
+ transient-pdf-file out-file im-in-options im-out-options)
+ (when (file-exists-p transient-pdf-file)
+ (delete-file transient-pdf-file))))))
+ ((string-match "\\.\\([^\\.]+\\)$" out-file)
+ (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
+ (match-string 1 out-file))))
+ nil) ;; signal that output has already been written to file
+ body))
+
+
+(defun convert-pdf (pdffile out-file im-in-options im-out-options)
+ "Generate a file from a pdf file using imagemagick."
+ (let ((cmd (concat "convert " im-in-options " " pdffile " "
+ im-out-options " " out-file)))
+ (message (concat "Converting pdffile file " cmd "..."))
+ (shell-command cmd)))
+
+(defun org-babel-latex-tex-to-pdf (file)
+ "Generate a pdf file according to the contents FILE.
+Extracted from `org-export-as-pdf' in org-latex.el."
+ (let* ((wconfig (current-window-configuration))
+ (default-directory (file-name-directory file))
+ (base (file-name-sans-extension file))
+ (pdffile (concat base ".pdf"))
+ (cmds org-latex-to-pdf-process)
+ (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
+ output-dir cmd)
+ (with-current-buffer outbuf (erase-buffer))
+ (message (concat "Processing LaTeX file " file "..."))
+ (setq output-dir (file-name-directory file))
+ (if (and cmds (symbolp cmds))
+ (funcall cmds (shell-quote-argument file))
+ (while cmds
+ (setq cmd (pop cmds))
+ (while (string-match "%b" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument base))
+ t t cmd)))
+ (while (string-match "%f" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument file))
+ t t cmd)))
+ (while (string-match "%o" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument output-dir))
+ t t cmd)))
+ (shell-command cmd outbuf)))
+ (message (concat "Processing LaTeX file " file "...done"))
+ (if (not (file-exists-p pdffile))
+ (error (concat "PDF file " pdffile " was not produced"))
+ (set-window-configuration wconfig)
+ (when org-export-pdf-remove-logfiles
+ (dolist (ext org-export-pdf-logfiles)
+ (setq file (concat base "." ext))
+ (and (file-exists-p file) (delete-file file))))
+ (message "Exporting to PDF...done")
+ pdffile)))
+
+(defun org-babel-prep-session:latex (session params)
+ "Return an error because LaTeX doesn't support sessions."
+ (error "LaTeX does not support sessions"))
+
+(provide 'ob-latex)
+
+
+
+;;; ob-latex.el ends here
diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el
new file mode 100644
index 0000000..2635730
--- /dev/null
+++ b/lisp/ob-ledger.el
@@ -0,0 +1,71 @@
+;;; ob-ledger.el --- org-babel functions for ledger evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric S Fraga
+;; Keywords: literate programming, reproducible research, accounting
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating ledger entries.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in ledger
+;;
+;; 2) we are generally only going to return output from the ledger program
+;;
+;; 3) we are adding the "cmdline" header argument
+;;
+;; 4) there are no variables
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-default-header-args:ledger
+ '((:results . "output") (:cmdline . "bal"))
+ "Default arguments to use when evaluating a ledger source block.")
+
+(defun org-babel-execute:ledger (body params)
+ "Execute a block of Ledger entries with org-babel. This function is
+called by `org-babel-execute-src-block'."
+ (message "executing Ledger source code block")
+ (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (cmdline (cdr (assoc :cmdline params)))
+ (in-file (org-babel-temp-file "ledger-"))
+ (out-file (org-babel-temp-file "ledger-output-")))
+ (with-temp-file in-file (insert body))
+ (message "%s" (concat "ledger"
+ " -f " (org-babel-process-file-name in-file)
+ " " cmdline))
+ (with-output-to-string
+ (shell-command (concat "ledger"
+ " -f " (org-babel-process-file-name in-file)
+ " " cmdline
+ " > " (org-babel-process-file-name out-file))))
+ (with-temp-buffer (insert-file-contents out-file) (buffer-string))))
+
+(defun org-babel-prep-session:ledger (session params)
+ (error "Ledger does not support sessions"))
+
+(provide 'ob-ledger)
+
+
+
+;;; ob-ledger.el ends here
diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el
new file mode 100644
index 0000000..6ee1949
--- /dev/null
+++ b/lisp/ob-lilypond.el
@@ -0,0 +1,436 @@
+;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Martyn Jago
+;; Keywords: babel language, literate programming
+;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
+
+;; 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:
+
+;; Installation, ob-lilypond documentation, and examples are available at
+;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html
+;;
+;; Lilypond documentation can be found at
+;; http://lilypond.org/manuals.html
+
+;;; Code:
+
+(require 'ob)
+(require 'ob-eval)
+(require 'ob-tangle)
+(require 'outline)
+(defalias 'lilypond-mode 'LilyPond-mode)
+
+(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly"))
+
+(defvar org-babel-default-header-args:lilypond '()
+ "Default header arguments for lilypond code blocks.
+NOTE: The arguments are determined at lilypond compile time.
+See (ly-set-header-args)")
+
+(defvar ly-compile-post-tangle t
+ "Following the org-babel-tangle (C-c C-v t) command,
+ly-compile-post-tangle determines whether ob-lilypond should
+automatically attempt to compile the resultant tangled file.
+If the value is nil, no automated compilation takes place.
+Default value is t")
+
+(defvar ly-display-pdf-post-tangle t
+ "Following a successful LilyPond compilation
+ly-display-pdf-post-tangle determines whether to automate the
+drawing / redrawing of the resultant pdf. If the value is nil,
+the pdf is not automatically redrawn. Default value is t")
+
+(defvar ly-play-midi-post-tangle t
+ "Following a successful LilyPond compilation
+ly-play-midi-post-tangle determines whether to automate the
+playing of the resultant midi file. If the value is nil,
+the midi file is not automatically played. Default value is t")
+
+(defvar ly-OSX-ly-path
+ "/Applications/lilypond.app/Contents/Resources/bin/lilypond")
+(defvar ly-OSX-pdf-path "open")
+(defvar ly-OSX-midi-path "open")
+
+(defvar ly-nix-ly-path "/usr/bin/lilypond")
+(defvar ly-nix-pdf-path "evince")
+(defvar ly-nix-midi-path "timidity")
+
+(defvar ly-win32-ly-path "lilypond")
+(defvar ly-win32-pdf-path "")
+(defvar ly-win32-midi-path "")
+
+(defvar ly-gen-png nil
+ "Image generation (png) can be turned on by default by setting
+LY-GEN-PNG to t")
+
+(defvar ly-gen-svg nil
+ "Image generation (SVG) can be turned on by default by setting
+LY-GEN-SVG to t")
+
+(defvar ly-gen-html nil
+ "HTML generation can be turned on by default by setting
+LY-GEN-HTML to t")
+
+(defvar ly-gen-pdf nil
+ "PDF generation can be turned on by default by setting
+LY-GEN-PDF to t")
+
+(defvar ly-use-eps nil
+ "You can force the compiler to use the EPS backend by setting
+LY-USE-EPS to t")
+
+(defvar ly-arrange-mode nil
+ "Arrange mode is turned on by setting LY-ARRANGE-MODE
+to t. In Arrange mode the following settings are altered
+from default...
+:tangle yes, :noweb yes
+:results silent :comments yes.
+In addition lilypond block execution causes tangling of all lilypond
+blocks")
+
+(defun org-babel-expand-body:lilypond (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapc
+ (lambda (pair)
+ (let ((name (symbol-name (car pair)))
+ (value (cdr pair)))
+ (setq body
+ (replace-regexp-in-string
+ (concat "\$" (regexp-quote name))
+ (if (stringp value) value (format "%S" value))
+ body))))
+ vars)
+ body))
+
+(defun org-babel-execute:lilypond (body params)
+ "This function is called by `org-babel-execute-src-block'.
+Depending on whether we are in arrange mode either:
+1. Attempt to execute lilypond block according to header settings
+ (This is the default basic mode)
+2. Tangle all lilypond blocks and process the result (arrange mode)"
+ (ly-set-header-args ly-arrange-mode)
+ (if ly-arrange-mode
+ (ly-tangle)
+ (ly-process-basic body params)))
+
+(defun ly-tangle ()
+ "ob-lilypond specific tangle, attempts to invoke
+=ly-execute-tangled-ly= if tangle is successful. Also passes
+specific arguments to =org-babel-tangle="
+ (interactive)
+ (if (org-babel-tangle nil "yes" "lilypond")
+ (ly-execute-tangled-ly) nil))
+
+(defun ly-process-basic (body params)
+ "Execute a lilypond block in basic mode."
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (out-file (cdr (assoc :file params)))
+ (cmdline (or (cdr (assoc :cmdline params))
+ ""))
+ (in-file (org-babel-temp-file "lilypond-")))
+
+ (with-temp-file in-file
+ (insert (org-babel-expand-body:generic body params)))
+ (org-babel-eval
+ (concat
+ (ly-determine-ly-path)
+ " -dbackend=eps "
+ "-dno-gs-load-fonts "
+ "-dinclude-eps-fonts "
+ "--png "
+ "--output="
+ (file-name-sans-extension out-file)
+ " "
+ cmdline
+ in-file) "")) nil)
+
+(defun org-babel-prep-session:lilypond (session params)
+ "Return an error because LilyPond exporter does not support sessions."
+ (error "Sorry, LilyPond does not currently support sessions!"))
+
+(defun ly-execute-tangled-ly ()
+ "Compile result of block tangle with lilypond.
+If error in compilation, attempt to mark the error in lilypond org file"
+ (when ly-compile-post-tangle
+ (let ((ly-tangled-file (ly-switch-extension
+ (buffer-file-name) ".lilypond"))
+ (ly-temp-file (ly-switch-extension
+ (buffer-file-name) ".ly")))
+ (if (file-exists-p ly-tangled-file)
+ (progn
+ (when (file-exists-p ly-temp-file)
+ (delete-file ly-temp-file))
+ (rename-file ly-tangled-file
+ ly-temp-file))
+ (error "Error: Tangle Failed!") t)
+ (switch-to-buffer-other-window "*lilypond*")
+ (erase-buffer)
+ (ly-compile-lilyfile ly-temp-file)
+ (goto-char (point-min))
+ (if (not (ly-check-for-compile-error ly-temp-file))
+ (progn
+ (other-window -1)
+ (ly-attempt-to-open-pdf ly-temp-file)
+ (ly-attempt-to-play-midi ly-temp-file))
+ (error "Error in Compilation!")))) nil)
+
+(defun ly-compile-lilyfile (file-name &optional test)
+ "Compile lilypond file and check for compile errors
+FILE-NAME is full path to lilypond (.ly) file"
+ (message "Compiling LilyPond...")
+ (let ((arg-1 (ly-determine-ly-path)) ;program
+ (arg-2 nil) ;infile
+ (arg-3 "*lilypond*") ;buffer
+ (arg-4 t) ;display
+ (arg-4 t) ;display
+ (arg-5 (if ly-gen-png "--png" "")) ;&rest...
+ (arg-6 (if ly-gen-html "--html" ""))
+ (arg-7 (if ly-gen-pdf "--pdf" ""))
+ (arg-8 (if ly-use-eps "-dbackend=eps" ""))
+ (arg-9 (if ly-gen-svg "-dbackend=svg" ""))
+ (arg-10 (concat "--output=" (file-name-sans-extension file-name)))
+ (arg-11 file-name))
+ (if test
+ `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
+ ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
+ (call-process
+ arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
+ arg-7 arg-8 arg-9 arg-10 arg-11))))
+
+(defun ly-check-for-compile-error (file-name &optional test)
+ "Check for compile error.
+This is performed by parsing the *lilypond* buffer
+containing the output message from the compilation.
+FILE-NAME is full path to lilypond file.
+If TEST is t just return nil if no error found, and pass
+nil as file-name since it is unused in this context"
+ (let ((is-error (search-forward "error:" nil t)))
+ (if (not test)
+ (if (not is-error)
+ nil
+ (ly-process-compile-error file-name))
+ is-error)))
+
+(defun ly-process-compile-error (file-name)
+ "Process the compilation error that has occurred.
+FILE-NAME is full path to lilypond file"
+ (let ((line-num (ly-parse-line-num)))
+ (let ((error-lines (ly-parse-error-line file-name line-num)))
+ (ly-mark-error-line file-name error-lines)
+ (error "Error: Compilation Failed!"))))
+
+(defun ly-mark-error-line (file-name line)
+ "Mark the erroneous lines in the lilypond org buffer.
+FILE-NAME is full path to lilypond file.
+LINE is the erroneous line"
+ (switch-to-buffer-other-window
+ (concat (file-name-nondirectory
+ (ly-switch-extension file-name ".org"))))
+ (let ((temp (point)))
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (if (search-forward line nil t)
+ (progn
+ (show-all)
+ (set-mark (point))
+ (goto-char (- (point) (length line))))
+ (goto-char temp))))
+
+(defun ly-parse-line-num (&optional buffer)
+ "Extract error line number."
+ (when buffer
+ (set-buffer buffer))
+ (let ((start
+ (and (search-backward ":" nil t)
+ (search-backward ":" nil t)
+ (search-backward ":" nil t)
+ (search-backward ":" nil t)))
+ (num nil))
+ (if start
+ (progn
+ (forward-char)
+ (let ((num (buffer-substring
+ (+ 1 start)
+ (- (search-forward ":" nil t) 1))))
+ (setq num (string-to-number num))
+ (if (numberp num)
+ num
+ nil)))
+ nil)))
+
+(defun ly-parse-error-line (file-name lineNo)
+ "Extract the erroneous line from the tangled .ly file
+FILE-NAME is full path to lilypond file.
+LINENO is the number of the erroneous line"
+ (with-temp-buffer
+ (insert-file-contents (ly-switch-extension file-name ".ly")
+ nil nil nil t)
+ (if (> lineNo 0)
+ (progn
+ (goto-char (point-min))
+ (forward-line (- lineNo 1))
+ (buffer-substring (point) (point-at-eol)))
+ nil)))
+
+(defun ly-attempt-to-open-pdf (file-name &optional test)
+ "Attempt to display the generated pdf file
+FILE-NAME is full path to lilypond file
+If TEST is non-nil, the shell command is returned and is not run"
+ (when ly-display-pdf-post-tangle
+ (let ((pdf-file (ly-switch-extension file-name ".pdf")))
+ (if (file-exists-p pdf-file)
+ (let ((cmd-string
+ (concat (ly-determine-pdf-path) " " pdf-file)))
+ (if test
+ cmd-string
+ (start-process
+ "\"Audition pdf\""
+ "*lilypond*"
+ (ly-determine-pdf-path)
+ pdf-file)))
+ (message "No pdf file generated so can't display!")))))
+
+(defun ly-attempt-to-play-midi (file-name &optional test)
+ "Attempt to play the generated MIDI file
+FILE-NAME is full path to lilypond file
+If TEST is non-nil, the shell command is returned and is not run"
+ (when ly-play-midi-post-tangle
+ (let ((midi-file (ly-switch-extension file-name ".midi")))
+ (if (file-exists-p midi-file)
+ (let ((cmd-string
+ (concat (ly-determine-midi-path) " " midi-file)))
+ (if test
+ cmd-string
+ (start-process
+ "\"Audition midi\""
+ "*lilypond*"
+ (ly-determine-midi-path)
+ midi-file)))
+ (message "No midi file generated so can't play!")))))
+
+(defun ly-determine-ly-path (&optional test)
+ "Return correct path to ly binary depending on OS
+If TEST is non-nil, it contains a simulation of the OS for test purposes"
+ (let ((sys-type
+ (or test system-type)))
+ (cond ((string= sys-type "darwin")
+ ly-OSX-ly-path)
+ ((string= sys-type "win32")
+ ly-win32-ly-path)
+ (t ly-nix-ly-path))))
+
+(defun ly-determine-pdf-path (&optional test)
+ "Return correct path to pdf viewer depending on OS
+If TEST is non-nil, it contains a simulation of the OS for test purposes"
+ (let ((sys-type
+ (or test system-type)))
+ (cond ((string= sys-type "darwin")
+ ly-OSX-pdf-path)
+ ((string= sys-type "win32")
+ ly-win32-pdf-path)
+ (t ly-nix-pdf-path))))
+
+(defun ly-determine-midi-path (&optional test)
+ "Return correct path to midi player depending on OS
+If TEST is non-nil, it contains a simulation of the OS for test purposes"
+ (let ((sys-type
+ (or test test system-type)))
+ (cond ((string= sys-type "darwin")
+ ly-OSX-midi-path)
+ ((string= sys-type "win32")
+ ly-win32-midi-path)
+ (t ly-nix-midi-path))))
+
+(defun ly-toggle-midi-play ()
+ "Toggle whether midi will be played following a successful compilation."
+ (interactive)
+ (setq ly-play-midi-post-tangle
+ (not ly-play-midi-post-tangle))
+ (message (concat "Post-Tangle MIDI play has been "
+ (if ly-play-midi-post-tangle
+ "ENABLED." "DISABLED."))))
+
+(defun ly-toggle-pdf-display ()
+ "Toggle whether pdf will be displayed following a successful compilation."
+ (interactive)
+ (setq ly-display-pdf-post-tangle
+ (not ly-display-pdf-post-tangle))
+ (message (concat "Post-Tangle PDF display has been "
+ (if ly-display-pdf-post-tangle
+ "ENABLED." "DISABLED."))))
+
+(defun ly-toggle-png-generation ()
+ "Toggle whether png image will be generated by compilation."
+ (interactive)
+ (setq ly-gen-png (not ly-gen-png))
+ (message (concat "PNG image generation has been "
+ (if ly-gen-png "ENABLED." "DISABLED."))))
+
+(defun ly-toggle-html-generation ()
+ "Toggle whether html will be generated by compilation."
+ (interactive)
+ (setq ly-gen-html (not ly-gen-html))
+ (message (concat "HTML generation has been "
+ (if ly-gen-html "ENABLED." "DISABLED."))))
+
+(defun ly-toggle-pdf-generation ()
+ "Toggle whether pdf will be generated by compilation."
+ (interactive)
+ (setq ly-gen-pdf (not ly-gen-pdf))
+ (message (concat "PDF generation has been "
+ (if ly-gen-pdf "ENABLED." "DISABLED."))))
+
+(defun ly-toggle-arrange-mode ()
+ "Toggle whether in Arrange mode or Basic mode."
+ (interactive)
+ (setq ly-arrange-mode
+ (not ly-arrange-mode))
+ (message (concat "Arrange mode has been "
+ (if ly-arrange-mode "ENABLED." "DISABLED."))))
+
+(defun ly-switch-extension (file-name ext)
+ "Utility command to swap current FILE-NAME extension with EXT"
+ (concat (file-name-sans-extension
+ file-name) ext))
+
+(defun ly-get-header-args (mode)
+ "Default arguments to use when evaluating a lilypond
+source block. These depend upon whether we are in arrange
+mode i.e. ARRANGE-MODE is t"
+ (cond (mode
+ '((:tangle . "yes")
+ (:noweb . "yes")
+ (:results . "silent")
+ (:cache . "yes")
+ (:comments . "yes")))
+ (t
+ '((:results . "file")
+ (:exports . "results")))))
+
+(defun ly-set-header-args (mode)
+ "Set org-babel-default-header-args:lilypond
+dependent on LY-ARRANGE-MODE"
+ (setq org-babel-default-header-args:lilypond
+ (ly-get-header-args mode)))
+
+(provide 'ob-lilypond)
+
+;;; ob-lilypond.el ends here
diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el
new file mode 100644
index 0000000..71e80bd
--- /dev/null
+++ b/lisp/ob-lisp.el
@@ -0,0 +1,108 @@
+;;; ob-lisp.el --- org-babel functions for common lisp evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Joel Boehland
+;; Eric Schulte
+;; David T. O'Toole <dto@gnu.org>
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; support for evaluating common lisp code, relies on slime for all eval
+
+;;; Requirements:
+
+;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.)
+;; See http://common-lisp.net/project/slime/
+
+;;; Code:
+(require 'ob)
+
+(declare-function slime-eval "ext:slime" (sexp &optional package))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
+
+(defvar org-babel-default-header-args:lisp '())
+(defvar org-babel-header-args:lisp '((package . :any)))
+
+(defcustom org-babel-lisp-dir-fmt
+ "(let ((*default-pathname-defaults* #P%S)) %%s)"
+ "Format string used to wrap code bodies to set the current directory.
+For example a value of \"(progn ;; %s\\n %%s)\" would ignore the
+current directory string."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-expand-body:lisp (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (print-level nil) (print-length nil)
+ (body (org-babel-trim
+ (if (> (length vars) 0)
+ (concat "(let ("
+ (mapconcat
+ (lambda (var)
+ (format "(%S (quote %S))" (car var) (cdr var)))
+ vars "\n ")
+ ")\n" body ")")
+ body))))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(pprint %s)" body)
+ body)))
+
+(defun org-babel-execute:lisp (body params)
+ "Execute a block of Common Lisp code with Babel."
+ (require 'slime)
+ (org-babel-reassemble-table
+ ((lambda (result)
+ (if (member "output" (cdr (assoc :result-params params)))
+ (car result)
+ (condition-case nil
+ (read (org-babel-lisp-vector-to-list (cadr result)))
+ (error (cadr result)))))
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (slime-eval `(swank:eval-and-grab-output
+ ,(let ((dir (if (assoc :dir params)
+ (cdr (assoc :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assoc :package params)))))
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params)))))
+
+(defun org-babel-lisp-vector-to-list (results)
+ ;; TODO: better would be to replace #(...) with [...]
+ (replace-regexp-in-string "#(" "(" results))
+
+(provide 'ob-lisp)
+
+
+
+;;; ob-lisp.el ends here
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
new file mode 100644
index 0000000..6aafe34
--- /dev/null
+++ b/lisp/ob-lob.el
@@ -0,0 +1,148 @@
+;;; ob-lob.el --- functions supporting the Library of Babel
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'ob)
+(require 'ob-table)
+
+(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
+
+(defvar org-babel-library-of-babel nil
+ "Library of source-code blocks.
+This is an association list. Populate the library by adding
+files to `org-babel-lob-files'.")
+
+(defcustom org-babel-lob-files '()
+ "Files used to populate the `org-babel-library-of-babel'.
+To add files to this list use the `org-babel-lob-ingest' command."
+ :group 'org-babel
+ :version "24.1"
+ :type 'list)
+
+(defvar org-babel-default-lob-header-args '((:exports . "results"))
+ "Default header arguments to use when exporting #+lob/call lines.")
+
+;;;###autoload
+(defun org-babel-lob-ingest (&optional file)
+ "Add all named source-blocks defined in FILE to
+`org-babel-library-of-babel'."
+ (interactive "fFile: ")
+ (let ((lob-ingest-count 0))
+ (org-babel-map-src-blocks file
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (source-name (nth 4 info)))
+ (when source-name
+ (setq source-name (intern source-name)
+ org-babel-library-of-babel
+ (cons (cons source-name info)
+ (assq-delete-all source-name org-babel-library-of-babel))
+ lob-ingest-count (1+ lob-ingest-count)))))
+ (message "%d src block%s added to Library of Babel"
+ lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
+ lob-ingest-count))
+
+(defconst org-babel-block-lob-one-liner-regexp
+ (concat
+ "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
+ "\(\\([^\n]*?\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
+ "Regexp to match non-inline calls to predefined source block functions.")
+
+(defconst org-babel-inline-lob-one-liner-regexp
+ (concat
+ "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
+ "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
+ "Regexp to match inline calls to predefined source block functions.")
+
+(defconst org-babel-lob-one-liner-regexp
+ (concat "\\(" org-babel-block-lob-one-liner-regexp
+ "\\|" org-babel-inline-lob-one-liner-regexp "\\)")
+ "Regexp to match calls to predefined source block functions.")
+
+;; functions for executing lob one-liners
+
+;;;###autoload
+(defun org-babel-lob-execute-maybe ()
+ "Execute a Library of Babel source block, if appropriate.
+Detect if this is context for a Library Of Babel source block and
+if so then run the appropriate source block from the Library."
+ (interactive)
+ (let ((info (org-babel-lob-get-info)))
+ (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim)))
+ (progn (org-babel-lob-execute info) t)
+ nil)))
+
+;;;###autoload
+(defun org-babel-lob-get-info ()
+ "Return a Library of Babel function call as a string."
+ (let ((case-fold-search t)
+ (nonempty (lambda (a b)
+ (let ((it (match-string a)))
+ (if (= (length it) 0) (match-string b) it)))))
+ (save-excursion
+ (beginning-of-line 1)
+ (when (looking-at org-babel-lob-one-liner-regexp)
+ (append
+ (mapcar #'org-no-properties
+ (list
+ (format "%s%s(%s)%s"
+ (funcall nonempty 3 12)
+ (if (not (= 0 (length (funcall nonempty 5 14))))
+ (concat "[" (funcall nonempty 5 14) "]") "")
+ (or (funcall nonempty 7 16) "")
+ (or (funcall nonempty 8 19) ""))
+ (funcall nonempty 9 18)))
+ (list (length (if (= (length (match-string 12)) 0)
+ (match-string 2) (match-string 11)))))))))
+
+(defun org-babel-lob-execute (info)
+ "Execute the lob call specified by INFO."
+ (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
+ (pre-params (org-babel-merge-params
+ org-babel-default-header-args
+ (org-babel-params-from-properties)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat ":var results="
+ (mapconcat #'identity (butlast info) " "))))))
+ (pre-info (funcall mkinfo pre-params))
+ (cache? (and (cdr (assoc :cache pre-params))
+ (string= "yes" (cdr (assoc :cache pre-params)))))
+ (new-hash (when cache? (org-babel-sha1-hash pre-info)))
+ (old-hash (when cache? (org-babel-current-result-hash))))
+ (if (and cache? (equal new-hash old-hash))
+ (save-excursion (goto-char (org-babel-where-is-src-block-result))
+ (forward-line 1)
+ (message "%S" (org-babel-read-result)))
+ (prog1 (org-babel-execute-src-block
+ nil (funcall mkinfo (org-babel-process-params pre-params)))
+ ;; update the hash
+ (when new-hash (org-babel-set-current-result-hash new-hash))))))
+
+(provide 'ob-lob)
+
+
+
+;;; ob-lob.el ends here
diff --git a/lisp/ob-matlab.el b/lisp/ob-matlab.el
new file mode 100644
index 0000000..717fc74
--- /dev/null
+++ b/lisp/ob-matlab.el
@@ -0,0 +1,47 @@
+;;; ob-matlab.el --- org-babel support for matlab evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Functions that are common to org-babel support for matlab and
+;; octave are in org-babel-octave.el
+
+;;; Requirements:
+
+;; Matlab
+
+;; matlab.el required for interactive emacs sessions and matlab-mode
+;; major mode for source code editing buffer
+;; http://matlab-emacs.sourceforge.net/
+
+;;; Code:
+(require 'ob)
+(require 'ob-octave)
+
+;; see ob-octave for matlab implementation
+
+(provide 'ob-matlab)
+
+
+
+;;; ob-matlab.el ends here
diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el
new file mode 100644
index 0000000..06fa3cf
--- /dev/null
+++ b/lisp/ob-maxima.el
@@ -0,0 +1,132 @@
+;;; ob-maxima.el --- org-babel functions for maxima evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric S Fraga
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research, maxima
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating maxima entries.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in maxima
+;;
+;; 2) we are adding the "cmdline" header argument
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max"))
+
+(defvar org-babel-default-header-args:maxima '())
+
+(defcustom org-babel-maxima-command
+ (if (boundp 'maxima-command) maxima-command "maxima")
+ "Command used to call maxima on the shell."
+ :group 'org-babel)
+
+(defun org-babel-maxima-expand (body params)
+ "Expand a block of Maxima code according to its header arguments."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (mapconcat 'identity
+ (list
+ ;; graphic output
+ (let ((graphic-file (org-babel-maxima-graphical-output-file params)))
+ (if graphic-file
+ (format
+ "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
+ graphic-file)
+ ""))
+ ;; variables
+ (mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
+ ;; body
+ body
+ "gnuplot_close ()$")
+ "\n")))
+
+(defun org-babel-execute:maxima (body params)
+ "Execute a block of Maxima entries with org-babel. This function is
+called by `org-babel-execute-src-block'."
+ (message "executing Maxima source code block")
+ (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (result
+ (let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
+ (in-file (org-babel-temp-file "maxima-" ".max"))
+ (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
+ org-babel-maxima-command in-file cmdline)))
+ (with-temp-file in-file (insert (org-babel-maxima-expand body params)))
+ (message cmd)
+ ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar (lambda (line)
+ (unless (or (string-match "batch" line)
+ (string-match "^rat: replaced .*$" line)
+ (= 0 (length line)))
+ line))
+ (split-string raw "[\r\n]"))) "\n"))
+ (org-babel-eval cmd "")))))
+ (if (org-babel-maxima-graphical-output-file params)
+ nil
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "output" result-params))
+ result
+ (let ((tmp-file (org-babel-temp-file "maxima-res-")))
+ (with-temp-file tmp-file (insert result))
+ (org-babel-import-elisp-from-file tmp-file))))))
+
+
+(defun org-babel-prep-session:maxima (session params)
+ (error "Maxima does not support sessions"))
+
+(defun org-babel-maxima-var-to-maxima (pair)
+ "Convert an elisp val into a string of maxima code specifying a var
+of the same value."
+ (let ((var (car pair))
+ (val (cdr pair)))
+ (when (symbolp val)
+ (setq val (symbol-name val))
+ (when (= (length val) 1)
+ (setq val (string-to-char val))))
+ (format "%S: %s$" var
+ (org-babel-maxima-elisp-to-maxima val))))
+
+(defun org-babel-maxima-graphical-output-file (params)
+ "Name of file to which maxima should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(defun org-babel-maxima-elisp-to-maxima (val)
+ "Return a string of maxima code which evaluates to VAL."
+ (if (listp val)
+ (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]")
+ (format "%s" val)))
+
+
+(provide 'ob-maxima)
+
+
+
+;;; ob-maxima.el ends here
diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el
new file mode 100644
index 0000000..64d3545
--- /dev/null
+++ b/lisp/ob-mscgen.el
@@ -0,0 +1,85 @@
+;;; ob-msc.el --- org-babel functions for mscgen evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Juan Pechiar
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This software provides EMACS org-babel export support for message
+;; sequence charts. The mscgen utility is used for processing the
+;; sequence definition, and must therefore be installed in the system.
+;;
+;; Mscgen is available and documented at
+;; http://www.mcternan.me.uk/mscgen/index.html
+;;
+;; This code is directly inspired by Eric Schulte's ob-dot.el
+;;
+;; Example:
+;;
+;; #+begin_src mscgen :file example.png
+;; msc {
+;; A,B;
+;; A -> B [ label = "send message" ];
+;; A <- B [ label = "get answer" ];
+;; }
+;; #+end_src
+;;
+;; Header for alternative file type:
+;;
+;; #+begin_src mscgen :file ex2.svg :filetype svg
+
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in mscgen
+;; 2) we are generally only going to return results of type "file"
+;; 3) we are adding the "file" and "filetype" header arguments
+;; 4) there are no variables
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-default-header-args:mscgen
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating a mscgen source block.")
+
+(defun org-babel-execute:mscgen (body params)
+ "Execute a block of Mscgen code with Babel.
+This function is called by `org-babel-execute-src-block'.
+Default filetype is png. Modify by setting :filetype parameter to
+mscgen supported formats."
+ (let* ((out-file (or (cdr (assoc :file params)) "output.png" ))
+ (filetype (or (cdr (assoc :filetype params)) "png" )))
+ (unless (cdr (assoc :file params))
+ (error "
+ERROR: no output file specified. Add \":file name.png\" to the src header"))
+ (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:mscgen (session params)
+ "Raise an error because Mscgen doesn't support sessions."
+ (error "Mscgen does not support sessions"))
+
+(provide 'ob-mscgen)
+
+
+
+;;; ob-msc.el ends here
diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el
new file mode 100644
index 0000000..d2bf366
--- /dev/null
+++ b/lisp/ob-ocaml.el
@@ -0,0 +1,144 @@
+;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating ocaml source code. This one will
+;; be sort of tricky because ocaml programs must be compiled before
+;; they can be run, but ocaml code can also be run through an
+;; interactive interpreter.
+;;
+;; For now lets only allow evaluation using the ocaml interpreter.
+
+;;; Requirements:
+
+;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/
+
+;;; Code:
+(require 'ob)
+(require 'ob-comint)
+(require 'comint)
+(eval-when-compile (require 'cl))
+
+(declare-function tuareg-run-caml "ext:tuareg" ())
+(declare-function tuareg-interactive-send-input "ext:tuareg" ())
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
+
+(defvar org-babel-default-header-args:ocaml '())
+
+(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
+(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
+
+(defun org-babel-execute:ocaml (body params)
+ "Execute a block of Ocaml code with Babel."
+ (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (full-body (org-babel-expand-body:generic
+ body params
+ (org-babel-variable-assignments:ocaml params)))
+ (session (org-babel-prep-session:ocaml
+ (cdr (assoc :session params)) params))
+ (raw (org-babel-comint-with-output
+ (session org-babel-ocaml-eoe-output t full-body)
+ (insert
+ (concat
+ (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
+ (tuareg-interactive-send-input)))
+ (clean
+ (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
+ (delq nil (mapcar (lambda (line)
+ (if out
+ (progn (setq out nil) line)
+ (when (string-match re line)
+ (progn (setq out t) nil))))
+ (mapcar #'org-babel-trim (reverse raw))))))))
+ (org-babel-reassemble-table
+ (org-babel-ocaml-parse-output (org-babel-trim clean))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+(defvar tuareg-interactive-buffer-name)
+(defun org-babel-prep-session:ocaml (session params)
+ "Prepare SESSION according to the header arguments in PARAMS."
+ (require 'tuareg)
+ (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
+ (not (string= session "default"))
+ (stringp session))
+ session
+ tuareg-interactive-buffer-name)))
+ (save-window-excursion (tuareg-run-caml)
+ (get-buffer tuareg-interactive-buffer-name))))
+
+(defun org-babel-variable-assignments:ocaml (params)
+ "Return list of ocaml statements assigning the block's variables."
+ (mapcar
+ (lambda (pair) (format "let %s = %s;;" (car pair)
+ (org-babel-ocaml-elisp-to-ocaml (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-ocaml-elisp-to-ocaml (val)
+ "Return a string of ocaml code which evaluates to VAL."
+ (if (listp val)
+ (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]")
+ (format "%S" val)))
+
+(defun org-babel-ocaml-parse-output (output)
+ "Parse OUTPUT.
+OUTPUT is string output from an ocaml process."
+ (let ((regexp "%s = \\(.+\\)$"))
+ (cond
+ ((string-match (format regexp "string") output)
+ (org-babel-read (match-string 1 output)))
+ ((or (string-match (format regexp "int") output)
+ (string-match (format regexp "float") output))
+ (string-to-number (match-string 1 output)))
+ ((string-match (format regexp "list") output)
+ (org-babel-ocaml-read-list (match-string 1 output)))
+ ((string-match (format regexp "array") output)
+ (org-babel-ocaml-read-array (match-string 1 output)))
+ (t (message "don't recognize type of %s" output) output))))
+
+(defun org-babel-ocaml-read-list (results)
+ "Convert RESULTS into an elisp table or string.
+If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape (replace-regexp-in-string ";" "," results)))
+
+(defun org-babel-ocaml-read-array (results)
+ "Convert RESULTS into an elisp table or string.
+If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape
+ (replace-regexp-in-string
+ "\\[|" "[" (replace-regexp-in-string
+ "|\\]" "]" (replace-regexp-in-string
+ "; " "," results)))))
+
+(provide 'ob-ocaml)
+
+
+
+;;; ob-ocaml.el ends here
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
new file mode 100644
index 0000000..73f25ec
--- /dev/null
+++ b/lisp/ob-octave.el
@@ -0,0 +1,282 @@
+;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Requirements:
+
+;; octave
+;; octave-mode.el and octave-inf.el come with GNU emacs
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function matlab-shell "ext:matlab-mode")
+(declare-function matlab-shell-run-region "ext:matlab-mode")
+
+(defvar org-babel-default-header-args:matlab '())
+(defvar org-babel-default-header-args:octave '())
+
+(defvar org-babel-matlab-shell-command "matlab -nosplash"
+ "Shell command to run matlab as an external process.")
+(defvar org-babel-octave-shell-command "octave -q"
+ "Shell command to run octave as an external process.")
+
+(defvar org-babel-matlab-with-emacs-link nil
+ "If non-nil use matlab-shell-run-region for session evaluation.
+ This will use EmacsLink if (matlab-with-emacs-link) evaluates
+ to a non-nil value.")
+
+(defvar org-babel-matlab-emacs-link-wrapper-method
+ "%s
+if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
+else, save -ascii %s ans
+end
+delete('%s')
+")
+(defvar org-babel-octave-wrapper-method
+ "%s
+if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid);
+else, dlmwrite('%s', ans, '\\t')
+end")
+
+(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'")
+
+(defvar org-babel-octave-eoe-output "ans = org_babel_eoe")
+
+(defun org-babel-execute:matlab (body params)
+ "Execute a block of matlab code with Babel."
+ (org-babel-execute:octave body params 'matlab))
+
+(defun org-babel-execute:octave (body params &optional matlabp)
+ "Execute a block of octave code with Babel."
+ (let* ((session
+ (funcall (intern (format "org-babel-%s-initiate-session"
+ (if matlabp "matlab" "octave")))
+ (cdr (assoc :session params)) params))
+ (vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (out-file (cdr (assoc :file params)))
+ (full-body
+ (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:octave params)))
+ (result (org-babel-octave-evaluate
+ session
+ (if (org-babel-octave-graphical-output-file params)
+ (mapconcat 'identity
+ (list
+ "set (0, \"defaultfigurevisible\", \"off\");"
+ full-body
+ (format "print -dpng %s" (org-babel-octave-graphical-output-file params)))
+ "\n")
+ full-body)
+ result-type matlabp)))
+ (if (org-babel-octave-graphical-output-file params)
+ nil
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+
+(defun org-babel-prep-session:matlab (session params)
+ "Prepare SESSION according to PARAMS."
+ (org-babel-prep-session:octave session params 'matlab))
+
+(defun org-babel-variable-assignments:octave (params)
+ "Return list of octave statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s;"
+ (car pair)
+ (org-babel-octave-var-to-octave (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defalias 'org-babel-variable-assignments:matlab
+ 'org-babel-variable-assignments:octave)
+
+(defun org-babel-octave-var-to-octave (var)
+ "Convert an emacs-lisp value into an octave variable.
+Converts an emacs-lisp variable into a string of octave code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-octave-var-to-octave var
+ (if (listp (car var)) "; " ",")) "]")
+ (cond
+ ((stringp var)
+ (format "\'%s\'" var))
+ (t
+ (format "%s" var)))))
+
+(defun org-babel-prep-session:octave (session params &optional matlabp)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-octave-initiate-session session params matlabp))
+ (var-lines (org-babel-variable-assignments:octave params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-matlab-initiate-session (&optional session params)
+ "Create a matlab inferior process buffer.
+If there is not a current inferior-process-buffer in SESSION then
+create. Return the initialized session."
+ (org-babel-octave-initiate-session session params 'matlab))
+
+(defun org-babel-octave-initiate-session (&optional session params matlabp)
+ "Create an octave inferior process buffer.
+If there is not a current inferior-process-buffer in SESSION then
+create. Return the initialized session."
+ (if matlabp (require 'matlab) (require 'octave-inf))
+ (unless (string= session "none")
+ (let ((session (or session
+ (if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
+ (if (org-babel-comint-buffer-livep session) session
+ (save-window-excursion
+ (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell))
+ (run-octave))
+ (rename-buffer (if (bufferp session) (buffer-name session)
+ (if (stringp session) session (buffer-name))))
+ (current-buffer))))))
+
+(defun org-babel-octave-evaluate
+ (session body result-type &optional matlabp)
+ "Pass BODY to the octave process in SESSION.
+If RESULT-TYPE equals 'output then return the outputs of the
+statements in BODY, if RESULT-TYPE equals 'value then return the
+value of the last statement in BODY, as elisp."
+ (if session
+ (org-babel-octave-evaluate-session session body result-type matlabp)
+ (org-babel-octave-evaluate-external-process body result-type matlabp)))
+
+(defun org-babel-octave-evaluate-external-process (body result-type matlabp)
+ "Evaluate BODY in an external octave process."
+ (let ((cmd (if matlabp
+ org-babel-matlab-shell-command
+ org-babel-octave-shell-command)))
+ (case result-type
+ (output (org-babel-eval cmd body))
+ (value (let ((tmp-file (org-babel-temp-file "octave-")))
+ (org-babel-eval
+ cmd
+ (format org-babel-octave-wrapper-method body
+ (org-babel-process-file-name tmp-file 'noquote)
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-octave-import-elisp-from-file tmp-file))))))
+
+(defun org-babel-octave-evaluate-session
+ (session body result-type &optional matlabp)
+ "Evaluate BODY in SESSION."
+ (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
+ (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
+ (full-body
+ (case result-type
+ (output
+ (mapconcat
+ #'org-babel-chomp
+ (list body org-babel-octave-eoe-indicator) "\n"))
+ (value
+ (if (and matlabp org-babel-matlab-with-emacs-link)
+ (concat
+ (format org-babel-matlab-emacs-link-wrapper-method
+ body
+ (org-babel-process-file-name tmp-file 'noquote)
+ (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n")
+ (mapconcat
+ #'org-babel-chomp
+ (list (format org-babel-octave-wrapper-method
+ body
+ (org-babel-process-file-name tmp-file 'noquote)
+ (org-babel-process-file-name tmp-file 'noquote))
+ org-babel-octave-eoe-indicator) "\n")))))
+ (raw (if (and matlabp org-babel-matlab-with-emacs-link)
+ (save-window-excursion
+ (with-temp-buffer
+ (insert full-body)
+ (write-region "" 'ignored wait-file nil nil nil 'excl)
+ (matlab-shell-run-region (point-min) (point-max))
+ (message "Waiting for Matlab Emacs Link")
+ (while (file-exists-p wait-file) (sit-for 0.01))
+ "")) ;; matlab-shell-run-region doesn't seem to
+ ;; make *matlab* buffer contents easily
+ ;; available, so :results output currently
+ ;; won't work
+ (org-babel-comint-with-output
+ (session
+ (if matlabp
+ org-babel-octave-eoe-indicator
+ org-babel-octave-eoe-output)
+ t full-body)
+ (insert full-body) (comint-send-input nil t)))) results)
+ (case result-type
+ (value
+ (org-babel-octave-import-elisp-from-file tmp-file))
+ (output
+ (progn
+ (setq results
+ (if matlabp
+ (cdr (reverse (delq "" (mapcar
+ #'org-babel-octave-read-string
+ (mapcar #'org-babel-trim raw)))))
+ (cdr (member org-babel-octave-eoe-output
+ (reverse (mapcar
+ #'org-babel-octave-read-string
+ (mapcar #'org-babel-trim raw)))))))
+ (mapconcat #'identity (reverse results) "\n"))))))
+
+(defun org-babel-octave-import-elisp-from-file (file-name)
+ "Import data from FILE-NAME.
+This removes initial blank and comment lines and then calls
+`org-babel-import-elisp-from-file'."
+ (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end)
+ (with-temp-file temp-file
+ (insert-file-contents file-name)
+ (re-search-forward "^[ \t]*[^# \t]" nil t)
+ (if (< (setq beg (point-min))
+ (setq end (point-at-bol)))
+ (delete-region beg end)))
+ (org-babel-import-elisp-from-file temp-file '(16))))
+
+(defun org-babel-octave-read-string (string)
+ "Strip \\\"s from around octave string."
+ (if (string-match "^\"\\([^\000]+\\)\"$" string)
+ (match-string 1 string)
+ string))
+
+(defun org-babel-octave-graphical-output-file (params)
+ "Name of file to which maxima should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(provide 'ob-octave)
+
+
+
+;;; ob-octave.el ends here
diff --git a/lisp/ob-org.el b/lisp/ob-org.el
new file mode 100644
index 0000000..64de4b2
--- /dev/null
+++ b/lisp/ob-org.el
@@ -0,0 +1,70 @@
+;;; ob-org.el --- org-babel functions for org code block evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is the simplest of code blocks, where upon evaluation the
+;; contents of the code block are returned in a raw result.
+
+;;; Code:
+(require 'ob)
+
+(declare-function org-export-string "org-exp" (string fmt &optional dir))
+
+(defvar org-babel-default-header-args:org
+ '((:results . "raw silent") (:exports . "code"))
+ "Default arguments for evaluating a org source block.")
+
+(defvar org-babel-org-default-header
+ "#+TITLE: default empty header\n"
+ "Default header inserted during export of org blocks.")
+
+(defun org-babel-expand-body:org (body params)
+ (dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
+ (setq body (replace-regexp-in-string
+ (regexp-quote (format "$%s" (car var))) (cdr var) body
+ nil 'literal)))
+ body)
+
+(defun org-babel-execute:org (body params)
+ "Execute a block of Org code with.
+This function is called by `org-babel-execute-src-block'."
+ (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (body (org-babel-expand-body:org
+ (replace-regexp-in-string "^," "" body) params)))
+ (cond
+ ((member "latex" result-params) (org-export-string
+ (concat "#+Title: \n" body) "latex"))
+ ((member "html" result-params) (org-export-string body "html"))
+ ((member "ascii" result-params) (org-export-string body "ascii"))
+ (t body))))
+
+(defun org-babel-prep-session:org (session params)
+ "Return an error because org does not support sessions."
+ (error "Org does not support sessions"))
+
+(provide 'ob-org)
+
+
+
+;;; ob-org.el ends here
diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el
new file mode 100644
index 0000000..abf0ed6
--- /dev/null
+++ b/lisp/ob-perl.el
@@ -0,0 +1,118 @@
+;;; ob-perl.el --- org-babel functions for perl evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Dan Davison
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating perl source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
+
+(defvar org-babel-default-header-args:perl '())
+
+(defvar org-babel-perl-command "perl"
+ "Name of command to use for executing perl code.")
+
+(defun org-babel-execute:perl (body params)
+ "Execute a block of Perl code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (cdr (assoc :session params)))
+ (result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:perl params)))
+ (session (org-babel-perl-initiate-session session)))
+ (org-babel-reassemble-table
+ (org-babel-perl-evaluate session full-body result-type)
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+(defun org-babel-prep-session:perl (session params)
+ "Prepare SESSION according to the header arguments in PARAMS."
+ (error "Sessions are not supported for Perl"))
+
+(defun org-babel-variable-assignments:perl (params)
+ "Return list of perl statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "$%s=%s;"
+ (car pair)
+ (org-babel-perl-var-to-perl (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+;; helper functions
+
+(defun org-babel-perl-var-to-perl (var)
+ "Convert an elisp value to a perl variable.
+The elisp value, VAR, is converted to a string of perl source code
+specifying a var of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]")
+ (format "%S" var)))
+
+(defvar org-babel-perl-buffers '(:default . nil))
+
+(defun org-babel-perl-initiate-session (&optional session params)
+ "Return nil because sessions are not supported by perl."
+ nil)
+
+(defvar org-babel-perl-wrapper-method
+ "
+sub main {
+%s
+}
+@r = main;
+open(o, \">%s\");
+print o join(\"\\n\", @r), \"\\n\"")
+
+(defvar org-babel-perl-pp-wrapper-method
+ nil)
+
+(defun org-babel-perl-evaluate (session body &optional result-type)
+ "Pass BODY to the Perl process in SESSION.
+If RESULT-TYPE equals 'output then return a list of the outputs
+of the statements in BODY, if RESULT-TYPE equals 'value then
+return the value of the last statement in BODY, as elisp."
+ (when session (error "Sessions are not supported for Perl"))
+ (case result-type
+ (output (org-babel-eval org-babel-perl-command body))
+ (value (let ((tmp-file (org-babel-temp-file "perl-")))
+ (org-babel-eval
+ org-babel-perl-command
+ (format org-babel-perl-wrapper-method body
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-eval-read-file tmp-file)))))
+
+(provide 'ob-perl)
+
+
+
+;;; ob-perl.el ends here
diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el
new file mode 100644
index 0000000..dd0704f
--- /dev/null
+++ b/lisp/ob-picolisp.el
@@ -0,0 +1,194 @@
+;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Authors: Thorsten Jolitz
+;; Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library enables the use of PicoLisp in the multi-language
+;; programming framework Org-Babel. PicoLisp is a minimal yet
+;; fascinating lisp dialect and a highly productive application
+;; framework for web-based client-server applications on top of
+;; object-oriented databases. A good way to learn PicoLisp is to first
+;; read Paul Grahams essay "The hundred year language"
+;; (http://www.paulgraham.com/hundred.html) and then study the various
+;; documents and essays published in the PicoLisp wiki
+;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some
+;; GNU/Linux Distributions, and can be downloaded here:
+;; http://software-lab.de/down.html. It ships with a picolisp-mode and
+;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/
+;; directory).
+
+;; Although it might seem more natural to use Emacs Lisp for most
+;; Lisp-based programming tasks inside Org-Mode, an Emacs library
+;; written in Emacs Lisp, PicoLisp has at least two outstanding
+;; features that make it a valuable addition to Org-Babel:
+
+;; PicoLisp _is_ an object-oriented database with a Prolog-based query
+;; language implemented in PicoLisp (Pilog). Database objects are
+;; first-class members of the language.
+
+;; PicoLisp is an extremely productive framework for the development
+;; of interactive web-applications (on top of a database).
+
+;;; Requirements:
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'ob-comint)
+(require 'comint)
+(eval-when-compile (require 'cl))
+
+(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
+
+;; optionally define a file extension for this language
+(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l"))
+
+;;; interferes with settings in org-babel buffer?
+;; optionally declare default header arguments for this language
+;; (defvar org-babel-default-header-args:picolisp
+;; '((:colnames . "no"))
+;; "Default arguments for evaluating a picolisp source block.")
+
+(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe"
+ "String to indicate that evaluation has completed.")
+
+(defcustom org-babel-picolisp-cmd "pil"
+ "Name of command used to evaluate picolisp blocks."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-expand-body:picolisp (body params &optional processed-params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (result-params (cdr (assoc :result-params params)))
+ (print-level nil) (print-length nil))
+ (if (> (length vars) 0)
+ (concat "(prog (let ("
+ (mapconcat
+ (lambda (var)
+ (format "%S '%S)"
+ (print (car var))
+ (print (cdr var))))
+ vars "\n ")
+ " \n" body ") )")
+ body)))
+
+(defun org-babel-execute:picolisp (body params)
+ "Execute a block of Picolisp code with org-babel. This function is
+ called by `org-babel-execute-src-block'"
+ (message "executing Picolisp source code block")
+ (let* (
+ ;; name of the session or "none"
+ (session-name (cdr (assoc :session params)))
+ ;; set the session if the session variable is non-nil
+ (session (org-babel-picolisp-initiate-session session-name))
+ ;; either OUTPUT or VALUE which should behave as described above
+ (result-type (cdr (assoc :result-type params)))
+ (result-params (cdr (assoc :result-params params)))
+ ;; expand the body with `org-babel-expand-body:picolisp'
+ (full-body (org-babel-expand-body:picolisp body params))
+ ;; wrap body appropriately for the type of evaluation and results
+ (wrapped-body
+ (cond
+ ((or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(pretty (out \"/dev/null\" %s))" full-body))
+ ((and (member "value" result-params) (not session))
+ (format "(print (out \"/dev/null\" %s))" full-body))
+ ((member "value" result-params)
+ (format "(out \"/dev/null\" %s)" full-body))
+ (t full-body))))
+
+ ((lambda (result)
+ (if (or (member "verbatim" result-params)
+ (member "scalar" result-params)
+ (member "output" result-params)
+ (member "code" result-params)
+ (member "pp" result-params)
+ (= (length result) 0))
+ result
+ (read result)))
+ (if (not (string= session-name "none"))
+ ;; session based evaluation
+ (mapconcat ;; <- joins the list back together into a single string
+ #'identity
+ (butlast ;; <- remove the org-babel-picolisp-eoe line
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (org-babel-chomp ;; remove trailing newlines
+ (when (> (length line) 0) ;; remove empty lines
+ (cond
+ ;; remove leading "-> " from return values
+ ((and (>= (length line) 3)
+ (string= "-> " (substring line 0 3)))
+ (substring line 3))
+ ;; remove trailing "-> <<return-value>>" on the
+ ;; last line of output
+ ((and (member "output" result-params)
+ (string-match-p "->" line))
+ (substring line 0 (string-match "->" line)))
+ (t line)
+ )
+ ;; (if (and (>= (length line) 3) ;; remove leading "<- "
+ ;; (string= "-> " (substring line 0 3)))
+ ;; (substring line 3)
+ ;; line)
+ )))
+ ;; returns a list of the output of each evaluated expression
+ (org-babel-comint-with-output (session org-babel-picolisp-eoe)
+ (insert wrapped-body) (comint-send-input)
+ (insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
+ "\n")
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "picolisp-script-")))
+ (with-temp-file script-file
+ (insert (concat wrapped-body "(bye)")))
+ (org-babel-eval
+ (format "%s %s"
+ org-babel-picolisp-cmd
+ (org-babel-process-file-name script-file))
+ ""))))))
+
+(defun org-babel-picolisp-initiate-session (&optional session-name)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (unless (string= session-name "none")
+ (require 'inferior-picolisp)
+ ;; provide a reasonable default session name
+ (let ((session (or session-name "*inferior-picolisp*")))
+ ;; check if we already have a live session by this name
+ (if (org-babel-comint-buffer-livep session)
+ (get-buffer session)
+ (save-window-excursion
+ (run-picolisp org-babel-picolisp-cmd)
+ (rename-buffer session-name)
+ (current-buffer))))))
+
+(provide 'ob-picolisp)
+
+
+
+;;; ob-picolisp.el ends here
diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el
new file mode 100644
index 0000000..37d8b7d
--- /dev/null
+++ b/lisp/ob-plantuml.el
@@ -0,0 +1,86 @@
+;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Zhang Weize
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating plantuml script.
+;;
+;; Inspired by Ian Yang's org-export-blocks-format-plantuml
+;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el
+
+;;; Requirements:
+
+;; plantuml | http://plantuml.sourceforge.net/
+;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-default-header-args:plantuml
+ '((:results . "file") (:exports . "results"))
+ "Default arguments for evaluating a plantuml source block.")
+
+(defcustom org-plantuml-jar-path nil
+ "Path to the plantuml.jar file."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-execute:plantuml (body params)
+ "Execute a block of plantuml code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (out-file (or (cdr (assoc :file params))
+ (error "PlantUML requires a \":file\" header argument")))
+ (cmdline (cdr (assoc :cmdline params)))
+ (in-file (org-babel-temp-file "plantuml-"))
+ (java (or (cdr (assoc :java params)) ""))
+ (cmd (if (not org-plantuml-jar-path)
+ (error "`org-plantuml-jar-path' is not set")
+ (concat "java " java " -jar "
+ (shell-quote-argument
+ (expand-file-name org-plantuml-jar-path))
+ (if (string= (file-name-extension out-file) "svg")
+ " -tsvg" "")
+ (if (string= (file-name-extension out-file) "eps")
+ " -teps" "")
+ " -p " cmdline " < "
+ (org-babel-process-file-name in-file)
+ " > "
+ (org-babel-process-file-name out-file)))))
+ (unless (file-exists-p org-plantuml-jar-path)
+ (error "Could not find plantuml.jar at %s" org-plantuml-jar-path))
+ (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml")))
+ (message "%s" cmd) (org-babel-eval cmd "")
+ nil)) ;; signal that output has already been written to file
+
+(defun org-babel-prep-session:plantuml (session params)
+ "Return an error because plantuml does not support sessions."
+ (error "Plantuml does not support sessions"))
+
+(provide 'ob-plantuml)
+
+
+
+;;; ob-plantuml.el ends here
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
new file mode 100644
index 0000000..71adf73
--- /dev/null
+++ b/lisp/ob-python.el
@@ -0,0 +1,300 @@
+;;; ob-python.el --- org-babel functions for python evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating python source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function org-remove-indentation "org" )
+(declare-function py-shell "ext:python-mode" (&optional argprompt))
+(declare-function py-toggle-shells "ext:python-mode" (arg))
+(declare-function run-python "ext:python" (&optional cmd noshow new))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
+
+(defvar org-babel-default-header-args:python '())
+
+(defvar org-babel-python-command "python"
+ "Name of command for executing Python code.")
+
+(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
+ "Preferred python mode for use in running python interactively.
+This will typically be either 'python or 'python-mode.")
+
+(defvar org-src-preserve-indentation)
+
+(defun org-babel-execute:python (body params)
+ "Execute a block of Python code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (org-babel-python-initiate-session
+ (cdr (assoc :session params))))
+ (result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (return-val (when (and (eq result-type 'value) (not session))
+ (cdr (assoc :return params))))
+ (preamble (cdr (assoc :preamble params)))
+ (full-body
+ (org-babel-expand-body:generic
+ (concat body (if return-val (format "\nreturn %s" return-val) ""))
+ params (org-babel-variable-assignments:python params)))
+ (result (org-babel-python-evaluate
+ session full-body result-type result-params preamble)))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))
+
+(defun org-babel-prep-session:python (session params)
+ "Prepare SESSION according to the header arguments in PARAMS.
+VARS contains resolved variable references"
+ (let* ((session (org-babel-python-initiate-session session))
+ (var-lines
+ (org-babel-variable-assignments:python params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:python (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:python session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:python (params)
+ "Return a list of Python statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-python-var-to-python (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-python-var-to-python (var)
+ "Convert an elisp value to a python variable.
+Convert an elisp value, VAR, into a string of python source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
+ (if (equal var 'hline)
+ "None"
+ (format
+ (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
+ var))))
+
+(defun org-babel-python-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If the results look like a list or tuple, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+(defvar org-babel-python-buffers '((:default . nil)))
+
+(defun org-babel-python-session-buffer (session)
+ "Return the buffer associated with SESSION."
+ (cdr (assoc session org-babel-python-buffers)))
+
+(defvar py-default-interpreter)
+(defun org-babel-python-initiate-session-by-key (&optional session)
+ "Initiate a python session.
+If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (require org-babel-python-mode)
+ (save-window-excursion
+ (let* ((session (if session (intern session) :default))
+ (python-buffer (org-babel-python-session-buffer session)))
+ (cond
+ ((and (eq 'python org-babel-python-mode)
+ (fboundp 'run-python)) ; python.el
+ (run-python))
+ ((and (eq 'python-mode org-babel-python-mode)
+ (fboundp 'py-shell)) ; python-mode.el
+ ;; Make sure that py-which-bufname is initialized, as otherwise
+ ;; it will be overwritten the first time a Python buffer is
+ ;; created.
+ (py-toggle-shells py-default-interpreter)
+ ;; `py-shell' creates a buffer whose name is the value of
+ ;; `py-which-bufname' with '*'s at the beginning and end
+ (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer))
+ (replace-regexp-in-string ;; zap surrounding *
+ "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer)
+ (concat "Python-" (symbol-name session))))
+ (py-which-bufname bufname))
+ (py-shell)
+ (setq python-buffer (concat "*" bufname "*"))))
+ (t
+ (error "No function available for running an inferior Python")))
+ (setq org-babel-python-buffers
+ (cons (cons session python-buffer)
+ (assq-delete-all session org-babel-python-buffers)))
+ session)))
+
+(defun org-babel-python-initiate-session (&optional session params)
+ "Create a session named SESSION according to PARAMS."
+ (unless (string= session "none")
+ (org-babel-python-session-buffer
+ (org-babel-python-initiate-session-by-key session))))
+
+(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
+ "A string to indicate that evaluation has completed.")
+(defvar org-babel-python-wrapper-method
+ "
+def main():
+%s
+
+open('%s', 'w').write( str(main()) )")
+(defvar org-babel-python-pp-wrapper-method
+ "
+import pprint
+def main():
+%s
+
+open('%s', 'w').write( pprint.pformat(main()) )")
+
+(defun org-babel-python-evaluate
+ (session body &optional result-type result-params preamble)
+ "Evaluate BODY as Python code."
+ (if session
+ (org-babel-python-evaluate-session
+ session body result-type result-params)
+ (org-babel-python-evaluate-external-process
+ body result-type result-params preamble)))
+
+(defun org-babel-python-evaluate-external-process
+ (body &optional result-type result-params preamble)
+ "Evaluate BODY in external python process.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ ((lambda (raw)
+ (if (or (member "code" result-params)
+ (member "pp" result-params)
+ (and (member "output" result-params)
+ (not (member "table" result-params))))
+ raw
+ (org-babel-python-table-or-string (org-babel-trim raw))))
+ (case result-type
+ (output (org-babel-eval org-babel-python-command
+ (concat (if preamble (concat preamble "\n") "")
+ body)))
+ (value (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-eval
+ org-babel-python-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-python-pp-wrapper-method
+ org-babel-python-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-babel-trim body))
+ "[\r\n]") "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
+
+(defun org-babel-python-evaluate-session
+ (session body &optional result-type result-params)
+ "Pass BODY to the Python process in SESSION.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5)))
+ (dump-last-value
+ (lambda
+ (tmp-file pp)
+ (mapc
+ (lambda (statement) (insert statement) (funcall send-wait))
+ (if pp
+ (list
+ "import pprint"
+ (format "open('%s', 'w').write(pprint.pformat(_))"
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list (format "open('%s', 'w').write(str(_))"
+ (org-babel-process-file-name tmp-file 'noquote)))))))
+ (input-body (lambda (body)
+ (mapc (lambda (line) (insert line) (funcall send-wait))
+ (split-string body "[\r\n]"))
+ (funcall send-wait))))
+ ((lambda (results)
+ (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
+ (if (or (member "code" result-params)
+ (member "pp" result-params)
+ (and (member "output" result-params)
+ (not (member "table" result-params))))
+ results
+ (org-babel-python-table-or-string results))))
+ (case result-type
+ (output
+ (mapconcat
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator t body)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait))
+ 2) "\n"))
+ (value
+ (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator nil body)
+ (let ((comint-process-echoes nil))
+ (funcall input-body body)
+ (funcall dump-last-value tmp-file (member "pp" result-params))
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait)))
+ (org-babel-eval-read-file tmp-file)))))))
+
+(defun org-babel-python-read-string (string)
+ "Strip 's from around Python string."
+ (if (string-match "^'\\([^\000]+\\)'$" string)
+ (match-string 1 string)
+ string))
+
+(provide 'ob-python)
+
+
+
+;;; ob-python.el ends here
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
new file mode 100644
index 0000000..79861f1
--- /dev/null
+++ b/lisp/ob-ref.el
@@ -0,0 +1,265 @@
+;;; ob-ref.el --- org-babel functions for referencing external data
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Functions for referencing data from the header arguments of a
+;; org-babel block. The syntax of such a reference should be
+
+;; #+VAR: variable-name=file:resource-id
+
+;; - variable-name :: the name of the variable to which the value
+;; will be assigned
+
+;; - file :: path to the file containing the resource, or omitted if
+;; resource is in the current file
+
+;; - resource-id :: the id or name of the resource
+
+;; So an example of a simple src block referencing table data in the
+;; same file would be
+
+;; #+TBLNAME: sandbox
+;; | 1 | 2 | 3 |
+;; | 4 | org-babel | 6 |
+;;
+;; #+begin_src emacs-lisp :var table=sandbox
+;; (message table)
+;; #+end_src
+
+;;; Code:
+(require 'ob)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-remove-if-not "org" (predicate seq))
+(declare-function org-at-table-p "org" (&optional table-type))
+(declare-function org-count "org" (CL-ITEM CL-SEQ))
+(declare-function org-at-item-p "org-list" ())
+(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
+(declare-function org-show-context "org" (&optional key))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+(defvar org-babel-ref-split-regexp
+ "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
+
+(defvar org-babel-update-intermediate nil
+ "Update the in-buffer results of code blocks executed to resolve references.")
+
+(defun org-babel-ref-parse (assignment)
+ "Parse a variable ASSIGNMENT in a header argument.
+If the right hand side of the assignment has a literal value
+return that value, otherwise interpret as a reference to an
+external resource and find its value using
+`org-babel-ref-resolve'. Return a list with two elements. The
+first element of the list will be the name of the variable, and
+the second will be an emacs-lisp representation of the value of
+the variable."
+ (when (string-match org-babel-ref-split-regexp assignment)
+ (let ((var (match-string 1 assignment))
+ (ref (match-string 2 assignment)))
+ (cons (intern var)
+ (let ((out (org-babel-read ref)))
+ (if (equal out ref)
+ (if (string-match "^\".*\"$" ref)
+ (read ref)
+ (org-babel-ref-resolve ref))
+ out))))))
+
+(defun org-babel-ref-goto-headline-id (id)
+ (goto-char (point-min))
+ (let ((rx (regexp-quote id)))
+ (or (re-search-forward
+ (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t)
+ (let* ((file (org-id-find-id-file id))
+ (m (when file (org-id-find-id-in-file id file 'marker))))
+ (when (and file m)
+ (message "file:%S" file)
+ (org-pop-to-buffer-same-window (marker-buffer m))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)
+ t)))))
+
+(defun org-babel-ref-headline-body ()
+ (save-restriction
+ (org-narrow-to-subtree)
+ (buffer-substring
+ (save-excursion (goto-char (point-min))
+ (forward-line 1)
+ (when (looking-at "[ \t]*:PROPERTIES:")
+ (re-search-forward ":END:" nil)
+ (forward-char))
+ (point))
+ (point-max))))
+
+(defvar org-babel-library-of-babel)
+(defun org-babel-ref-resolve (ref)
+ "Resolve the reference REF and return its value."
+ (save-window-excursion
+ (save-excursion
+ (let ((case-fold-search t)
+ type args new-refere new-header-args new-referent result
+ lob-info split-file split-ref index index-row index-col id)
+ ;; if ref is indexed grab the indices -- beware nested indices
+ (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
+ (let ((str (substring ref 0 (match-beginning 0))))
+ (= (org-count ?( str) (org-count ?) str))))
+ (setq index (match-string 1 ref))
+ (setq ref (substring ref 0 (match-beginning 0))))
+ ;; assign any arguments to pass to source block
+ (when (string-match
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
+ (setq new-refere (match-string 1 ref))
+ (setq new-header-args (match-string 3 ref))
+ (setq new-referent (match-string 5 ref))
+ (when (> (length new-refere) 0)
+ (when (> (length new-referent) 0)
+ (setq args (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args new-referent))))
+ (when (> (length new-header-args) 0)
+ (setq args (append (org-babel-parse-header-arguments
+ new-header-args) args)))
+ (setq ref new-refere)))
+ (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
+ (setq split-file (match-string 1 ref))
+ (setq split-ref (match-string 2 ref))
+ (find-file split-file) (setq ref split-ref))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
+ (res-rx (org-babel-named-data-regexp-for-name ref)))
+ ;; goto ref in the current buffer
+ (or
+ ;; check for code blocks
+ (re-search-forward src-rx nil t)
+ ;; check for named data
+ (re-search-forward res-rx nil t)
+ ;; check for local or global headlines by id
+ (setq id (org-babel-ref-goto-headline-id ref))
+ ;; check the Library of Babel
+ (setq lob-info (cdr (assoc (intern ref)
+ org-babel-library-of-babel)))))
+ (unless (or lob-info id) (goto-char (match-beginning 0)))
+ ;; ;; TODO: allow searching for names in other buffers
+ ;; (setq id-loc (org-id-find ref 'marker)
+ ;; buffer (marker-buffer id-loc)
+ ;; loc (marker-position id-loc))
+ ;; (move-marker id-loc nil)
+ (error "Reference '%s' not found in this buffer" ref))
+ (cond
+ (lob-info (setq type 'lob))
+ (id (setq type 'id))
+ ((and (looking-at org-babel-src-name-regexp)
+ (save-excursion
+ (forward-line 1)
+ (or (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
+ (setq type 'source-block))
+ (t (while (not (setq type (org-babel-ref-at-ref-p)))
+ (forward-line 1)
+ (beginning-of-line)
+ (if (or (= (point) (point-min)) (= (point) (point-max)))
+ (error "Reference not found")))))
+ (let ((params (append args '((:results . "silent")))))
+ (setq result
+ (case type
+ (results-line (org-babel-read-result))
+ (table (org-babel-read-table))
+ (list (org-babel-read-list))
+ (file (org-babel-read-link))
+ (source-block (org-babel-execute-src-block
+ nil nil (if org-babel-update-intermediate
+ nil params)))
+ (lob (org-babel-execute-src-block
+ nil lob-info params))
+ (id (org-babel-ref-headline-body)))))
+ (if (symbolp result)
+ (format "%S" result)
+ (if (and index (listp result))
+ (org-babel-ref-index-list index result)
+ result)))))))
+
+(defun org-babel-ref-index-list (index lis)
+ "Return the subset of LIS indexed by INDEX.
+
+Indices are 0 based and negative indices count from the end of
+LIS, so 0 references the first element of LIS and -1 references
+the last. If INDEX is separated by \",\"s then each \"portion\"
+is assumed to index into the next deepest nesting or dimension.
+
+A valid \"portion\" can consist of either an integer index, two
+integers separated by a \":\" in which case the entire range is
+returned, or an empty string or \"*\" both of which are
+interpreted to mean the entire range and as such are equivalent
+to \"0:-1\"."
+ (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
+ (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
+ (lgth (length lis))
+ (portion (match-string 1 index))
+ (remainder (substring index (match-end 0)))
+ (wrap (lambda (num) (if (< num 0) (+ lgth num) num)))
+ (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))))
+ (funcall
+ open
+ (mapcar
+ (lambda (sub-lis)
+ (if (listp sub-lis)
+ (org-babel-ref-index-list remainder sub-lis)
+ sub-lis))
+ (if (or (= 0 (length portion)) (string-match ind-re portion))
+ (mapcar
+ (lambda (n) (nth n lis))
+ (apply 'org-number-sequence
+ (if (and (> (length portion) 0) (match-string 2 portion))
+ (list
+ (funcall wrap (string-to-number (match-string 2 portion)))
+ (funcall wrap (string-to-number (match-string 3 portion))))
+ (list (funcall wrap 0) (funcall wrap -1)))))
+ (list (nth (funcall wrap (string-to-number portion)) lis))))))
+ lis))
+
+(defun org-babel-ref-split-args (arg-string)
+ "Split ARG-STRING into top-level arguments of balanced parenthesis."
+ (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44)))
+
+(defvar org-bracket-link-regexp)
+(defun org-babel-ref-at-ref-p ()
+ "Return the type of reference located at point.
+Return nil if none of the supported reference types are found.
+Supported reference types are tables and source blocks."
+ (cond ((org-at-table-p) 'table)
+ ((org-at-item-p) 'list)
+ ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block)
+ ((looking-at org-bracket-link-regexp) 'file)
+ ((looking-at org-babel-result-regexp) 'results-line)))
+
+(provide 'ob-ref)
+
+
+
+;;; ob-ref.el ends here
diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el
new file mode 100644
index 0000000..54077d0
--- /dev/null
+++ b/lisp/ob-ruby.el
@@ -0,0 +1,245 @@
+;;; ob-ruby.el --- org-babel functions for ruby evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating ruby source code.
+
+;;; Requirements:
+
+;; - ruby and irb executables :: http://www.ruby-lang.org/
+;;
+;; - ruby-mode :: Can be installed through ELPA, or from
+;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
+;;
+;; - inf-ruby mode :: Can be installed through ELPA, or from
+;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function run-ruby "ext:inf-ruby" (&optional command name))
+(declare-function xmp "ext:rcodetools" (&optional option))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb"))
+
+(defvar org-babel-default-header-args:ruby '())
+
+(defvar org-babel-ruby-command "ruby"
+ "Name of command to use for executing ruby code.")
+
+(defun org-babel-execute:ruby (body params)
+ "Execute a block of Ruby code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (org-babel-ruby-initiate-session
+ (cdr (assoc :session params))))
+ (result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:ruby params)))
+ (result (if (member "xmp" result-params)
+ (with-temp-buffer
+ (require 'rcodetools)
+ (insert full-body)
+ (xmp (cdr (assoc :xmp-option params)))
+ (buffer-string))
+ (org-babel-ruby-evaluate
+ session full-body result-type result-params))))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))
+
+(defun org-babel-prep-session:ruby (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ ;; (message "params=%S" params) ;; debugging
+ (let* ((session (org-babel-ruby-initiate-session session))
+ (var-lines (org-babel-variable-assignments:ruby params)))
+ (org-babel-comint-in-buffer session
+ (sit-for .5) (goto-char (point-max))
+ (mapc (lambda (var)
+ (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1) (goto-char (point-max))) var-lines))
+ session))
+
+(defun org-babel-load-session:ruby (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:ruby session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:ruby (params)
+ "Return list of ruby statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-ruby-var-to-ruby (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-ruby-var-to-ruby (var)
+ "Convert VAR into a ruby variable.
+Convert an elisp value into a string of ruby source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
+ (format "%S" var)))
+
+(defun org-babel-ruby-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+(defun org-babel-ruby-initiate-session (&optional session params)
+ "Initiate a ruby session.
+If there is not a current inferior-process-buffer in SESSION
+then create one. Return the initialized session."
+ (unless (string= session "none")
+ (require 'inf-ruby)
+ (let ((session-buffer (save-window-excursion
+ (run-ruby nil session) (current-buffer))))
+ (if (org-babel-comint-buffer-livep session-buffer)
+ (progn (sit-for .25) session-buffer)
+ (sit-for .5)
+ (org-babel-ruby-initiate-session session)))))
+
+(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe"
+ "String to indicate that evaluation has completed.")
+(defvar org-babel-ruby-f-write
+ "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}")
+(defvar org-babel-ruby-pp-f-write
+ "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}")
+(defvar org-babel-ruby-wrapper-method
+ "
+def main()
+%s
+end
+results = main()
+File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) }
+")
+(defvar org-babel-ruby-pp-wrapper-method
+ "
+require 'pp'
+def main()
+%s
+end
+results = main()
+File.open('%s', 'w') do |f|
+ $stdout = f
+ pp results
+end
+")
+
+(defun org-babel-ruby-evaluate
+ (buffer body &optional result-type result-params)
+ "Pass BODY to the Ruby process in BUFFER.
+If RESULT-TYPE equals 'output then return a list of the outputs
+of the statements in BODY, if RESULT-TYPE equals 'value then
+return the value of the last statement in BODY, as elisp."
+ (if (not buffer)
+ ;; external process evaluation
+ (case result-type
+ (output (org-babel-eval org-babel-ruby-command body))
+ (value (let ((tmp-file (org-babel-temp-file "ruby-")))
+ (org-babel-eval
+ org-babel-ruby-command
+ (format (if (member "pp" result-params)
+ org-babel-ruby-pp-wrapper-method
+ org-babel-ruby-wrapper-method)
+ body (org-babel-process-file-name tmp-file 'noquote)))
+ ((lambda (raw)
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ raw
+ (org-babel-ruby-table-or-string raw)))
+ (org-babel-eval-read-file tmp-file)))))
+ ;; comint session evaluation
+ (case result-type
+ (output
+ (mapconcat
+ #'identity
+ (butlast
+ (split-string
+ (mapconcat
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (list body org-babel-ruby-eoe-indicator))
+ (comint-send-input nil t)) 2)
+ "\n") "[\r\n]")) "\n"))
+ (value
+ ((lambda (results)
+ (if (or (member "code" result-params) (member "pp" result-params))
+ results
+ (org-babel-ruby-table-or-string results)))
+ (let* ((tmp-file (org-babel-temp-file "ruby-"))
+ (ppp (or (member "code" result-params)
+ (member "pp" result-params))))
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t body)
+ (when ppp (insert "require 'pp';") (comint-send-input nil t))
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (append
+ (list body)
+ (if (not ppp)
+ (list (format org-babel-ruby-f-write
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list
+ "results=_" "require 'pp'" "orig_out = $stdout"
+ (format org-babel-ruby-pp-f-write
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (list org-babel-ruby-eoe-indicator)))
+ (comint-send-input nil t))
+ (org-babel-eval-read-file tmp-file)))))))
+
+(defun org-babel-ruby-read-string (string)
+ "Strip \\\"s from around a ruby string."
+ (if (string-match "^\"\\([^\000]+\\)\"$" string)
+ (match-string 1 string)
+ string))
+
+(provide 'ob-ruby)
+
+
+
+;;; ob-ruby.el ends here
diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el
new file mode 100644
index 0000000..c960610
--- /dev/null
+++ b/lisp/ob-sass.el
@@ -0,0 +1,72 @@
+;;; ob-sass.el --- org-babel functions for the sass css generation language
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; For more information on sass see http://sass-lang.com/
+;;
+;; This accepts a 'file' header argument which is the target of the
+;; compiled sass. The default output type for sass evaluation is
+;; either file (if a 'file' header argument was given) or scalar if no
+;; such header argument was supplied.
+;;
+;; A 'cmdline' header argument can be supplied to pass arguments to
+;; the sass command line.
+
+;;; Requirements:
+
+;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+
+(defvar org-babel-default-header-args:sass '())
+
+(defun org-babel-execute:sass (body params)
+ "Execute a block of Sass code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (file (cdr (assoc :file params)))
+ (out-file (or file (org-babel-temp-file "sass-out-")))
+ (cmdline (cdr (assoc :cmdline params)))
+ (in-file (org-babel-temp-file "sass-in-"))
+ (cmd (concat "sass " (or cmdline "")
+ " " (org-babel-process-file-name in-file)
+ " " (org-babel-process-file-name out-file))))
+ (with-temp-file in-file
+ (insert (org-babel-expand-body:generic body params)))
+ (org-babel-eval cmd "")
+ (if file
+ nil ;; signal that output has already been written to file
+ (with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
+
+(defun org-babel-prep-session:sass (session params)
+ "Raise an error because sass does not support sessions."
+ (error "Sass does not support sessions"))
+
+(provide 'ob-sass)
+
+
+
+;;; ob-sass.el ends here
diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el
new file mode 100644
index 0000000..b5eb184
--- /dev/null
+++ b/lisp/ob-scala.el
@@ -0,0 +1,120 @@
+;;; ob-scala.el --- org-babel functions for Scala evaluation
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Andrzej Lichnerowicz
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Currently only supports the external execution. No session support yet.
+
+;;; Requirements:
+;; - Scala language :: http://www.scala-lang.org/
+;; - Scala major mode :: Can be installed from Scala sources
+;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
+(defvar org-babel-default-header-args:scala '())
+(defvar org-babel-scala-command "scala"
+ "Name of the command to use for executing Scala code.")
+
+
+(defun org-babel-execute:scala (body params)
+ "Execute a block of Scala code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Scala source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-scala-initiate-session (nth 0 processed-params)))
+ (vars (nth 1 processed-params))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assoc :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-scala-evaluate
+ session full-body result-type result-params)))
+
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+
+(defun org-babel-scala-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If RESULTS look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+
+(defvar org-babel-scala-wrapper-method
+ "(
+%s
+) asString print
+")
+
+
+(defun org-babel-scala-evaluate
+ (session body &optional result-type result-params)
+ "Evaluate BODY in external Scala process.
+If RESULT-TYPE equals 'output then return standard output as a string.
+If RESULT-TYPE equals 'value then return the value of the last statement
+in BODY as elisp."
+ (when session (error "Sessions are not (yet) supported for Scala"))
+ (case result-type
+ (output
+ (let ((src-file (org-babel-temp-file "scala-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-scala-command " " src-file) ""))))
+ (value
+ (let* ((src-file (org-babel-temp-file "scala-"))
+ (wrapper (format org-babel-scala-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ ((lambda (raw)
+ (if (member "code" result-params)
+ raw
+ (org-babel-scala-table-or-string raw)))
+ (org-babel-eval
+ (concat org-babel-scala-command " " src-file) ""))))))
+
+
+(defun org-babel-prep-session:scala (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Scala"))
+
+(defun org-babel-scala-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Scala."
+ nil)
+
+(provide 'ob-scala)
+
+
+
+;;; ob-scala.el ends here
diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
new file mode 100644
index 0000000..ce29928
--- /dev/null
+++ b/lisp/ob-scheme.el
@@ -0,0 +1,137 @@
+;;; ob-scheme.el --- org-babel functions for Scheme
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, scheme
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Now working with SBCL for both session and external evaluation.
+;;
+;; This certainly isn't optimally robust, but it seems to be working
+;; for the basic use cases.
+
+;;; Requirements:
+
+;; - a working scheme implementation
+;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
+;;
+;; - for session based evaluation cmuscheme.el is required which is
+;; included in Emacs
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(eval-when-compile (require 'cl))
+
+(declare-function run-scheme "ext:cmuscheme" (cmd))
+
+(defvar org-babel-default-header-args:scheme '()
+ "Default header arguments for scheme code blocks.")
+
+(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
+ "String to indicate that evaluation has completed.")
+
+(defcustom org-babel-scheme-cmd "guile"
+ "Name of command used to evaluate scheme blocks."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defun org-babel-expand-body:scheme (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if (> (length vars) 0)
+ (concat "(let ("
+ (mapconcat
+ (lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
+ vars "\n ")
+ ")\n" body ")")
+ body)))
+
+(defvar scheme-program-name)
+(defun org-babel-execute:scheme (body params)
+ "Execute a block of Scheme code with org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
+ org-babel-scheme-cmd))
+ (full-body (org-babel-expand-body:scheme body params)))
+ (read
+ (if (not (string= (cdr (assoc :session params)) "none"))
+ ;; session evaluation
+ (let ((session (org-babel-prep-session:scheme
+ (cdr (assoc :session params)) params)))
+ (org-babel-comint-with-output
+ (session (format "%S" org-babel-scheme-eoe) t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (list body (format "%S" org-babel-scheme-eoe)))))
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "scheme-script-")))
+ (with-temp-file script-file
+ (insert
+ ;; return the value or the output
+ (if (string= result-type "value")
+ (format "(display %s)" full-body)
+ full-body)))
+ (org-babel-eval
+ (format "%s %s" org-babel-scheme-cmd
+ (org-babel-process-file-name script-file)) ""))))))
+
+(defun org-babel-prep-session:scheme (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-scheme-initiate-session session))
+ (vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (var-lines
+ (mapcar
+ (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
+ vars)))
+ (when session
+ (org-babel-comint-in-buffer session
+ (sit-for .5) (goto-char (point-max))
+ (mapc (lambda (var)
+ (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1) (goto-char (point-max))) var-lines)))
+ session))
+
+(defun org-babel-scheme-initiate-session (&optional session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ (require 'cmuscheme)
+ (unless (string= session "none")
+ (let ((session-buffer (save-window-excursion
+ (run-scheme org-babel-scheme-cmd)
+ (rename-buffer session)
+ (current-buffer))))
+ (if (org-babel-comint-buffer-livep session-buffer)
+ (progn (sit-for .25) session-buffer)
+ (sit-for .5)
+ (org-babel-scheme-initiate-session session)))))
+
+(provide 'ob-scheme)
+
+
+
+;;; ob-scheme.el ends here
diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el
new file mode 100644
index 0000000..c628892
--- /dev/null
+++ b/lisp/ob-screen.el
@@ -0,0 +1,146 @@
+;;; ob-screen.el --- org-babel support for interactive terminal
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Benjamin Andresen
+;; Keywords: literate programming, interactive shell
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for interactive terminals. Mostly shell scripts.
+;; Heavily inspired by 'eev' from Eduardo Ochs
+;;
+;; Adding :cmd and :terminal as header arguments
+;; :terminal must support the -T (title) and -e (command) parameter
+;;
+;; You can test the default setup. (xterm + sh) with
+;; M-x org-babel-screen-test RET
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+
+(defvar org-babel-screen-location "screen"
+ "The command location for screen.
+In case you want to use a different screen than one selected by your $PATH")
+
+(defvar org-babel-default-header-args:screen
+ '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm"))
+ "Default arguments to use when running screen source blocks.")
+
+(defun org-babel-execute:screen (body params)
+ "Send a block of code via screen to a terminal using Babel.
+\"default\" session is used when none is specified."
+ (message "Sending source code block to interactive terminal session...")
+ (save-window-excursion
+ (let* ((session (cdr (assoc :session params)))
+ (socket (org-babel-screen-session-socketname session)))
+ (unless socket (org-babel-prep-session:screen session params))
+ (org-babel-screen-session-execute-string
+ session (org-babel-expand-body:generic body params)))))
+
+(defun org-babel-prep-session:screen (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (cdr (assoc :session params)))
+ (socket (org-babel-screen-session-socketname session))
+ (cmd (cdr (assoc :cmd params)))
+ (terminal (cdr (assoc :terminal params)))
+ (process-name (concat "org-babel: terminal (" session ")")))
+ (apply 'start-process process-name "*Messages*"
+ terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location
+ "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session)
+ ,cmd))
+ ;; XXX: Is there a better way than the following?
+ (while (not (org-babel-screen-session-socketname session))
+ ;; wait until screen session is available before returning
+ )))
+
+;; helper functions
+
+(defun org-babel-screen-session-execute-string (session body)
+ "If SESSION exists, send BODY to it."
+ (let ((socket (org-babel-screen-session-socketname session)))
+ (when socket
+ (let ((tmpfile (org-babel-screen-session-write-temp-file session body)))
+ (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*"
+ org-babel-screen-location
+ `("-S" ,socket "-X" "eval" "msgwait 0"
+ ,(concat "readreg z " tmpfile)
+ "paste z"))))))
+
+(defun org-babel-screen-session-socketname (session)
+ "Check if SESSION exists by parsing output of \"screen -ls\"."
+ (let* ((screen-ls (shell-command-to-string "screen -ls"))
+ (sockets (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (when (string-match (rx (or "(Attached)" "(Detached)")) x)
+ x))
+ (split-string screen-ls "\n"))))
+ (match-socket (car
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (when (string-match
+ (concat "org-babel-session-" session) x)
+ x))
+ sockets)))))
+ (when match-socket (car (split-string match-socket)))))
+
+(defun org-babel-screen-session-write-temp-file (session body)
+ "Save BODY in a temp file that is named after SESSION."
+ (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session)))
+ (with-temp-file tmpfile
+ (insert body)
+
+ ;; org-babel has superfluous spaces
+ (goto-char (point-min))
+ (delete-matching-lines "^ +$"))
+ tmpfile))
+
+(defun org-babel-screen-test ()
+ "Test if the default setup works.
+The terminal should shortly flicker."
+ (interactive)
+ (let* ((session "org-babel-testing")
+ (random-string (format "%s" (random 99999)))
+ (tmpfile "/tmp/org-babel-screen.test")
+ (body (concat "echo '" random-string "' > " tmpfile "\nexit\n"))
+ process tmp-string)
+ (org-babel-execute:screen body org-babel-default-header-args:screen)
+ ;; XXX: need to find a better way to do the following
+ (while (not (file-readable-p tmpfile))
+ ;; do something, otherwise this will be optimized away
+ (format "org-babel-screen: File not readable yet."))
+ (setq tmp-string (with-temp-buffer
+ (insert-file-contents-literally tmpfile)
+ (buffer-substring (point-min) (point-max))))
+ (delete-file tmpfile)
+ (message (concat "org-babel-screen: Setup "
+ (if (string-match random-string tmp-string)
+ "WORKS."
+ "DOESN'T work.")))))
+
+(provide 'ob-screen)
+
+
+
+;;; ob-screen.el ends here
diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el
new file mode 100644
index 0000000..1cb607f
--- /dev/null
+++ b/lisp/ob-sh.el
@@ -0,0 +1,216 @@
+;;; ob-sh.el --- org-babel functions for shell evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating shell source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+(require 'shell)
+(eval-when-compile (require 'cl))
+
+(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
+(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
+(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
+(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
+(declare-function orgtbl-to-generic "org-table" (table params))
+
+(defvar org-babel-default-header-args:sh '())
+
+(defvar org-babel-sh-command "sh"
+ "Command used to invoke a shell.
+This will be passed to `shell-command-on-region'")
+
+(defcustom org-babel-sh-var-quote-fmt
+ "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
+ "Format string used to escape variables when passed to shell scripts."
+ :group 'org-babel
+ :type 'string)
+
+(defun org-babel-execute:sh (body params)
+ "Execute a block of Shell commands with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (org-babel-sh-initiate-session
+ (cdr (assoc :session params))))
+ (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
+ (org-babel-ref-resolve stdin))))
+ (cdr (assoc :stdin params))))
+ (full-body (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:sh params))))
+ (org-babel-reassemble-table
+ (org-babel-sh-evaluate session full-body params stdin)
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+
+(defun org-babel-prep-session:sh (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-sh-initiate-session session))
+ (var-lines (org-babel-variable-assignments:sh params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:sh (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:sh session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:sh (params)
+ "Return list of shell statements assigning the block's variables."
+ (let ((sep (cdr (assoc :separator params))))
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-sh-var-to-sh (cdr pair) sep)))
+ (mapcar #'cdr (org-babel-get-header params :var)))))
+
+(defun org-babel-sh-var-to-sh (var &optional sep)
+ "Convert an elisp value to a shell variable.
+Convert an elisp var into a string of shell commands specifying a
+var of the same value."
+ (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep)))
+
+(defun org-babel-sh-var-to-string (var &optional sep)
+ "Convert an elisp value to a string."
+ (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
+ (cond
+ ((and (listp var) (listp (car var)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
+ ((listp var)
+ (mapconcat echo-var var "\n"))
+ (t (funcall echo-var var)))))
+
+(defun org-babel-sh-table-or-results (results)
+ "Convert RESULTS to an appropriate elisp value.
+If the results look like a table, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (org-babel-script-escape results))
+
+(defun org-babel-sh-initiate-session (&optional session params)
+ "Initiate a session named SESSION according to PARAMS."
+ (when (and session (not (string= session "none")))
+ (save-window-excursion
+ (or (org-babel-comint-buffer-livep session)
+ (progn (shell session) (get-buffer (current-buffer)))))))
+
+(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
+ "String to indicate that evaluation has completed.")
+(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
+ "String to indicate that evaluation has completed.")
+
+(defun org-babel-sh-evaluate (session body &optional params stdin)
+ "Pass BODY to the Shell process in BUFFER.
+If RESULT-TYPE equals 'output then return a list of the outputs
+of the statements in BODY, if RESULT-TYPE equals 'value then
+return the value of the last statement in BODY."
+ ((lambda (results)
+ (when results
+ (let ((result-params (cdr (assoc :result-params params))))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "output" result-params))
+ results
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file))))))
+ (cond
+ (stdin ; external shell script w/STDIN
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (with-temp-file stdin-file (insert stdin))
+ (with-temp-buffer
+ (call-process-shell-command
+ (if shebang
+ script-file
+ (format "%s %s" org-babel-sh-command script-file))
+ stdin-file
+ (current-buffer))
+ (buffer-string))))
+ (session ; session evaluation
+ (mapconcat
+ #'org-babel-sh-strip-weird-long-prompt
+ (mapcar
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-sh-eoe-output t body)
+ (mapc
+ (lambda (line)
+ (insert line)
+ (comint-send-input nil t)
+ (while (save-excursion
+ (goto-char comint-last-input-end)
+ (not (re-search-forward
+ comint-prompt-regexp nil t)))
+ (accept-process-output (get-buffer-process (current-buffer)))))
+ (append
+ (split-string (org-babel-trim body) "\n")
+ (list org-babel-sh-eoe-indicator))))
+ 2)) "\n"))
+ ('otherwise ; external shell script
+ (if (and (cdr (assoc :shebang params))
+ (> (length (cdr (assoc :shebang params))) 0))
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (org-babel-eval script-file ""))
+ (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+
+(defun org-babel-sh-strip-weird-long-prompt (string)
+ "Remove prompt cruft from a string of shell output."
+ (while (string-match "^% +[\r\n$]+ *" string)
+ (setq string (substring string (match-end 0))))
+ string)
+
+(provide 'ob-sh)
+
+
+
+;;; ob-sh.el ends here
diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el
new file mode 100644
index 0000000..8f4b132
--- /dev/null
+++ b/lisp/ob-shen.el
@@ -0,0 +1,79 @@
+;;; ob-shen.el --- org-babel functions for Shen
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, shen
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Currently this only works using session evaluation as there is no
+;; defined method for executing shen code outside of a session.
+
+;;; Requirements:
+
+;; - shen-mode and inf-shen will soon be available through the GNU
+;; elpa, however in the interim they are available at
+;; https://github.com/eschulte/shen-mode
+
+;;; Code:
+(require 'ob)
+
+(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+
+(defvar org-babel-default-header-args:shen '()
+ "Default header arguments for shen code blocks.")
+
+(defun org-babel-expand-body:shen (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (if (> (length vars) 0)
+ (concat "(let "
+ (mapconcat (lambda (var)
+ (format "%s %s" (car var)
+ (org-babel-shen-var-to-shen (cdr var))))
+ vars " ")
+ body ")")
+ body)))
+
+(defun org-babel-shen-var-to-shen (var)
+ "Convert VAR into a shen variable."
+ (if (listp var)
+ (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]")
+ (format "%S" var)))
+
+(defun org-babel-execute:shen (body params)
+ "Execute a block of Shen code with org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (require 'inf-shen)
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (result-params (cdr (assoc :result-params params)))
+ (full-body (org-babel-expand-body:shen body params)))
+ ((lambda (results)
+ (if (or (member 'scalar result-params)
+ (member 'verbatim result-params))
+ results
+ (condition-case nil (org-babel-script-escape results)
+ (error results))))
+ (with-temp-buffer
+ (insert full-body)
+ (call-interactively #'shen-eval-defun)))))
+
+(provide 'ob-shen)
+;;; ob-shen.el ends here
diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
new file mode 100644
index 0000000..ad7b1e2
--- /dev/null
+++ b/lisp/ob-sql.el
@@ -0,0 +1,169 @@
+;;; ob-sql.el --- org-babel functions for sql evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating sql source code.
+;; (see also ob-sqlite.el)
+;;
+;; SQL is somewhat unique in that there are many different engines for
+;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this
+;; file will have to be implemented engine by engine.
+;;
+;; Also SQL evaluation generally takes place inside of a database.
+;;
+;; For now lets just allow a generic ':cmdline' header argument.
+;;
+;; TODO:
+;;
+;; - support for sessions
+;; - add more useful header arguments (user, passwd, database, etc...)
+;; - support for more engines (currently only supports mysql)
+;; - what's a reasonable way to drop table data into SQL?
+;;
+
+;;; Code:
+(require 'ob)
+(eval-when-compile (require 'cl))
+
+(declare-function org-table-import "org-table" (file arg))
+(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
+
+(defvar org-babel-default-header-args:sql '())
+
+(defvar org-babel-header-args:sql
+ '((engine . :any)
+ (out-file . :any)))
+
+(defun org-babel-expand-body:sql (body params)
+ "Expand BODY according to the values of PARAMS."
+ (org-babel-sql-expand-vars
+ body (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defun org-babel-execute:sql (body params)
+ "Execute a block of Sql code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (cmdline (cdr (assoc :cmdline params)))
+ (engine (cdr (assoc :engine params)))
+ (in-file (org-babel-temp-file "sql-in-"))
+ (out-file (or (cdr (assoc :out-file params))
+ (org-babel-temp-file "sql-out-")))
+ (header-delim "")
+ (command (case (intern engine)
+ ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ "/^+/d;s/^\|//;$d"
+ (org-babel-process-file-name out-file)))
+ ('monetdb (format "mclient -f tab %s < %s > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ ('msosql (format "osql %s -s \"\t\" -i %s -o %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ ('mysql (format "mysql %s < %s > %s"
+ (or cmdline "")
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)))
+ ('postgresql (format
+ "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
+ (org-babel-process-file-name in-file)
+ (org-babel-process-file-name out-file)
+ (or cmdline "")))
+ (t (error "No support for the %s SQL engine" engine)))))
+ (with-temp-file in-file
+ (insert
+ (case (intern engine)
+ ('dbi "/format partbox\n")
+ (t ""))
+ (org-babel-expand-body:sql body params)))
+ (message command)
+ (shell-command command)
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "html" result-params)
+ (member "code" result-params)
+ (equal (point-min) (point-max)))
+ (with-temp-buffer
+ (progn (insert-file-contents-literally out-file) (buffer-string)))
+ (with-temp-buffer
+ ;; need to figure out what the delimiter is for the header row
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(-+\\)[^-]" nil t)
+ (setq header-delim (match-string-no-properties 1)))
+ (goto-char (point-max))
+ (forward-char -1)
+ (while (looking-at "\n")
+ (delete-char 1)
+ (goto-char (point-max))
+ (forward-char -1))
+ (write-file out-file))
+ (org-table-import out-file '(16))
+ (org-babel-reassemble-table
+ (mapcar (lambda (x)
+ (if (string= (car x) header-delim)
+ 'hline
+ x))
+ (org-table-to-lisp))
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))))
+
+(defun org-babel-sql-expand-vars (body vars)
+ "Expand the variables held in VARS in BODY."
+ (mapc
+ (lambda (pair)
+ (setq body
+ (replace-regexp-in-string
+ (format "\$%s" (car pair))
+ ((lambda (val)
+ (if (listp val)
+ ((lambda (data-file)
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (org-babel-temp-file "sql-data-"))
+ (if (stringp val) val (format "%S" val))))
+ (cdr pair))
+ body)))
+ vars)
+ body)
+
+(defun org-babel-prep-session:sql (session params)
+ "Raise an error because Sql sessions aren't implemented."
+ (error "SQL sessions not yet implemented"))
+
+(provide 'ob-sql)
+
+
+
+;;; ob-sql.el ends here
diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el
new file mode 100644
index 0000000..24a7dd5
--- /dev/null
+++ b/lisp/ob-sqlite.el
@@ -0,0 +1,166 @@
+;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating sqlite source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-eval)
+(require 'ob-ref)
+
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-table-convert-region "org-table"
+ (beg0 end0 &optional separator))
+(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS))
+
+(defvar org-babel-default-header-args:sqlite '())
+
+(defvar org-babel-header-args:sqlite
+ '((db . :any)
+ (header . :any)
+ (echo . :any)
+ (bail . :any)
+ (csv . :any)
+ (column . :any)
+ (html . :any)
+ (line . :any)
+ (list . :any)
+ (separator . :any)
+ (nullvalue . :any))
+ "Sqlite specific header args.")
+
+(defun org-babel-expand-body:sqlite (body params)
+ "Expand BODY according to the values of PARAMS."
+ (org-babel-sqlite-expand-vars
+ body (mapcar #'cdr (org-babel-get-header params :var))))
+
+(defvar org-babel-sqlite3-command "sqlite3")
+
+(defun org-babel-execute:sqlite (body params)
+ "Execute a block of Sqlite code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (db (cdr (assoc :db params)))
+ (separator (cdr (assoc :separator params)))
+ (nullvalue (cdr (assoc :nullvalue params)))
+ (headers-p (equal "yes" (cdr (assoc :colnames params))))
+ (others (delq nil (mapcar
+ (lambda (arg) (car (assoc arg params)))
+ (list :header :echo :bail :column
+ :csv :html :line :list))))
+ exit-code)
+ (unless db (error "ob-sqlite: can't evaluate without a database"))
+ (with-temp-buffer
+ (insert
+ (org-babel-eval
+ (org-fill-template
+ "%cmd %header %separator %nullvalue %others %csv %db "
+ (list
+ (cons "cmd" org-babel-sqlite3-command)
+ (cons "header" (if headers-p "-header" "-noheader"))
+ (cons "separator"
+ (if separator (format "-separator %s" separator) ""))
+ (cons "nullvalue"
+ (if nullvalue (format "-nullvalue %s" nullvalue) ""))
+ (cons "others"
+ (mapconcat
+ (lambda (arg) (format "-%s" (substring (symbol-name arg) 1)))
+ others " "))
+ ;; for easy table parsing, default header type should be -csv
+ (cons "csv" (if (or (member :csv others) (member :column others)
+ (member :line others) (member :list others)
+ (member :html others) separator)
+ ""
+ "-csv"))
+ (cons "db " db)))
+ ;; body of the code block
+ (org-babel-expand-body:sqlite body params)))
+ (if (or (member "scalar" result-params)
+ (member "verbatim" result-params)
+ (member "html" result-params)
+ (member "code" result-params)
+ (equal (point-min) (point-max)))
+ (buffer-string)
+ (org-table-convert-region (point-min) (point-max)
+ (if (or (member :csv others)
+ (member :column others)
+ (member :line others)
+ (member :list others)
+ (member :html others) separator)
+ nil
+ '(4)))
+ (org-babel-sqlite-table-or-scalar
+ (org-babel-sqlite-offset-colnames
+ (org-table-to-lisp) headers-p))))))
+
+(defun org-babel-sqlite-expand-vars (body vars)
+ "Expand the variables held in VARS in BODY."
+ (mapc
+ (lambda (pair)
+ (setq body
+ (replace-regexp-in-string
+ (format "\$%s" (car pair))
+ ((lambda (val)
+ (if (listp val)
+ ((lambda (data-file)
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (org-babel-temp-file "sqlite-data-"))
+ (if (stringp val) val (format "%S" val))))
+ (cdr pair))
+ body)))
+ vars)
+ body)
+
+(defun org-babel-sqlite-table-or-scalar (result)
+ "If RESULT looks like a trivial table, then unwrap it."
+ (if (and (equal 1 (length result))
+ (equal 1 (length (car result))))
+ (org-babel-read (caar result))
+ (mapcar (lambda (row)
+ (if (equal 'hline row)
+ 'hline
+ (mapcar #'org-babel-read row))) result)))
+
+(defun org-babel-sqlite-offset-colnames (table headers-p)
+ "If HEADERS-P is non-nil then offset the first row as column names."
+ (if headers-p
+ (cons (car table) (cons 'hline (cdr table)))
+ table))
+
+(defun org-babel-prep-session:sqlite (session params)
+ "Raise an error because support for SQLite sessions isn't implemented.
+Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "SQLite sessions not yet implemented"))
+
+(provide 'ob-sqlite)
+
+
+
+;;; ob-sqlite.el ends here
diff --git a/lisp/ob-table.el b/lisp/ob-table.el
new file mode 100644
index 0000000..242ddf0
--- /dev/null
+++ b/lisp/ob-table.el
@@ -0,0 +1,138 @@
+;;; ob-table.el --- support for calling org-babel functions from tables
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Should allow calling functions from org-mode tables using the
+;; function `sbe' as so...
+
+;; #+begin_src emacs-lisp :results silent
+;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
+;; #+end_src
+
+;; #+name: fibbd
+;; #+begin_src emacs-lisp :var n=2 :results silent
+;; (fibbd n)
+;; #+end_src
+
+;; | original | fibbd |
+;; |----------+--------|
+;; | 0 | |
+;; | 1 | |
+;; | 2 | |
+;; | 3 | |
+;; | 4 | |
+;; | 5 | |
+;; | 6 | |
+;; | 7 | |
+;; | 8 | |
+;; | 9 | |
+;; #+TBLFM: $2='(sbe 'fibbd (n $1))
+
+;;; Code:
+(require 'ob)
+
+(defun org-babel-table-truncate-at-newline (string)
+ "Replace newline character with ellipses.
+If STRING ends in a newline character, then remove the newline
+character and replace it with ellipses."
+ (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
+ (concat (substring string 0 (match-beginning 0))
+ (if (match-string 1 string) "...")) string))
+
+(defmacro sbe (source-block &rest variables)
+ "Return the results of calling SOURCE-BLOCK with VARIABLES.
+Each element of VARIABLES should be a two
+element list, whose first element is the name of the variable and
+second element is a string of its value. The following call to
+`sbe' would be equivalent to the following source code block.
+
+ (sbe 'source-block (n $2) (m 3))
+
+#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
+results
+#+end_src
+
+NOTE: by default string variable names are interpreted as
+references to source-code blocks, to force interpretation of a
+cell's value as a string, prefix the identifier a \"$\" (e.g.,
+\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
+
+NOTE: it is also possible to pass header arguments to the code
+block. In this case a table cell should hold the string value of
+the header argument which can then be passed before all variables
+as shown in the example below.
+
+| 1 | 2 | :file nothing.png | nothing.png |
+#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
+ (let* ((header-args (if (stringp (car variables)) (car variables) ""))
+ (variables (if (stringp (car variables)) (cdr variables) variables)))
+ (let* (quote
+ (variables
+ (mapcar
+ (lambda (var)
+ ;; ensure that all cells prefixed with $'s are strings
+ (cons (car var)
+ (delq nil (mapcar
+ (lambda (el)
+ (if (eq '$ el)
+ (prog1 nil (setq quote t))
+ (prog1 (if quote
+ (format "\"%s\"" el)
+ (org-no-properties el))
+ (setq quote nil))))
+ (cdr var)))))
+ variables)))
+ (unless (stringp source-block)
+ (setq source-block (symbol-name source-block)))
+ ((lambda (result)
+ (org-babel-trim (if (stringp result) result (format "%S" result))))
+ (if (and source-block (> (length source-block) 0))
+ (let ((params
+ (eval `(org-babel-parse-header-arguments
+ (concat
+ ":var results="
+ ,source-block
+ "[" ,header-args "]"
+ "("
+ (mapconcat
+ (lambda (var-spec)
+ (if (> (length (cdr var-spec)) 1)
+ (format "%S='%S"
+ (car var-spec)
+ (mapcar #'read (cdr var-spec)))
+ (format "%S=%s"
+ (car var-spec) (cadr var-spec))))
+ ',variables ", ")
+ ")")))))
+ (org-babel-execute-src-block
+ nil (list "emacs-lisp" "results" params)
+ '((:results . "silent"))))
+ "")))))
+(def-edebug-spec sbe (form form))
+
+(provide 'ob-table)
+
+
+
+;;; ob-table.el ends here
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
new file mode 100644
index 0000000..7077a15
--- /dev/null
+++ b/lisp/ob-tangle.el
@@ -0,0 +1,519 @@
+;;; ob-tangle.el --- extract source code from org-mode files
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Extract the code from source blocks out into raw source-code files.
+
+;;; Code:
+(require 'ob)
+(require 'org-src)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-heading-components "org" ())
+(declare-function org-back-to-heading "org" (invisible-ok))
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-babel-update-block-body "org" (new-body))
+(declare-function make-directory "files" (dir &optional parents))
+
+;;;###autoload
+(defcustom org-babel-tangle-lang-exts
+ '(("emacs-lisp" . "el"))
+ "Alist mapping languages to their file extensions.
+The key is the language name, the value is the string that should
+be inserted as the extension commonly used to identify files
+written in this language. If no entry is found in this list,
+then the name of the language is used."
+ :group 'org-babel-tangle
+ :version "24.1"
+ :type '(repeat
+ (cons
+ (string "Language name")
+ (string "File Extension"))))
+
+(defcustom org-babel-post-tangle-hook nil
+ "Hook run in code files tangled by `org-babel-tangle'."
+ :group 'org-babel
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-babel-pre-tangle-hook '(save-buffer)
+ "Hook run at the beginning of `org-babel-tangle'."
+ :group 'org-babel
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-babel-tangle-body-hook nil
+ "Hook run over the contents of each code block body."
+ :group 'org-babel
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]"
+ "Format of inserted comments in tangled code files.
+The following format strings can be used to insert special
+information into the output using `org-fill-template'.
+%start-line --- the line number at the start of the code block
+%file --------- the file from which the code block was tangled
+%link --------- Org-mode style link to the code block
+%source-name -- name of the code block
+
+Whether or not comments are inserted during tangling is
+controlled by the :comments header argument."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-babel-tangle-comment-format-end "%source-name ends here"
+ "Format of inserted comments in tangled code files.
+The following format strings can be used to insert special
+information into the output using `org-fill-template'.
+%start-line --- the line number at the start of the code block
+%file --------- the file from which the code block was tangled
+%link --------- Org-mode style link to the code block
+%source-name -- name of the code block
+
+Whether or not comments are inserted during tangling is
+controlled by the :comments header argument."
+ :group 'org-babel
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-babel-process-comment-text #'org-babel-trim
+ "Function called to process raw Org-mode text collected to be
+inserted as comments in tangled source-code files. The function
+should take a single string argument and return a string
+result. The default value is `org-babel-trim'."
+ :group 'org-babel
+ :version "24.1"
+ :type 'function)
+
+(defun org-babel-find-file-noselect-refresh (file)
+ "Find file ensuring that the latest changes on disk are
+represented in the file."
+ (find-file-noselect file)
+ (with-current-buffer (get-file-buffer file)
+ (revert-buffer t t t)))
+
+(defmacro org-babel-with-temp-filebuffer (file &rest body)
+ "Open FILE into a temporary buffer execute BODY there like
+`progn', then kill the FILE buffer returning the result of
+evaluating BODY."
+ (declare (indent 1))
+ (let ((temp-path (make-symbol "temp-path"))
+ (temp-result (make-symbol "temp-result"))
+ (temp-file (make-symbol "temp-file"))
+ (visited-p (make-symbol "visited-p")))
+ `(let* ((,temp-path ,file)
+ (,visited-p (get-file-buffer ,temp-path))
+ ,temp-result ,temp-file)
+ (org-babel-find-file-noselect-refresh ,temp-path)
+ (setf ,temp-file (get-file-buffer ,temp-path))
+ (with-current-buffer ,temp-file
+ (setf ,temp-result (progn ,@body)))
+ (unless ,visited-p (kill-buffer ,temp-file))
+ ,temp-result)))
+(def-edebug-spec org-babel-with-temp-filebuffer (form body))
+
+;;;###autoload
+(defun org-babel-load-file (file)
+ "Load Emacs Lisp source code blocks in the Org-mode FILE.
+This function exports the source code using
+`org-babel-tangle' and then loads the resulting file using
+`load-file'."
+ (interactive "fFile to load: ")
+ (let* ((age (lambda (file)
+ (float-time
+ (time-subtract (current-time)
+ (nth 5 (or (file-attributes (file-truename file))
+ (file-attributes file)))))))
+ (base-name (file-name-sans-extension file))
+ (exported-file (concat base-name ".el")))
+ ;; tangle if the org-mode file is newer than the elisp file
+ (unless (and (file-exists-p exported-file)
+ (> (funcall age file) (funcall age exported-file)))
+ (org-babel-tangle-file file exported-file "emacs-lisp"))
+ (load-file exported-file)
+ (message "Loaded %s" exported-file)))
+
+;;;###autoload
+(defun org-babel-tangle-file (file &optional target-file lang)
+ "Extract the bodies of source code blocks in FILE.
+Source code blocks are extracted with `org-babel-tangle'.
+Optional argument TARGET-FILE can be used to specify a default
+export file for all source blocks. Optional argument LANG can be
+used to limit the exported source code blocks by language."
+ (interactive "fFile to tangle: \nP")
+ (let ((visited-p (get-file-buffer (expand-file-name file)))
+ to-be-removed)
+ (save-window-excursion
+ (find-file file)
+ (setq to-be-removed (current-buffer))
+ (org-babel-tangle nil target-file lang))
+ (unless visited-p
+ (kill-buffer to-be-removed))))
+
+(defun org-babel-tangle-publish (_ filename pub-dir)
+ "Tangle FILENAME and place the results in PUB-DIR."
+ (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
+
+;;;###autoload
+(defun org-babel-tangle (&optional only-this-block target-file lang)
+ "Write code blocks to source-specific files.
+Extract the bodies of all source code blocks from the current
+file into their own source-specific files. Optional argument
+TARGET-FILE can be used to specify a default export file for all
+source blocks. Optional argument LANG can be used to limit the
+exported source code blocks by language."
+ (interactive "P")
+ (run-hooks 'org-babel-pre-tangle-hook)
+ ;; possibly restrict the buffer to the current code block
+ (save-restriction
+ (when only-this-block
+ (unless (org-babel-where-is-src-block-head)
+ (error "Point is not currently inside of a code block"))
+ (save-match-data
+ (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ target-file)
+ (setq target-file
+ (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
+ (narrow-to-region (match-beginning 0) (match-end 0)))
+ (save-excursion
+ (let ((block-counter 0)
+ (org-babel-default-header-args
+ (if target-file
+ (org-babel-merge-params org-babel-default-header-args
+ (list (cons :tangle target-file)))
+ org-babel-default-header-args))
+ path-collector)
+ (mapc ;; map over all languages
+ (lambda (by-lang)
+ (let* ((lang (car by-lang))
+ (specs (cdr by-lang))
+ (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
+ (lang-f (intern
+ (concat
+ (or (and (cdr (assoc lang org-src-lang-modes))
+ (symbol-name
+ (cdr (assoc lang org-src-lang-modes))))
+ lang)
+ "-mode")))
+ she-banged)
+ (mapc
+ (lambda (spec)
+ (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
+ (let* ((tangle (funcall get-spec :tangle))
+ (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
+ (funcall get-spec :shebang)))
+ (base-name (cond
+ ((string= "yes" tangle)
+ (file-name-sans-extension
+ (buffer-file-name)))
+ ((string= "no" tangle) nil)
+ ((> (length tangle) 0) tangle)))
+ (file-name (when base-name
+ ;; decide if we want to add ext to base-name
+ (if (and ext (string= "yes" tangle))
+ (concat base-name "." ext) base-name))))
+ (when file-name
+ ;; possibly create the parent directories for file
+ (when ((lambda (m) (and m (not (string= m "no"))))
+ (funcall get-spec :mkdirp))
+ (make-directory (file-name-directory file-name) 'parents))
+ ;; delete any old versions of file
+ (when (and (file-exists-p file-name)
+ (not (member file-name path-collector)))
+ (delete-file file-name))
+ ;; drop source-block to file
+ (with-temp-buffer
+ (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
+ (when (and she-bang (not (member file-name she-banged)))
+ (insert (concat she-bang "\n"))
+ (setq she-banged (cons file-name she-banged)))
+ (org-babel-spec-to-string spec)
+ ;; We avoid append-to-file as it does not work with tramp.
+ (let ((content (buffer-string)))
+ (with-temp-buffer
+ (if (file-exists-p file-name)
+ (insert-file-contents file-name))
+ (goto-char (point-max))
+ (insert content)
+ (write-region nil nil file-name))))
+ ;; if files contain she-bangs, then make the executable
+ (when she-bang (set-file-modes file-name #o755))
+ ;; update counter
+ (setq block-counter (+ 1 block-counter))
+ (add-to-list 'path-collector file-name)))))
+ specs)))
+ (org-babel-tangle-collect-blocks lang))
+ (message "Tangled %d code block%s from %s" block-counter
+ (if (= block-counter 1) "" "s")
+ (file-name-nondirectory
+ (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ ;; run `org-babel-post-tangle-hook' in all tangled files
+ (when org-babel-post-tangle-hook
+ (mapc
+ (lambda (file)
+ (org-babel-with-temp-filebuffer file
+ (run-hooks 'org-babel-post-tangle-hook)))
+ path-collector))
+ path-collector))))
+
+(defun org-babel-tangle-clean ()
+ "Remove comments inserted by `org-babel-tangle'.
+Call this function inside of a source-code file generated by
+`org-babel-tangle' to remove all comments inserted automatically
+by `org-babel-tangle'. Warning, this comment removes any lines
+containing constructs which resemble org-mode file links or noweb
+references."
+ (interactive)
+ (goto-char (point-min))
+ (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t)
+ (re-search-forward (org-babel-noweb-wrap) nil t))
+ (delete-region (save-excursion (beginning-of-line 1) (point))
+ (save-excursion (end-of-line 1) (forward-char 1) (point)))))
+
+(defvar org-stored-links)
+(defvar org-bracket-link-regexp)
+(defun org-babel-spec-to-string (spec)
+ "Insert SPEC into the current file.
+Insert the source-code specified by SPEC into the current
+source code file. This function uses `comment-region' which
+assumes that the appropriate major-mode is set. SPEC has the
+form
+
+ (start-line file link source-name params body comment)"
+ (let* ((start-line (nth 0 spec))
+ (file (nth 1 spec))
+ (link (nth 2 spec))
+ (source-name (nth 3 spec))
+ (body (nth 5 spec))
+ (comment (nth 6 spec))
+ (comments (cdr (assoc :comments (nth 4 spec))))
+ (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
+ (link-p (or (string= comments "both") (string= comments "link")
+ (string= comments "yes") (string= comments "noweb")))
+ (link-data (mapcar (lambda (el)
+ (cons (symbol-name el)
+ ((lambda (le)
+ (if (stringp le) le (format "%S" le)))
+ (eval el))))
+ '(start-line file link source-name)))
+ (insert-comment (lambda (text)
+ (when (and comments (not (string= comments "no"))
+ (> (length text) 0))
+ (when padline (insert "\n"))
+ (comment-region (point) (progn (insert text) (point)))
+ (end-of-line nil) (insert "\n")))))
+ (when comment (funcall insert-comment comment))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-beg link-data)))
+ (when padline (insert "\n"))
+ (insert
+ (format
+ "%s\n"
+ (replace-regexp-in-string
+ "^," ""
+ (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+ (when link-p
+ (funcall
+ insert-comment
+ (org-fill-template org-babel-tangle-comment-format-end link-data)))))
+
+(defun org-babel-tangle-collect-blocks (&optional language)
+ "Collect source blocks in the current Org-mode file.
+Return an association list of source-code block specifications of
+the form used by `org-babel-spec-to-string' grouped by language.
+Optional argument LANG can be used to limit the collected source
+code blocks by language."
+ (let ((block-counter 1) (current-heading "") blocks)
+ (org-babel-map-src-blocks (buffer-file-name)
+ ((lambda (new-heading)
+ (if (not (string= new-heading current-heading))
+ (progn
+ (setq block-counter 1)
+ (setq current-heading new-heading))
+ (setq block-counter (+ 1 block-counter))))
+ (replace-regexp-in-string "[ \t]" "-"
+ (condition-case nil
+ (or (nth 4 (org-heading-components))
+ "(dummy for heading without text)")
+ (error (buffer-file-name)))))
+ (let* ((start-line (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info)))
+ (unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (unless (and language (not (string= language src-lang)))
+ (let* ((info (org-babel-get-src-block-info))
+ (params (nth 2 info))
+ (link ((lambda (link)
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link)))
+ (org-no-properties
+ (org-store-link nil))))
+ (source-name
+ (intern (or (nth 4 info)
+ (format "%s:%d"
+ current-heading block-counter))))
+ (expand-cmd
+ (intern (concat "org-babel-expand-body:" src-lang)))
+ (assignments-cmd
+ (intern (concat "org-babel-variable-assignments:" src-lang)))
+ (body
+ ((lambda (body) ;; run the tangle-body-hook
+ (with-temp-buffer
+ (insert body)
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string)))
+ ((lambda (body) ;; expand the body in language specific manner
+ (if (assoc :no-expand params)
+ body
+ (if (fboundp expand-cmd)
+ (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params
+ (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
+ (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))))
+ (comment
+ (when (or (string= "both" (cdr (assoc :comments params)))
+ (string= "org" (cdr (assoc :comments params))))
+ ;; from the previous heading or code-block end
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
+ by-lang)
+ ;; add the spec for this block to blocks under it's language
+ (setq by-lang (cdr (assoc src-lang blocks)))
+ (setq blocks (delq (assoc src-lang blocks) blocks))
+ (setq blocks (cons
+ (cons src-lang
+ (cons (list start-line file link
+ source-name params body comment)
+ by-lang)) blocks)))))))
+ ;; ensure blocks in the correct order
+ (setq blocks
+ (mapcar
+ (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
+ blocks))
+ blocks))
+
+(defun org-babel-tangle-comment-links ( &optional info)
+ "Return a list of begin and end link comments for the code block at point."
+ (let* ((start-line (org-babel-where-is-src-block-head))
+ (file (buffer-file-name))
+ (link (org-link-escape (progn (call-interactively 'org-store-link)
+ (org-no-properties
+ (car (pop org-stored-links))))))
+ (source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
+ (link-data (mapcar (lambda (el)
+ (cons (symbol-name el)
+ ((lambda (le)
+ (if (stringp le) le (format "%S" le)))
+ (eval el))))
+ '(start-line file link source-name))))
+ (list (org-fill-template org-babel-tangle-comment-format-beg link-data)
+ (org-fill-template org-babel-tangle-comment-format-end link-data))))
+
+;; de-tangling functions
+(defvar org-bracket-link-analytic-regexp)
+(defun org-babel-detangle (&optional source-code-file)
+ "Propagate changes in source file back original to Org-mode file.
+This requires that code blocks were tangled with link comments
+which enable the original code blocks to be found."
+ (interactive)
+ (save-excursion
+ (when source-code-file (find-file source-code-file))
+ (goto-char (point-min))
+ (let ((counter 0) new-body end)
+ (while (re-search-forward org-bracket-link-analytic-regexp nil t)
+ (when (re-search-forward
+ (concat " " (regexp-quote (match-string 5)) " ends here"))
+ (setq end (match-end 0))
+ (forward-line -1)
+ (save-excursion
+ (when (setq new-body (org-babel-tangle-jump-to-org))
+ (org-babel-update-block-body new-body)))
+ (setq counter (+ 1 counter)))
+ (goto-char end))
+ (prog1 counter (message "Detangled %d code blocks" counter)))))
+
+(defun org-babel-tangle-jump-to-org ()
+ "Jump from a tangled code file to the related Org-mode file."
+ (interactive)
+ (let ((mid (point))
+ start end done
+ target-buffer target-char link path block-name body)
+ (save-window-excursion
+ (save-excursion
+ (while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
+ (not ; ever wider searches until matching block comments
+ (and (setq start (point-at-eol))
+ (setq link (match-string 0))
+ (setq path (match-string 3))
+ (setq block-name (match-string 5))
+ (save-excursion
+ (save-match-data
+ (re-search-forward
+ (concat " " (regexp-quote block-name)
+ " ends here") nil t)
+ (setq end (point-at-bol))))))))
+ (unless (and start (< start mid) (< mid end))
+ (error "Not in tangled code"))
+ (setq body (org-babel-trim (buffer-substring start end))))
+ (when (string-match "::" path)
+ (setq path (substring path 0 (match-beginning 0))))
+ (find-file path) (setq target-buffer (current-buffer))
+ (goto-char start) (org-open-link-from-string link)
+ (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
+ (org-babel-next-src-block
+ (string-to-number (match-string 1 block-name)))
+ (org-babel-goto-named-src-block block-name))
+ (setq target-char (point)))
+ (pop-to-buffer target-buffer)
+ (prog1 body (goto-char target-char))))
+
+(provide 'ob-tangle)
+
+
+
+;;; ob-tangle.el ends here
diff --git a/lisp/ob.el b/lisp/ob.el
new file mode 100644
index 0000000..f15457d
--- /dev/null
+++ b/lisp/ob.el
@@ -0,0 +1,2604 @@
+;;; ob.el --- working with code blocks in org-mode
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'ob-eval)
+(require 'org-macs)
+(require 'org-compat)
+
+(defconst org-babel-exeext
+ (if (memq system-type '(windows-nt cygwin))
+ ".exe"
+ nil))
+(defvar org-babel-call-process-region-original)
+(defvar org-src-lang-modes)
+(defvar org-babel-library-of-babel)
+(declare-function show-all "outline" ())
+(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function tramp-compat-make-temp-file "tramp-compat"
+ (filename &optional dir-flag))
+(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
+(declare-function tramp-file-name-user "tramp" (vec))
+(declare-function tramp-file-name-host "tramp" (vec))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-edit-src-code "org-src"
+ (&optional context code edit-buffer-name quietp))
+(declare-function org-edit-src-exit "org-src" (&optional context))
+(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
+(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body))
+(declare-function org-outline-overlay-data "org" (&optional use-markers))
+(declare-function org-set-outline-overlay-data "org" (data))
+(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+(declare-function org-make-options-regexp "org" (kwds &optional extra))
+(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-show-context "org" (&optional key))
+(declare-function org-at-table-p "org" (&optional table-type))
+(declare-function org-cycle "org" (&optional arg))
+(declare-function org-uniquify "org" (list))
+(declare-function org-current-level "org" ())
+(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function org-table-import "org-table" (file arg))
+(declare-function org-add-hook "org-compat"
+ (hook function &optional append local))
+(declare-function org-table-align "org-table" ())
+(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function orgtbl-to-generic "org-table" (table params))
+(declare-function orgtbl-to-orgtbl "org-table" (table params))
+(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
+(declare-function org-babel-lob-get-info "ob-lob" nil)
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-babel-ref-parse "ob-ref" (assignment))
+(declare-function org-babel-ref-resolve "ob-ref" (ref))
+(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
+(declare-function org-babel-ref-headline-body "ob-ref" ())
+(declare-function org-babel-lob-execute-maybe "ob-lob" ())
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-at-item-p "org-list" ())
+(declare-function org-list-parse-list "org-list" (&optional delete))
+(declare-function org-list-to-generic "org-list" (LIST PARAMS))
+(declare-function org-list-struct "org-list" ())
+(declare-function org-list-prevs-alist "org-list" (struct))
+(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-add-protective-commas "org-src" (beg end))
+
+(defgroup org-babel nil
+ "Code block evaluation and management in `org-mode' documents."
+ :tag "Babel"
+ :group 'org)
+
+(defcustom org-confirm-babel-evaluate t
+ "Confirm before evaluation.
+Require confirmation before interactively evaluating code
+blocks in Org-mode buffers. The default value of this variable
+is t, meaning confirmation is required for any code block
+evaluation. This variable can be set to nil to inhibit any
+future confirmation requests. This variable can also be set to a
+function which takes two arguments the language of the code block
+and the body of the code block. Such a function should then
+return a non-nil value if the user should be prompted for
+execution or nil if no prompt is required.
+
+Warning: Disabling confirmation may result in accidental
+evaluation of potentially harmful code. It may be advisable
+remove code block execution from C-c C-c as further protection
+against accidental code block evaluation. The
+`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
+remove code block execution from the C-c C-c keybinding."
+ :group 'org-babel
+ :version "24.1"
+ :type '(choice boolean function))
+;; don't allow this variable to be changed through file settings
+(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
+
+(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
+ "Remove code block evaluation from the C-c C-c key binding."
+ :group 'org-babel
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-babel-results-keyword "RESULTS"
+ "Keyword used to name results generated by code blocks.
+Should be either RESULTS or NAME however any capitalization may
+be used."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-noweb-wrap-start "<<"
+ "String used to begin a noweb reference in a code block.
+See also `org-babel-noweb-wrap-end'."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-noweb-wrap-end ">>"
+ "String used to end a noweb reference in a code block.
+See also `org-babel-noweb-wrap-start'."
+ :group 'org-babel
+ :type 'string)
+
+(defun org-babel-noweb-wrap (&optional regexp)
+ (concat org-babel-noweb-wrap-start
+ (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
+ org-babel-noweb-wrap-end))
+
+(defvar org-babel-src-name-regexp
+ "^[ \t]*#\\+name:[ \t]*"
+ "Regular expression used to match a source name line.")
+
+(defvar org-babel-multi-line-header-regexp
+ "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
+ "Regular expression used to match multi-line header arguments.")
+
+(defvar org-babel-src-name-w-name-regexp
+ (concat org-babel-src-name-regexp
+ "\\("
+ org-babel-multi-line-header-regexp
+ "\\)*"
+ "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
+ "Regular expression matching source name lines with a name.")
+
+(defvar org-babel-src-block-regexp
+ (concat
+ ;; (1) indentation (2) lang
+ "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
+ ;; (3) switches
+ "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
+ ;; (4) header arguments
+ "\\([^\n]*\\)\n"
+ ;; (5) body
+ "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
+ "Regexp used to identify code blocks.")
+
+(defvar org-babel-inline-src-block-regexp
+ (concat
+ ;; (1) replacement target (2) lang
+ "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
+ ;; (3,4) (unused, headers)
+ "\\(\\|\\[\\(.*?\\)\\]\\)"
+ ;; (5) body
+ "{\\([^\f\n\r\v]+?\\)}\\)")
+ "Regexp used to identify inline src-blocks.")
+
+(defun org-babel-get-header (params key &optional others)
+ "Select only header argument of type KEY from a list.
+Optional argument OTHERS indicates that only the header that do
+not match KEY should be returned."
+ (delq nil
+ (mapcar
+ (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
+ params)))
+
+(defun org-babel-get-inline-src-block-matches()
+ "Set match data if within body of an inline source block.
+Returns non-nil if match-data set"
+ (let ((src-at-0-p (save-excursion
+ (beginning-of-line 1)
+ (string= "src" (thing-at-point 'word))))
+ (first-line-p (= 1 (line-number-at-pos)))
+ (orig (point)))
+ (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
+ (first-line-p "[[:punct:] \t]src_")
+ (t "[[:punct:] \f\t\n\r\v]src_")))
+ (lower-limit (if first-line-p
+ nil
+ (- (point-at-bol) 1))))
+ (save-excursion
+ (when (or (and src-at-0-p (bobp))
+ (and (re-search-forward "}" (point-at-eol) t)
+ (re-search-backward search-for lower-limit t)
+ (> orig (point))))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ t ))))))
+
+(defvar org-babel-inline-lob-one-liner-regexp)
+(defun org-babel-get-lob-one-liner-matches()
+ "Set match data if on line of an lob one liner.
+Returns non-nil if match-data set"
+ (save-excursion
+ (unless (= (point) (point-at-bol)) ;; move before inline block
+ (re-search-backward "[ \f\t\n\r\v]" nil t))
+ (if (looking-at org-babel-inline-lob-one-liner-regexp)
+ t
+ nil)))
+
+(defun org-babel-get-src-block-info (&optional light)
+ "Get information on the current source block.
+
+Optional argument LIGHT does not resolve remote variable
+references; a process which could likely result in the execution
+of other code blocks.
+
+Returns a list
+ (language body header-arguments-alist switches name indent)."
+ (let ((case-fold-search t) head info name indent)
+ ;; full code block
+ (if (setq head (org-babel-where-is-src-block-head))
+ (save-excursion
+ (goto-char head)
+ (setq info (org-babel-parse-src-block-match))
+ (setq indent (car (last info)))
+ (setq info (butlast info))
+ (while (and (forward-line -1)
+ (looking-at org-babel-multi-line-header-regexp))
+ (setf (nth 2 info)
+ (org-babel-merge-params
+ (nth 2 info)
+ (org-babel-parse-header-arguments (match-string 1)))))
+ (when (looking-at org-babel-src-name-w-name-regexp)
+ (setq name (org-no-properties (match-string 3)))
+ (when (and (match-string 5) (> (length (match-string 5)) 0))
+ (setf (nth 2 info) ;; merge functional-syntax vars and header-args
+ (org-babel-merge-params
+ (mapcar
+ (lambda (ref) (cons :var ref))
+ (mapcar
+ (lambda (var) ;; check that each variable is initialized
+ (if (string-match ".+=.+" var)
+ var
+ (error
+ "variable \"%s\"%s must be assigned a default value"
+ var (if name (format " in block \"%s\"" name) ""))))
+ (org-babel-ref-split-args (match-string 5))))
+ (nth 2 info))))))
+ ;; inline source block
+ (when (org-babel-get-inline-src-block-matches)
+ (setq info (org-babel-parse-inline-src-block-match))))
+ ;; resolve variable references and add summary parameters
+ (when (and info (not light))
+ (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
+ (when info (append info (list name indent)))))
+
+(defvar org-current-export-file) ; dynamically bound
+(defun org-babel-confirm-evaluate (info)
+ "Confirm evaluation of the code block INFO.
+This behavior can be suppressed by setting the value of
+`org-confirm-babel-evaluate' to nil, in which case all future
+interactive code block evaluations will proceed without any
+confirmation from the user.
+
+Note disabling confirmation may result in accidental evaluation
+of potentially harmful code."
+ (let* ((eval (or (cdr (assoc :eval (nth 2 info)))
+ (when (assoc :noeval (nth 2 info)) "no")))
+ (query (cond ((equal eval "query") t)
+ ((and (boundp 'org-current-export-file)
+ org-current-export-file
+ (equal eval "query-export")) t)
+ ((functionp org-confirm-babel-evaluate)
+ (funcall org-confirm-babel-evaluate
+ (nth 0 info) (nth 1 info)))
+ (t org-confirm-babel-evaluate))))
+ (if (or (equal eval "never") (equal eval "no")
+ (and (boundp 'org-current-export-file)
+ org-current-export-file
+ (or (equal eval "no-export")
+ (equal eval "never-export")))
+ (and query
+ (not (yes-or-no-p
+ (format "Evaluate this%scode block%son your system? "
+ (if info (format " %s " (nth 0 info)) " ")
+ (if (nth 4 info)
+ (format " (%s) " (nth 4 info)) " "))))))
+ (prog1 nil (message "Evaluation %s"
+ (if (or (equal eval "never") (equal eval "no")
+ (equal eval "no-export")
+ (equal eval "never-export"))
+ "Disabled" "Aborted")))
+ t)))
+
+;;;###autoload
+(defun org-babel-execute-safely-maybe ()
+ (unless org-babel-no-eval-on-ctrl-c-ctrl-c
+ (org-babel-execute-maybe)))
+
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
+
+;;;###autoload
+(defun org-babel-execute-maybe ()
+ (interactive)
+ (or (org-babel-execute-src-block-maybe)
+ (org-babel-lob-execute-maybe)))
+
+(defun org-babel-execute-src-block-maybe ()
+ "Conditionally execute a source block.
+Detect if this is context for a Babel src-block and if so
+then run `org-babel-execute-src-block'."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info)))
+ (if info
+ (progn (org-babel-eval-wipe-error-buffer)
+ (org-babel-execute-src-block current-prefix-arg info) t) nil)))
+
+;;;###autoload
+(defun org-babel-view-src-block-info ()
+ "Display information on the current source block.
+This includes header arguments, language and name, and is largely
+a window into the `org-babel-get-src-block-info' function."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info 'light))
+ (full (lambda (it) (> (length it) 0)))
+ (printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
+ (when info
+ (with-help-window (help-buffer)
+ (let ((name (nth 4 info))
+ (lang (nth 0 info))
+ (switches (nth 3 info))
+ (header-args (nth 2 info)))
+ (when name (funcall printf "Name: %s\n" name))
+ (when lang (funcall printf "Lang: %s\n" lang))
+ (when (funcall full switches) (funcall printf "Switches: %s\n" switches))
+ (funcall printf "Header Arguments:\n")
+ (dolist (pair (sort header-args
+ (lambda (a b) (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+ (when (funcall full (cdr pair))
+ (funcall printf "\t%S%s\t%s\n"
+ (car pair)
+ (if (> (length (format "%S" (car pair))) 7) "" "\t")
+ (cdr pair)))))))))
+
+;;;###autoload
+(defun org-babel-expand-src-block-maybe ()
+ "Conditionally expand a source block.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-expand-src-block'."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info)))
+ (if info
+ (progn (org-babel-expand-src-block current-prefix-arg info) t)
+ nil)))
+
+;;;###autoload
+(defun org-babel-load-in-session-maybe ()
+ "Conditionally load a source block in a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-load-in-session'."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info)))
+ (if info
+ (progn (org-babel-load-in-session current-prefix-arg info) t)
+ nil)))
+
+(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
+
+;;;###autoload
+(defun org-babel-pop-to-session-maybe ()
+ "Conditionally pop to a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-pop-to-session'."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info)))
+ (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
+
+(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
+
+(defconst org-babel-common-header-args-w-values
+ '((cache . ((no yes)))
+ (cmdline . :any)
+ (colnames . ((nil no yes)))
+ (comments . ((no link yes org both noweb)))
+ (dir . :any)
+ (eval . ((never query)))
+ (exports . ((code results both none)))
+ (file . :any)
+ (file-desc . :any)
+ (hlines . ((no yes)))
+ (mkdirp . ((yes no)))
+ (no-expand)
+ (noeval)
+ (noweb . ((yes no tangle no-export strip-export)))
+ (noweb-ref . :any)
+ (noweb-sep . :any)
+ (padline . ((yes no)))
+ (results . ((file list vector table scalar verbatim)
+ (raw html latex org code pp drawer)
+ (replace silent append prepend)
+ (output value)))
+ (rownames . ((no yes)))
+ (sep . :any)
+ (session . :any)
+ (shebang . :any)
+ (tangle . ((tangle yes no :any)))
+ (var . :any)
+ (wrap . :any)))
+
+(defconst org-babel-header-arg-names
+ (mapcar #'car org-babel-common-header-args-w-values)
+ "Common header arguments used by org-babel.
+Note that individual languages may define their own language
+specific header arguments as well.")
+
+(defvar org-babel-default-header-args
+ '((:session . "none") (:results . "replace") (:exports . "code")
+ (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")
+ (:padnewline . "yes"))
+ "Default arguments to use when evaluating a source block.")
+
+(defvar org-babel-default-inline-header-args
+ '((:session . "none") (:results . "replace") (:exports . "results"))
+ "Default arguments to use when evaluating an inline source block.")
+
+(defvar org-babel-data-names '("tblname" "results" "name"))
+
+(defvar org-babel-result-regexp
+ (concat "^[ \t]*#\\+"
+ (regexp-opt org-babel-data-names t)
+ "\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
+ "Regular expression used to match result lines.
+If the results are associated with a hash key then the hash will
+be saved in the second match data.")
+
+(defvar org-babel-result-w-name-regexp
+ (concat org-babel-result-regexp
+ "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
+
+(defvar org-babel-min-lines-for-block-output 10
+ "The minimum number of lines for block output.
+If number of lines of output is equal to or exceeds this
+value, the output is placed in a #+begin_example...#+end_example
+block. Otherwise the output is marked as literal by inserting
+colons at the starts of the lines. This variable only takes
+effect if the :results output option is in effect.")
+
+(defvar org-babel-noweb-error-langs nil
+ "Languages for which Babel will raise literate programming errors.
+List of languages for which errors should be raised when the
+source code block satisfying a noweb reference in this language
+can not be resolved.")
+
+(defvar org-babel-hash-show 4
+ "Number of initial characters to show of a hidden results hash.")
+
+(defvar org-babel-after-execute-hook nil
+ "Hook for functions to be called after `org-babel-execute-src-block'")
+
+(defun org-babel-named-src-block-regexp-for-name (name)
+ "This generates a regexp used to match a src block named NAME."
+ (concat org-babel-src-name-regexp (regexp-quote name)
+ "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
+ (substring org-babel-src-block-regexp 1)))
+
+(defun org-babel-named-data-regexp-for-name (name)
+ "This generates a regexp used to match data named NAME."
+ (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
+
+;;; functions
+(defvar call-process-region)
+;;;###autoload
+
+(defun org-babel-execute-src-block (&optional arg info params)
+ "Execute the current source code block.
+Insert the results of execution into the buffer. Source code
+execution and the collection and formatting of results can be
+controlled through a variety of header arguments.
+
+With prefix argument ARG, force re-execution even if an existing
+result cached in the buffer would otherwise have been returned.
+
+Optionally supply a value for INFO in the form returned by
+`org-babel-get-src-block-info'.
+
+Optionally supply a value for PARAMS which will be merged with
+the header arguments specified at the front of the source code
+block."
+ (interactive)
+ (let ((info (or info (org-babel-get-src-block-info))))
+ (when (org-babel-confirm-evaluate
+ (let ((i info))
+ (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params))
+ i))
+ (let* ((lang (nth 0 info))
+ (params (if params
+ (org-babel-process-params
+ (org-babel-merge-params (nth 2 info) params))
+ (nth 2 info)))
+ (cache? (and (not arg) (cdr (assoc :cache params))
+ (string= "yes" (cdr (assoc :cache params)))))
+ (result-params (cdr (assoc :result-params params)))
+ (new-hash (when cache? (org-babel-sha1-hash info)))
+ (old-hash (when cache? (org-babel-current-result-hash)))
+ (body (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory (expand-file-name dir)))
+ default-directory))
+ (org-babel-call-process-region-original
+ (if (boundp 'org-babel-call-process-region-original)
+ org-babel-call-process-region-original
+ (symbol-function 'call-process-region)))
+ (indent (car (last info)))
+ result cmd)
+ (unwind-protect
+ (let ((call-process-region
+ (lambda (&rest args)
+ (apply 'org-babel-tramp-handle-call-process-region args))))
+ (let ((lang-check (lambda (f)
+ (let ((f (intern (concat "org-babel-execute:" f))))
+ (when (fboundp f) f)))))
+ (setq cmd
+ (or (funcall lang-check lang)
+ (funcall lang-check (symbol-name
+ (cdr (assoc lang org-src-lang-modes))))
+ (error "No org-babel-execute function for %s!" lang))))
+ (if (and (not arg) new-hash (equal new-hash old-hash))
+ (save-excursion ;; return cached result
+ (goto-char (org-babel-where-is-src-block-result nil info))
+ (end-of-line 1) (forward-char 1)
+ (setq result (org-babel-read-result))
+ (message (replace-regexp-in-string
+ "%" "%%" (format "%S" result))) result)
+ (message "executing %s code block%s..."
+ (capitalize lang)
+ (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
+ (setq result
+ ((lambda (result)
+ (if (and (eq (cdr (assoc :result-type params)) 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp result)))
+ (list (list result)) result))
+ (funcall cmd body params)))
+ ;; if non-empty result and :file then write to :file
+ (when (cdr (assoc :file params))
+ (when result
+ (with-temp-file (cdr (assoc :file params))
+ (insert
+ (org-babel-format-result
+ result (cdr (assoc :sep (nth 2 info)))))))
+ (setq result (cdr (assoc :file params))))
+ (org-babel-insert-result
+ result result-params info new-hash indent lang)
+ (run-hooks 'org-babel-after-execute-hook)
+ result))
+ (setq call-process-region 'org-babel-call-process-region-original))))))
+
+(defun org-babel-expand-body:generic (body params &optional var-lines)
+ "Expand BODY with PARAMS.
+Expand a block of code with org-babel according to its header
+arguments. This generic implementation of body expansion is
+called for languages which have not defined their own specific
+org-babel-expand-body:lang function."
+ (mapconcat #'identity (append var-lines (list body)) "\n"))
+
+;;;###autoload
+(defun org-babel-expand-src-block (&optional arg info params)
+ "Expand the current source code block.
+Expand according to the source code block's header
+arguments and pop open the results in a preview buffer."
+ (interactive)
+ (let* ((info (or info (org-babel-get-src-block-info)))
+ (lang (nth 0 info))
+ (params (setf (nth 2 info)
+ (sort (org-babel-merge-params (nth 2 info) params)
+ (lambda (el1 el2) (string< (symbol-name (car el1))
+ (symbol-name (car el2)))))))
+ (body (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info) (nth 1 info))))
+ (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
+ (assignments-cmd (intern (concat "org-babel-variable-assignments:"
+ lang)))
+ (expanded
+ (if (fboundp expand-cmd) (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
+ (org-edit-src-code
+ nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))))
+
+(defun org-babel-edit-distance (s1 s2)
+ "Return the edit (levenshtein) distance between strings S1 S2."
+ (let* ((l1 (length s1))
+ (l2 (length s2))
+ (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
+ (number-sequence 1 (1+ l1)))))
+ (in (lambda (i j) (aref (aref dist i) j)))
+ (mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
+ (setf (aref (aref dist 0) 0) 0)
+ (dolist (i (number-sequence 1 l1))
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist i) j)
+ (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
+ (funcall mmin (funcall in (1- i) j)
+ (funcall in i (1- j))
+ (funcall in (1- i) (1- j)))))))
+ (funcall in l1 l2)))
+
+(defun org-babel-combine-header-arg-lists (original &rest others)
+ "Combine a number of lists of header argument names and arguments."
+ (let ((results (copy-sequence original)))
+ (dolist (new-list others)
+ (dolist (arg-pair new-list)
+ (let ((header (car arg-pair))
+ (args (cdr arg-pair)))
+ (setq results
+ (cons arg-pair (org-remove-if
+ (lambda (pair) (equal header (car pair)))
+ results))))))
+ results))
+
+;;;###autoload
+(defun org-babel-check-src-block ()
+ "Check for misspelled header arguments in the current code block."
+ (interactive)
+ ;; TODO: report malformed code block
+ ;; TODO: report incompatible combinations of header arguments
+ ;; TODO: report uninitialized variables
+ (let ((too-close 2) ;; <- control closeness to report potential match
+ (names (mapcar #'symbol-name org-babel-header-arg-names)))
+ (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
+ (and (org-babel-where-is-src-block-head)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (match-string 4))))))
+ (dolist (name names)
+ (when (and (not (string= header name))
+ (<= (org-babel-edit-distance header name) too-close)
+ (not (member header names)))
+ (error "Supplied header \"%S\" is suspiciously close to \"%S\""
+ header name))))
+ (message "No suspicious header arguments found.")))
+
+;;;###autoload
+(defun org-babel-insert-header-arg ()
+ "Insert a header argument selecting from lists of common args and values."
+ (interactive)
+ (let* ((lang (car (org-babel-get-src-block-info 'light)))
+ (lang-headers (intern (concat "org-babel-header-args:" lang)))
+ (headers (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (if (boundp lang-headers) (eval lang-headers) nil)))
+ (arg (org-icompleting-read
+ "Header Arg: "
+ (mapcar
+ (lambda (header-spec) (symbol-name (car header-spec)))
+ headers))))
+ (insert ":" arg)
+ (let ((vals (cdr (assoc (intern arg) headers))))
+ (when vals
+ (insert
+ " "
+ (cond
+ ((eq vals :any)
+ (read-from-minibuffer "value: "))
+ ((listp vals)
+ (mapconcat
+ (lambda (group)
+ (let ((arg (org-icompleting-read
+ "value: "
+ (cons "default" (mapcar #'symbol-name group)))))
+ (if (and arg (not (string= "default" arg)))
+ (concat arg " ")
+ "")))
+ vals ""))))))))
+
+;; Add support for completing-read insertion of header arguments after ":"
+(defun org-babel-header-arg-expand ()
+ "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts."
+ (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head))
+ (org-babel-enter-header-arg-w-completion (match-string 2))))
+
+(defun org-babel-enter-header-arg-w-completion (&optional lang)
+ "Insert header argument appropriate for LANG with completion."
+ (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
+ (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
+ (headers-w-values (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values lang-headers))
+ (headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
+ (header (org-completing-read "Header Arg: " headers))
+ (args (cdr (assoc (intern header) headers-w-values)))
+ (arg (when (and args (listp args))
+ (org-completing-read
+ (format "%s: " header)
+ (mapcar #'symbol-name (apply #'append args))))))
+ (insert (concat header " " (or arg "")))
+ (cons header arg)))
+
+(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+
+;;;###autoload
+(defun org-babel-load-in-session (&optional arg info)
+ "Load the body of the current source-code block.
+Evaluate the header arguments for the source block before
+entering the session. After loading the body this pops open the
+session."
+ (interactive)
+ (let* ((info (or info (org-babel-get-src-block-info)))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (body (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (session (cdr (assoc :session params)))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory dir)) default-directory))
+ (cmd (intern (concat "org-babel-load-session:" lang))))
+ (unless (fboundp cmd)
+ (error "No org-babel-load-session function for %s!" lang))
+ (pop-to-buffer (funcall cmd session body params))
+ (end-of-line 1)))
+
+;;;###autoload
+(defun org-babel-initiate-session (&optional arg info)
+ "Initiate session for current code block.
+If called with a prefix argument then resolve any variable
+references in the header arguments and assign these variables in
+the session. Copy the body of the code block to the kill ring."
+ (interactive "P")
+ (let* ((info (or info (org-babel-get-src-block-info (not arg))))
+ (lang (nth 0 info))
+ (body (nth 1 info))
+ (params (nth 2 info))
+ (session (cdr (assoc :session params)))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory dir)) default-directory))
+ (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
+ (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
+ (if (and (stringp session) (string= session "none"))
+ (error "This block is not using a session!"))
+ (unless (fboundp init-cmd)
+ (error "No org-babel-initiate-session function for %s!" lang))
+ (with-temp-buffer (insert (org-babel-trim body))
+ (copy-region-as-kill (point-min) (point-max)))
+ (when arg
+ (unless (fboundp prep-cmd)
+ (error "No org-babel-prep-session function for %s!" lang))
+ (funcall prep-cmd session params))
+ (funcall init-cmd session params)))
+
+;;;###autoload
+(defun org-babel-switch-to-session (&optional arg info)
+ "Switch to the session of the current code block.
+Uses `org-babel-initiate-session' to start the session. If called
+with a prefix argument then this is passed on to
+`org-babel-initiate-session'."
+ (interactive "P")
+ (pop-to-buffer (org-babel-initiate-session arg info))
+ (end-of-line 1))
+
+(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
+
+;;;###autoload
+(defun org-babel-switch-to-session-with-code (&optional arg info)
+ "Switch to code buffer and display session."
+ (interactive "P")
+ (let ((swap-windows
+ (lambda ()
+ (let ((other-window-buffer (window-buffer (next-window))))
+ (set-window-buffer (next-window) (current-buffer))
+ (set-window-buffer (selected-window) other-window-buffer))
+ (other-window 1)))
+ (info (org-babel-get-src-block-info))
+ (org-src-window-setup 'reorganize-frame))
+ (save-excursion
+ (org-babel-switch-to-session arg info))
+ (org-edit-src-code)
+ (funcall swap-windows)))
+
+(defmacro org-babel-do-in-edit-buffer (&rest body)
+ "Evaluate BODY in edit buffer if there is a code block at point.
+Return t if a code block was found at point, nil otherwise."
+ `(let ((org-src-window-setup 'switch-invisibly))
+ (when (and (org-babel-where-is-src-block-head)
+ (org-edit-src-code nil nil nil))
+ (unwind-protect (progn ,@body)
+ (if (org-bound-and-true-p org-edit-src-from-org-mode)
+ (org-edit-src-exit)))
+ t)))
+(def-edebug-spec org-babel-do-in-edit-buffer (body))
+
+(defun org-babel-do-key-sequence-in-edit-buffer (key)
+ "Read key sequence and execute the command in edit buffer.
+Enter a key sequence to be executed in the language major-mode
+edit buffer. For example, TAB will alter the contents of the
+Org-mode code block according to the effect of TAB in the
+language major-mode buffer. For languages that support
+interactive sessions, this can be used to send code from the Org
+buffer to the session for evaluation using the native major-mode
+evaluation mechanisms."
+ (interactive "kEnter key-sequence to execute in edit buffer: ")
+ (org-babel-do-in-edit-buffer
+ (call-interactively
+ (key-binding (or key (read-key-sequence nil))))))
+
+(defvar org-bracket-link-regexp)
+;;;###autoload
+(defun org-babel-open-src-block-result (&optional re-run)
+ "If `point' is on a src block then open the results of the
+source code block, otherwise return nil. With optional prefix
+argument RE-RUN the source-code block is evaluated even if
+results already exist."
+ (interactive "P")
+ (let ((info (org-babel-get-src-block-info)))
+ (when info
+ (save-excursion
+ ;; go to the results, if there aren't any then run the block
+ (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
+ (progn (org-babel-execute-src-block)
+ (org-babel-where-is-src-block-result))))
+ (end-of-line 1)
+ (while (looking-at "[\n\r\t\f ]") (forward-char 1))
+ ;; open the results
+ (if (looking-at org-bracket-link-regexp)
+ ;; file results
+ (org-open-at-point)
+ (let ((r (org-babel-format-result
+ (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
+ (pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
+ (delete-region (point-min) (point-max))
+ (insert r)))
+ t))))
+
+;;;###autoload
+(defmacro org-babel-map-src-blocks (file &rest body)
+ "Evaluate BODY forms on each source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer. During evaluation of BODY the following local variables
+are set relative to the currently matched code block.
+
+full-block ------- string holding the entirety of the code block
+beg-block -------- point at the beginning of the code block
+end-block -------- point at the end of the matched code block
+lang ------------- string holding the language of the code block
+beg-lang --------- point at the beginning of the lang
+end-lang --------- point at the end of the lang
+switches --------- string holding the switches
+beg-switches ----- point at the beginning of the switches
+end-switches ----- point at the end of the switches
+header-args ------ string holding the header-args
+beg-header-args -- point at the beginning of the header-args
+end-header-args -- point at the end of the header-args
+body ------------- string holding the body of the code block
+beg-body --------- point at the beginning of the body
+end-body --------- point at the end of the body"
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-src-block-regexp nil t)
+ (goto-char (match-beginning 0))
+ (let ((full-block (match-string 0))
+ (beg-block (match-beginning 0))
+ (end-block (match-end 0))
+ (lang (match-string 2))
+ (beg-lang (match-beginning 2))
+ (end-lang (match-end 2))
+ (switches (match-string 3))
+ (beg-switches (match-beginning 3))
+ (end-switches (match-end 3))
+ (header-args (match-string 4))
+ (beg-header-args (match-beginning 4))
+ (end-header-args (match-end 4))
+ (body (match-string 5))
+ (beg-body (match-beginning 5))
+ (end-body (match-end 5)))
+ ,@body
+ (goto-char end-block))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-src-blocks (form body))
+
+;;;###autoload
+(defmacro org-babel-map-inline-src-blocks (file &rest body)
+ "Evaluate BODY forms on each inline source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-inline-src-block-regexp nil t)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-inline-src-blocks (form body))
+
+(defvar org-babel-lob-one-liner-regexp)
+;;;###autoload
+(defmacro org-babel-map-call-lines (file &rest body)
+ "Evaluate BODY forms on each call line in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-call-lines (form body))
+
+;;;###autoload
+(defmacro org-babel-map-executables (file &rest body)
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file"))
+ (rx (make-symbol "rx")))
+ `(let* ((,tempvar ,file)
+ (,rx (concat "\\(" org-babel-src-block-regexp
+ "\\|" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)"))
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward ,rx nil t)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
+ (save-match-data ,@body)
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-executables (form body))
+
+;;;###autoload
+(defun org-babel-execute-buffer (&optional arg)
+ "Execute source code blocks in a buffer.
+Call `org-babel-execute-src-block' on every source block in
+the current buffer."
+ (interactive "P")
+ (org-babel-eval-wipe-error-buffer)
+ (org-save-outline-visibility t
+ (org-babel-map-executables nil
+ (if (looking-at org-babel-lob-one-liner-regexp)
+ (org-babel-lob-execute-maybe)
+ (org-babel-execute-src-block arg)))))
+
+;;;###autoload
+(defun org-babel-execute-subtree (&optional arg)
+ "Execute source code blocks in a subtree.
+Call `org-babel-execute-src-block' on every source block in
+the current subtree."
+ (interactive "P")
+ (save-restriction
+ (save-excursion
+ (org-narrow-to-subtree)
+ (org-babel-execute-buffer arg)
+ (widen))))
+
+;;;###autoload
+(defun org-babel-sha1-hash (&optional info)
+ "Generate an sha1 hash based on the value of info."
+ (interactive)
+ (let ((print-level nil)
+ (info (or info (org-babel-get-src-block-info))))
+ (setf (nth 2 info)
+ (sort (copy-sequence (nth 2 info))
+ (lambda (a b) (string< (car a) (car b)))))
+ (let* ((rm (lambda (lst)
+ (dolist (p '("replace" "silent" "append" "prepend"))
+ (setq lst (remove p lst)))
+ lst))
+ (norm (lambda (arg)
+ (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
+ (copy-sequence (cdr arg))
+ (cdr arg))))
+ (when (and v (not (and (sequencep v)
+ (not (consp v))
+ (= (length v) 0))))
+ (cond
+ ((and (listp v) ; lists are sorted
+ (member (car arg) '(:result-params)))
+ (sort (funcall rm v) #'string<))
+ ((and (stringp v) ; strings are sorted
+ (member (car arg) '(:results :exports)))
+ (mapconcat #'identity (sort (funcall rm (split-string v))
+ #'string<) " "))
+ (t v)))))))
+ ((lambda (hash)
+ (when (org-called-interactively-p 'interactive) (message hash)) hash)
+ (let ((it (format "%s-%s"
+ (mapconcat
+ #'identity
+ (delq nil (mapcar (lambda (arg)
+ (let ((normalized (funcall norm arg)))
+ (when normalized
+ (format "%S" normalized))))
+ (nth 2 info))) ":")
+ (nth 1 info))))
+ (sha1 it))))))
+
+(defun org-babel-current-result-hash ()
+ "Return the current in-buffer hash."
+ (org-babel-where-is-src-block-result)
+ (org-no-properties (match-string 3)))
+
+(defun org-babel-set-current-result-hash (hash)
+ "Set the current in-buffer hash to HASH."
+ (org-babel-where-is-src-block-result)
+ (save-excursion (goto-char (match-beginning 3))
+ ;; (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 3)
+ (org-babel-hide-hash)))
+
+(defun org-babel-hide-hash ()
+ "Hide the hash in the current results line.
+Only the initial `org-babel-hash-show' characters of the hash
+will remain visible."
+ (add-to-invisibility-spec '(org-babel-hide-hash . t))
+ (save-excursion
+ (when (and (re-search-forward org-babel-result-regexp nil t)
+ (match-string 3))
+ (let* ((start (match-beginning 3))
+ (hide-start (+ org-babel-hash-show start))
+ (end (match-end 3))
+ (hash (match-string 3))
+ ov1 ov2)
+ (setq ov1 (make-overlay start hide-start))
+ (setq ov2 (make-overlay hide-start end))
+ (overlay-put ov2 'invisible 'org-babel-hide-hash)
+ (overlay-put ov1 'babel-hash hash)))))
+
+(defun org-babel-hide-all-hashes ()
+ "Hide the hash in the current buffer.
+Only the initial `org-babel-hash-show' characters of each hash
+will remain visible. This function should be called as part of
+the `org-mode-hook'."
+ (save-excursion
+ (while (re-search-forward org-babel-result-regexp nil t)
+ (goto-char (match-beginning 0))
+ (org-babel-hide-hash)
+ (goto-char (match-end 0)))))
+(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
+
+(defun org-babel-hash-at-point (&optional point)
+ "Return the value of the hash at POINT.
+The hash is also added as the last element of the kill ring.
+This can be called with C-c C-c."
+ (interactive)
+ (let ((hash (car (delq nil (mapcar
+ (lambda (ol) (overlay-get ol 'babel-hash))
+ (overlays-at (or point (point))))))))
+ (when hash (kill-new hash) (message hash))))
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
+
+(defun org-babel-result-hide-spec ()
+ "Hide portions of results lines.
+Add `org-babel-hide-result' as an invisibility spec for hiding
+portions of results lines."
+ (add-to-invisibility-spec '(org-babel-hide-result . t)))
+(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
+
+(defvar org-babel-hide-result-overlays nil
+ "Overlays hiding results.")
+
+(defun org-babel-result-hide-all ()
+ "Fold all results in the current buffer."
+ (interactive)
+ (org-babel-show-result-all)
+ (save-excursion
+ (while (re-search-forward org-babel-result-regexp nil t)
+ (save-excursion (goto-char (match-beginning 0))
+ (org-babel-hide-result-toggle-maybe)))))
+
+(defun org-babel-show-result-all ()
+ "Unfold all results in the current buffer."
+ (mapc 'delete-overlay org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays nil))
+
+;;;###autoload
+(defun org-babel-hide-result-toggle-maybe ()
+ "Toggle visibility of result at point."
+ (interactive)
+ (let ((case-fold-search t))
+ (if (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-babel-result-regexp))
+ (progn (org-babel-hide-result-toggle)
+ t) ;; to signal that we took action
+ nil))) ;; to signal that we did not
+
+(defun org-babel-hide-result-toggle (&optional force)
+ "Toggle the visibility of the current result."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward org-babel-result-regexp nil t)
+ (let ((start (progn (beginning-of-line 2) (- (point) 1)))
+ (end (progn
+ (while (looking-at org-babel-multi-line-header-regexp)
+ (forward-line 1))
+ (goto-char (- (org-babel-result-end) 1)) (point)))
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-babel-hide-result))
+ (overlays-at start)))
+ (if (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov)))
+ (overlays-at start)))
+ (setq ov (make-overlay start end))
+ (overlay-put ov 'invisible 'org-babel-hide-result)
+ ;; make the block accessible to isearch
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov))))
+ (push ov org-babel-hide-result-overlays)))
+ (error "Not looking at a result line"))))
+
+;; org-tab-after-check-for-cycling-hook
+(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
+;; Remove overlays when changing major mode
+(add-hook 'org-mode-hook
+ (lambda () (org-add-hook 'change-major-mode-hook
+ 'org-babel-show-result-all 'append 'local)))
+
+(defvar org-file-properties)
+(defun org-babel-params-from-properties (&optional lang)
+ "Retrieve parameters specified as properties.
+Return an association list of any source block params which
+may be specified in the properties of the current outline entry."
+ (save-match-data
+ (let (val sym)
+ (org-babel-parse-multiple-vars
+ (delq nil
+ (mapcar
+ (lambda (header-arg)
+ (and (setq val (org-entry-get (point) header-arg t))
+ (cons (intern (concat ":" header-arg))
+ (org-babel-read val))))
+ (mapcar
+ #'symbol-name
+ (mapcar
+ #'car
+ (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (progn
+ (setq sym (intern (concat "org-babel-header-args:" lang)))
+ (and (boundp sym) (eval sym))))))))))))
+
+(defvar org-src-preserve-indentation)
+(defun org-babel-parse-src-block-match ()
+ "Parse the results from a match of the `org-babel-src-block-regexp'."
+ (let* ((block-indentation (length (match-string 1)))
+ (lang (org-no-properties (match-string 2)))
+ (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
+ (switches (match-string 3))
+ (body (org-no-properties
+ (let* ((body (match-string 5))
+ (sub-length (- (length body) 1)))
+ (if (and (> sub-length 0)
+ (string= "\n" (substring body sub-length)))
+ (substring body 0 sub-length)
+ (or body "")))))
+ (preserve-indentation (or org-src-preserve-indentation
+ (save-match-data
+ (string-match "-i\\>" switches)))))
+ (list lang
+ ;; get block body less properties, protective commas, and indentation
+ (with-temp-buffer
+ (save-match-data
+ (insert (org-babel-strip-protective-commas body lang))
+ (unless preserve-indentation (org-do-remove-indentation))
+ (buffer-string)))
+ (org-babel-merge-params
+ org-babel-default-header-args
+ (org-babel-params-from-properties lang)
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) ""))))
+ switches
+ block-indentation)))
+
+(defun org-babel-parse-inline-src-block-match ()
+ "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
+ (let* ((lang (org-no-properties (match-string 2)))
+ (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
+ (list lang
+ (org-babel-strip-protective-commas
+ (org-no-properties (match-string 5)) lang)
+ (org-babel-merge-params
+ org-babel-default-inline-header-args
+ (org-babel-params-from-properties lang)
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) "")))))))
+
+(defun org-babel-balanced-split (string alts)
+ "Split STRING on instances of ALTS.
+ALTS is a cons of two character options where each option may be
+either the numeric code of a single character or a list of
+character alternatives. For example to split on balanced
+instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
+ (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
+ (matched (lambda (ch last)
+ (if (consp alts)
+ (and (funcall matches ch (cdr alts))
+ (funcall matches last (car alts)))
+ (funcall matches ch alts))))
+ (balance 0) (last 0)
+ quote partial lst)
+ (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
+ (setq balance (+ balance
+ (cond ((or (equal 91 ch) (equal 40 ch)) 1)
+ ((or (equal 93 ch) (equal 41 ch)) -1)
+ (t 0))))
+ (when (and (equal 34 ch) (not (equal 92 last)))
+ (setq quote (not quote)))
+ (setq partial (cons ch partial))
+ (when (and (= balance 0) (not quote) (funcall matched ch last))
+ (setq lst (cons (apply #'string (nreverse
+ (if (consp alts)
+ (cddr partial)
+ (cdr partial))))
+ lst))
+ (setq partial nil))
+ (setq last ch))
+ (string-to-list string))
+ (nreverse (cons (apply #'string (nreverse partial)) lst))))
+
+(defun org-babel-join-splits-near-ch (ch list)
+ "Join splits where \"=\" is on either end of the split."
+ (let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
+ (first= (lambda (str) (= ch (aref str 0)))))
+ (reverse
+ (org-reduce (lambda (acc el)
+ (let ((head (car acc)))
+ (if (and head (or (funcall last= head) (funcall first= el)))
+ (cons (concat head el) (cdr acc))
+ (cons el acc))))
+ list :initial-value nil))))
+
+(defun org-babel-parse-header-arguments (arg-string)
+ "Parse a string of header arguments returning an alist."
+ (when (> (length arg-string) 0)
+ (org-babel-parse-multiple-vars
+ (delq nil
+ (mapcar
+ (lambda (arg)
+ (if (string-match
+ "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
+ arg)
+ (cons (intern (match-string 1 arg))
+ (org-babel-read (org-babel-chomp (match-string 2 arg))))
+ (cons (intern (org-babel-chomp arg)) nil)))
+ ((lambda (raw)
+ (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
+ (org-babel-balanced-split arg-string '((32 9) . 58))))))))
+
+(defun org-babel-parse-multiple-vars (header-arguments)
+ "Expand multiple variable assignments behind a single :var keyword.
+
+This allows expression of multiple variables with one :var as
+shown below.
+
+#+PROPERTY: var foo=1, bar=2"
+ (let (results)
+ (mapc (lambda (pair)
+ (if (eq (car pair) :var)
+ (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
+ (org-babel-join-splits-near-ch
+ 61 (org-babel-balanced-split (cdr pair) 32)))
+ (push pair results)))
+ header-arguments)
+ (nreverse results)))
+
+(defun org-babel-process-params (params)
+ "Expand variables in PARAMS and add summary parameters."
+ (let* ((processed-vars (mapcar (lambda (el)
+ (if (consp (cdr el))
+ (cdr el)
+ (org-babel-ref-parse (cdr el))))
+ (org-babel-get-header params :var)))
+ (vars-and-names (if (and (assoc :colname-names params)
+ (assoc :rowname-names params))
+ (list processed-vars)
+ (org-babel-disassemble-tables
+ processed-vars
+ (cdr (assoc :hlines params))
+ (cdr (assoc :colnames params))
+ (cdr (assoc :rownames params)))))
+ (raw-result (or (cdr (assoc :results params)) ""))
+ (result-params (append
+ (split-string (if (stringp raw-result)
+ raw-result
+ (eval raw-result)))
+ (cdr (assoc :result-params params)))))
+ (append
+ (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
+ (list
+ (cons :colname-names (or (cdr (assoc :colname-names params))
+ (cadr vars-and-names)))
+ (cons :rowname-names (or (cdr (assoc :rowname-names params))
+ (caddr vars-and-names)))
+ (cons :result-params result-params)
+ (cons :result-type (cond ((member "output" result-params) 'output)
+ ((member "value" result-params) 'value)
+ (t 'value))))
+ (org-babel-get-header params :var 'other))))
+
+;; row and column names
+(defun org-babel-del-hlines (table)
+ "Remove all 'hlines from TABLE."
+ (remove 'hline table))
+
+(defun org-babel-get-colnames (table)
+ "Return the column names of TABLE.
+Return a cons cell, the `car' of which contains the TABLE less
+colnames, and the `cdr' of which contains a list of the column
+names."
+ (if (equal 'hline (nth 1 table))
+ (cons (cddr table) (car table))
+ (cons (cdr table) (car table))))
+
+(defun org-babel-get-rownames (table)
+ "Return the row names of TABLE.
+Return a cons cell, the `car' of which contains the TABLE less
+colnames, and the `cdr' of which contains a list of the column
+names. Note: this function removes any hlines in TABLE."
+ (let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
+ (width (apply 'max
+ (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
+ (table (funcall trans (mapcar (lambda (row)
+ (if (not (equal row 'hline))
+ row
+ (setq row '())
+ (dotimes (n width)
+ (setq row (cons 'hline row)))
+ row))
+ table))))
+ (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
+ (funcall trans (cdr table)))
+ (remove 'hline (car table)))))
+
+(defun org-babel-put-colnames (table colnames)
+ "Add COLNAMES to TABLE if they exist."
+ (if colnames (apply 'list colnames 'hline table) table))
+
+(defun org-babel-put-rownames (table rownames)
+ "Add ROWNAMES to TABLE if they exist."
+ (if rownames
+ (mapcar (lambda (row)
+ (if (listp row)
+ (cons (or (pop rownames) "") row)
+ row)) table)
+ table))
+
+(defun org-babel-pick-name (names selector)
+ "Select one out of an alist of row or column names.
+SELECTOR can be either a list of names in which case those names
+will be returned directly, or an index into the list NAMES in
+which case the indexed names will be return."
+ (if (listp selector)
+ selector
+ (when names
+ (if (and selector (symbolp selector) (not (equal t selector)))
+ (cdr (assoc selector names))
+ (if (integerp selector)
+ (nth (- selector 1) names)
+ (cdr (car (last names))))))))
+
+(defun org-babel-disassemble-tables (vars hlines colnames rownames)
+ "Parse tables for further processing.
+Process the variables in VARS according to the HLINES,
+ROWNAMES and COLNAMES header arguments. Return a list consisting
+of the vars, cnames and rnames."
+ (let (cnames rnames)
+ (list
+ (mapcar
+ (lambda (var)
+ (when (listp (cdr var))
+ (when (and (not (equal colnames "no"))
+ (or colnames (and (equal (nth 1 (cdr var)) 'hline)
+ (not (member 'hline (cddr (cdr var)))))))
+ (let ((both (org-babel-get-colnames (cdr var))))
+ (setq cnames (cons (cons (car var) (cdr both))
+ cnames))
+ (setq var (cons (car var) (car both)))))
+ (when (and rownames (not (equal rownames "no")))
+ (let ((both (org-babel-get-rownames (cdr var))))
+ (setq rnames (cons (cons (car var) (cdr both))
+ rnames))
+ (setq var (cons (car var) (car both)))))
+ (when (and hlines (not (equal hlines "yes")))
+ (setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
+ var)
+ vars)
+ (reverse cnames) (reverse rnames))))
+
+(defun org-babel-reassemble-table (table colnames rownames)
+ "Add column and row names to a table.
+Given a TABLE and set of COLNAMES and ROWNAMES add the names
+to the table for reinsertion to org-mode."
+ (if (listp table)
+ ((lambda (table)
+ (if (and colnames (listp (car table)) (= (length (car table))
+ (length colnames)))
+ (org-babel-put-colnames table colnames) table))
+ (if (and rownames (= (length table) (length rownames)))
+ (org-babel-put-rownames table rownames) table))
+ table))
+
+(defun org-babel-where-is-src-block-head ()
+ "Find where the current source block begins.
+Return the point at the beginning of the current source
+block. Specifically at the beginning of the #+BEGIN_SRC line.
+If the point is not on a source block then return nil."
+ (let ((initial (point)) (case-fold-search t) top bottom)
+ (or
+ (save-excursion ;; on a source name line or a #+header line
+ (beginning-of-line 1)
+ (and (or (looking-at org-babel-src-name-regexp)
+ (looking-at org-babel-multi-line-header-regexp))
+ (progn
+ (while (and (forward-line 1)
+ (or (looking-at org-babel-src-name-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
+ (looking-at org-babel-src-block-regexp))
+ (point)))
+ (save-excursion ;; on a #+begin_src line
+ (beginning-of-line 1)
+ (and (looking-at org-babel-src-block-regexp)
+ (point)))
+ (save-excursion ;; inside a src block
+ (and
+ (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
+ (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
+ (< top initial) (< initial bottom)
+ (progn (goto-char top) (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp))
+ (point))))))
+
+;;;###autoload
+(defun org-babel-goto-src-block-head ()
+ "Go to the beginning of the current code block."
+ (interactive)
+ ((lambda (head)
+ (if head (goto-char head) (error "Not currently in a code block")))
+ (org-babel-where-is-src-block-head)))
+
+;;;###autoload
+(defun org-babel-goto-named-src-block (name)
+ "Go to a named source-code block."
+ (interactive
+ (let ((completion-ignore-case t)
+ (case-fold-search t)
+ (under-point (thing-at-point 'line)))
+ (list (org-icompleting-read
+ "source-block name: " (org-babel-src-block-names) nil t
+ (cond
+ ;; noweb
+ ((string-match (org-babel-noweb-wrap) under-point)
+ (let ((block-name (match-string 1 under-point)))
+ (string-match "[^(]*" block-name)
+ (match-string 0 block-name)))
+ ;; #+call:
+ ((string-match org-babel-lob-one-liner-regexp under-point)
+ (let ((source-info (car (org-babel-lob-get-info))))
+ (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
+ (let ((source-name (match-string 1 source-info)))
+ source-name))))
+ ;; #+results:
+ ((string-match (concat "#\\+" org-babel-results-keyword
+ "\\:\s+\\([^\\(]*\\)") under-point)
+ (match-string 1 under-point))
+ ;; symbol-at-point
+ ((and (thing-at-point 'symbol))
+ (org-babel-find-named-block (thing-at-point 'symbol))
+ (thing-at-point 'symbol))
+ (""))))))
+ (let ((point (org-babel-find-named-block name)))
+ (if point
+ ;; taken from `org-open-at-point'
+ (progn (org-mark-ring-push) (goto-char point) (org-show-context))
+ (message "source-code block '%s' not found in this buffer" name))))
+
+(defun org-babel-find-named-block (name)
+ "Find a named source-code block.
+Return the location of the source block identified by source
+NAME, or nil if no such block exists. Set match data according to
+org-babel-named-src-block-regexp."
+ (save-excursion
+ (let ((case-fold-search t)
+ (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
+ (goto-char (point-min))
+ (when (or (re-search-forward regexp nil t)
+ (re-search-backward regexp nil t))
+ (match-beginning 0)))))
+
+(defun org-babel-src-block-names (&optional file)
+ "Returns the names of source blocks in FILE or the current buffer."
+ (save-excursion
+ (when file (find-file file)) (goto-char (point-min))
+ (let ((case-fold-search t) names)
+ (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
+ (setq names (cons (match-string 3) names)))
+ names)))
+
+;;;###autoload
+(defun org-babel-goto-named-result (name)
+ "Go to a named result."
+ (interactive
+ (let ((completion-ignore-case t))
+ (list (org-icompleting-read "source-block name: "
+ (org-babel-result-names) nil t))))
+ (let ((point (org-babel-find-named-result name)))
+ (if point
+ ;; taken from `org-open-at-point'
+ (progn (goto-char point) (org-show-context))
+ (message "result '%s' not found in this buffer" name))))
+
+(defun org-babel-find-named-result (name &optional point)
+ "Find a named result.
+Return the location of the result named NAME in the current
+buffer or nil if no such result exists."
+ (save-excursion
+ (let ((case-fold-search t))
+ (goto-char (or point (point-min)))
+ (catch 'is-a-code-block
+ (when (re-search-forward
+ (concat org-babel-result-regexp
+ "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
+ (when (and (string= "name" (downcase (match-string 1)))
+ (or (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp)))
+ (throw 'is-a-code-block (org-babel-find-named-result name (point))))
+ (beginning-of-line 0) (point))))))
+
+(defun org-babel-result-names (&optional file)
+ "Returns the names of results in FILE or the current buffer."
+ (save-excursion
+ (when file (find-file file)) (goto-char (point-min))
+ (let ((case-fold-search t) names)
+ (while (re-search-forward org-babel-result-w-name-regexp nil t)
+ (setq names (cons (match-string 4) names)))
+ names)))
+
+;;;###autoload
+(defun org-babel-next-src-block (&optional arg)
+ "Jump to the next source block.
+With optional prefix argument ARG, jump forward ARG many source blocks."
+ (interactive "P")
+ (when (looking-at org-babel-src-block-regexp) (forward-char 1))
+ (condition-case nil
+ (re-search-forward org-babel-src-block-regexp nil nil (or arg 1))
+ (error (error "No further code blocks")))
+ (goto-char (match-beginning 0)) (org-show-context))
+
+;;;###autoload
+(defun org-babel-previous-src-block (&optional arg)
+ "Jump to the previous source block.
+With optional prefix argument ARG, jump backward ARG many source blocks."
+ (interactive "P")
+ (condition-case nil
+ (re-search-backward org-babel-src-block-regexp nil nil (or arg 1))
+ (error (error "No previous code blocks")))
+ (goto-char (match-beginning 0)) (org-show-context))
+
+(defvar org-babel-load-languages)
+
+;;;###autoload
+(defun org-babel-mark-block ()
+ "Mark current src block."
+ (interactive)
+ ((lambda (head)
+ (when head
+ (save-excursion
+ (goto-char head)
+ (looking-at org-babel-src-block-regexp))
+ (push-mark (match-end 5) nil t)
+ (goto-char (match-beginning 5))))
+ (org-babel-where-is-src-block-head)))
+
+(defun org-babel-demarcate-block (&optional arg)
+ "Wrap or split the code in the region or on the point.
+When called from inside of a code block the current block is
+split. When called from outside of a code block a new code block
+is created. In both cases if the region is demarcated and if the
+region is not active then the point is demarcated."
+ (interactive "P")
+ (let ((info (org-babel-get-src-block-info 'light))
+ (headers (progn (org-babel-where-is-src-block-head)
+ (match-string 4)))
+ (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
+ (if info
+ (mapc
+ (lambda (place)
+ (save-excursion
+ (goto-char place)
+ (let ((lang (nth 0 info))
+ (indent (make-string (nth 5 info) ? )))
+ (when (string-match "^[[:space:]]*$"
+ (buffer-substring (point-at-bol)
+ (point-at-eol)))
+ (delete-region (point-at-bol) (point-at-eol)))
+ (insert (concat
+ (if (looking-at "^") "" "\n")
+ indent "#+end_src\n"
+ (if arg stars indent) "\n"
+ indent "#+begin_src " lang
+ (if (> (length headers) 1)
+ (concat " " headers) headers)
+ (if (looking-at "[\n\r]")
+ ""
+ (concat "\n" (make-string (current-column) ? )))))))
+ (move-end-of-line 2))
+ (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
+ (let ((start (point))
+ (lang (org-icompleting-read "Lang: "
+ (mapcar (lambda (el) (symbol-name (car el)))
+ org-babel-load-languages)))
+ (body (delete-and-extract-region
+ (if (org-region-active-p) (mark) (point)) (point))))
+ (insert (concat (if (looking-at "^") "" "\n")
+ (if arg (concat stars "\n") "")
+ "#+begin_src " lang "\n"
+ body
+ (if (or (= (length body) 0)
+ (string-match "[\r\n]$" body)) "" "\n")
+ "#+end_src\n"))
+ (goto-char start) (move-end-of-line 1)))))
+
+(defvar org-babel-lob-one-liner-regexp)
+(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
+ "Find where the current source block results begin.
+Return the point at the beginning of the result of the current
+source block. Specifically at the beginning of the results line.
+If no result exists for this block then create a results line
+following the source block."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (on-lob-line (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-babel-lob-one-liner-regexp)))
+ (inlinep (when (org-babel-get-inline-src-block-matches)
+ (match-end 0)))
+ (name (if on-lob-line
+ (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
+ (nth 4 (or info (org-babel-get-src-block-info 'light)))))
+ (head (unless on-lob-line (org-babel-where-is-src-block-head)))
+ found beg end)
+ (when head (goto-char head))
+ (setq
+ found ;; was there a result (before we potentially insert one)
+ (or
+ inlinep
+ (and
+ ;; named results:
+ ;; - return t if it is found, else return nil
+ ;; - if it does not need to be rebuilt, then don't set end
+ ;; - if it does need to be rebuilt then do set end
+ name (setq beg (org-babel-find-named-result name))
+ (prog1 beg
+ (when (and hash (not (string= hash (match-string 3))))
+ (goto-char beg) (setq end beg) ;; beginning of result
+ (forward-line 1)
+ (delete-region end (org-babel-result-end)) nil)))
+ (and
+ ;; unnamed results:
+ ;; - return t if it is found, else return nil
+ ;; - if it is found, and the hash doesn't match, delete and set end
+ (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
+ (progn (end-of-line 1)
+ (if (eobp) (insert "\n") (forward-char 1))
+ (setq end (point))
+ (or (and (not name)
+ (progn ;; unnamed results line already exists
+ (re-search-forward "[^ \f\t\n\r\v]" nil t)
+ (beginning-of-line 1)
+ (looking-at
+ (concat org-babel-result-regexp "\n")))
+ (prog1 (point)
+ ;; must remove and rebuild if hash!=old-hash
+ (if (and hash (not (string= hash (match-string 3))))
+ (prog1 nil
+ (forward-line 1)
+ (delete-region
+ end (org-babel-result-end)))
+ (setq end nil)))))))))
+ (if (and insert end)
+ (progn
+ (goto-char end)
+ (unless beg
+ (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
+ (insert (concat
+ (if indent
+ (mapconcat
+ (lambda (el) " ")
+ (org-number-sequence 1 indent) "")
+ "")
+ "#+" org-babel-results-keyword
+ (when hash (concat "["hash"]"))
+ ":"
+ (when name (concat " " name)) "\n"))
+ (unless beg (insert "\n") (backward-char))
+ (beginning-of-line 0)
+ (if hash (org-babel-hide-hash))
+ (point))
+ found))))
+
+(defvar org-block-regexp)
+(defun org-babel-read-result ()
+ "Read the result at `point' into emacs-lisp."
+ (let ((case-fold-search t) result-string)
+ (cond
+ ((org-at-table-p) (org-babel-read-table))
+ ((org-at-item-p) (org-babel-read-list))
+ ((looking-at org-bracket-link-regexp) (org-babel-read-link))
+ ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
+ ((looking-at "^[ \t]*: ")
+ (setq result-string
+ (org-babel-trim
+ (mapconcat (lambda (line)
+ (if (and (> (length line) 1)
+ (string-match "^[ \t]*: \\(.+\\)" line))
+ (match-string 1 line)
+ line))
+ (split-string
+ (buffer-substring
+ (point) (org-babel-result-end)) "[\r\n]+")
+ "\n")))
+ (or (org-babel-number-p result-string) result-string))
+ ((looking-at org-babel-result-regexp)
+ (save-excursion (forward-line 1) (org-babel-read-result))))))
+
+(defun org-babel-read-table ()
+ "Read the table at `point' into emacs-lisp."
+ (mapcar (lambda (row)
+ (if (and (symbolp row) (equal row 'hline)) row
+ (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
+ (org-table-to-lisp)))
+
+(defun org-babel-read-list ()
+ "Read the list at `point' into emacs-lisp."
+ (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
+ (mapcar #'cadr (cdr (org-list-parse-list)))))
+
+(defvar org-link-types-re)
+(defun org-babel-read-link ()
+ "Read the link at `point' into emacs-lisp.
+If the path of the link is a file path it is expanded using
+`expand-file-name'."
+ (let* ((case-fold-search t)
+ (raw (and (looking-at org-bracket-link-regexp)
+ (org-no-properties (match-string 1))))
+ (type (and (string-match org-link-types-re raw)
+ (match-string 1 raw))))
+ (cond
+ ((not type) (expand-file-name raw))
+ ((string= type "file")
+ (and (string-match "file\\(.*\\):\\(.+\\)" raw)
+ (expand-file-name (match-string 2 raw))))
+ (t raw))))
+
+(defun org-babel-format-result (result &optional sep)
+ "Format RESULT for writing to file."
+ (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
+ (if (listp result)
+ ;; table result
+ (orgtbl-to-generic
+ result (list :sep (or sep "\t") :fmt echo-res))
+ ;; scalar result
+ (funcall echo-res result))))
+
+(defun org-babel-insert-result
+ (result &optional result-params info hash indent lang)
+ "Insert RESULT into the current buffer.
+By default RESULT is inserted after the end of the
+current source block. With optional argument RESULT-PARAMS
+controls insertion of results in the org-mode file.
+RESULT-PARAMS can take the following values:
+
+replace - (default option) insert results after the source block
+ replacing any previously inserted results
+
+silent -- no results are inserted
+
+file ---- the results are interpreted as a file path, and are
+ inserted into the buffer using the Org-mode file syntax
+
+list ---- the results are interpreted as an Org-mode list.
+
+raw ----- results are added directly to the Org-mode file. This
+ is a good option if you code block will output org-mode
+ formatted text.
+
+drawer -- results are added directly to the Org-mode file as with
+ \"raw\", but are wrapped in a RESULTS drawer, allowing
+ them to later be replaced or removed automatically.
+
+org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
+ They are not comma-escaped when inserted, but Org syntax
+ here will be discarded when exporting the file.
+
+html ---- results are added inside of a #+BEGIN_HTML block. This
+ is a good option if you code block will output html
+ formatted text.
+
+latex --- results are added inside of a #+BEGIN_LATEX block.
+ This is a good option if you code block will output
+ latex formatted text.
+
+code ---- the results are extracted in the syntax of the source
+ code of the language being evaluated and are added
+ inside of a #+BEGIN_SRC block with the source-code
+ language set appropriately. Note this relies on the
+ optional LANG argument."
+ (if (stringp result)
+ (progn
+ (setq result (org-no-properties result))
+ (when (member "file" result-params)
+ (setq result (org-babel-result-to-file
+ result (when (assoc :file-desc (nth 2 info))
+ (or (cdr (assoc :file-desc (nth 2 info)))
+ result))))))
+ (unless (listp result) (setq result (format "%S" result))))
+ (if (and result-params (member "silent" result-params))
+ (progn
+ (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ result)
+ (save-excursion
+ (let* ((inlinep
+ (save-excursion
+ (when (or (org-babel-get-inline-src-block-matches)
+ (org-babel-get-lob-one-liner-matches))
+ (goto-char (match-end 0))
+ (insert (if (listp result) "\n" " "))
+ (point))))
+ (existing-result (unless inlinep
+ (org-babel-where-is-src-block-result
+ t info hash indent)))
+ (results-switches
+ (cdr (assoc :results_switches (nth 2 info))))
+ beg end)
+ (when (and (stringp result) ; ensure results end in a newline
+ (not inlinep)
+ (> (length result) 0)
+ (not (or (string-equal (substring result -1) "\n")
+ (string-equal (substring result -1) "\r"))))
+ (setq result (concat result "\n")))
+ (if (not existing-result)
+ (setq beg (or inlinep (point)))
+ (goto-char existing-result)
+ (save-excursion
+ (re-search-forward "#" nil t)
+ (setq indent (- (current-column) 1)))
+ (forward-line 1)
+ (setq beg (point))
+ (cond
+ ((member "replace" result-params)
+ (delete-region (point) (org-babel-result-end)))
+ ((member "append" result-params)
+ (goto-char (org-babel-result-end)) (setq beg (point-marker)))
+ ((member "prepend" result-params)))) ; already there
+ (setq results-switches
+ (if results-switches (concat " " results-switches) ""))
+ (let ((wrap (lambda (start finish &optional escape)
+ (goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (if escape (org-add-protective-commas (point) end))
+ (goto-char end) (goto-char (point-at-eol))
+ (setq end (point-marker))))
+ (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
+ ;; insert results based on type
+ (cond
+ ;; do nothing for an empty result
+ ((null result))
+ ;; insert a list if preferred
+ ((member "list" result-params)
+ (insert
+ (org-babel-trim
+ (org-list-to-generic
+ (cons 'unordered
+ (mapcar
+ (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
+ (if (listp result) result (list result))))
+ '(:splicep nil :istart "- " :iend "\n")))
+ "\n"))
+ ;; assume the result is a table if it's not a string
+ ((funcall proper-list-p result)
+ (goto-char beg)
+ (insert (concat (orgtbl-to-orgtbl
+ (if (or (eq 'hline (car result))
+ (and (listp (car result))
+ (listp (cdr (car result)))))
+ result (list result))
+ '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
+ (goto-char beg) (when (org-at-table-p) (org-table-align)))
+ ((and (listp result) (not (funcall proper-list-p result)))
+ (insert (format "%s\n" result)))
+ ((member "file" result-params)
+ (when inlinep (goto-char inlinep))
+ (insert result))
+ (t (goto-char beg) (insert result)))
+ (when (funcall proper-list-p result) (goto-char (org-table-end)))
+ (setq end (point-marker))
+ ;; possibly wrap result
+ (cond
+ ((assoc :wrap (nth 2 info))
+ (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
+ (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
+ ((member "html" result-params)
+ (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
+ ((member "latex" result-params)
+ (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
+ ((member "org" result-params)
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" 'escape))
+ ((member "code" result-params)
+ (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
+ "#+END_SRC"))
+ ((member "raw" result-params)
+ (goto-char beg) (if (org-at-table-p) (org-cycle)))
+ ((or (member "drawer" result-params)
+ ;; Stay backward compatible with <7.9.2
+ (member "wrap" result-params))
+ (funcall wrap ":RESULTS:" ":END:"))
+ ((and (not (funcall proper-list-p result))
+ (not (member "file" result-params)))
+ (org-babel-examplize-region beg end results-switches)
+ (setq end (point)))))
+ ;; possibly indent the results to match the #+results line
+ (when (and (not inlinep) (numberp indent) indent (> indent 0)
+ ;; in this case `table-align' does the work for us
+ (not (and (listp result)
+ (member "append" result-params))))
+ (indent-rigidly beg end indent))))
+ (if (null result)
+ (if (member "value" result-params)
+ (message "Code block returned no value.")
+ (message "Code block produced no output."))
+ (message "Code block evaluation complete."))))
+
+(defun org-babel-remove-result (&optional info)
+ "Remove the result of the current source block."
+ (interactive)
+ (let ((location (org-babel-where-is-src-block-result nil info)) start)
+ (when location
+ (setq start (- location 1))
+ (save-excursion
+ (goto-char location) (forward-line 1)
+ (delete-region start (org-babel-result-end))))))
+
+(defun org-babel-result-end ()
+ "Return the point at the end of the current set of results."
+ (save-excursion
+ (cond
+ ((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
+ ((org-at-item-p) (let* ((struct (org-list-struct))
+ (prvs (org-list-prevs-alist struct)))
+ (org-list-get-list-end (point-at-bol) struct prvs)))
+ ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:"))
+ (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
+ (forward-char 1) (point)))
+ (t
+ (let ((case-fold-search t))
+ (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)"))
+ (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
+ nil t)
+ (forward-char 1))
+ (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
+ (forward-line 1))))
+ (point)))))
+
+(defun org-babel-result-to-file (result &optional description)
+ "Convert RESULT into an `org-mode' link with optional DESCRIPTION.
+If the `default-directory' is different from the containing
+file's directory then expand relative links."
+ (when (stringp result)
+ (format "[[file:%s]%s]"
+ (if (and default-directory
+ buffer-file-name
+ (not (string= (expand-file-name default-directory)
+ (expand-file-name
+ (file-name-directory buffer-file-name)))))
+ (expand-file-name result default-directory)
+ result)
+ (if description (concat "[" description "]") ""))))
+
+(defvar org-babel-capitalize-examplize-region-markers nil
+ "Make true to capitalize begin/end example markers inserted by code blocks.")
+
+(defun org-babel-examplize-region (beg end &optional results-switches)
+ "Comment out region using the inline '==' or ': ' org example quote."
+ (interactive "*r")
+ (let ((chars-between (lambda (b e)
+ (not (string-match "^[\\s]*$" (buffer-substring b e)))))
+ (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
+ (upcase str) str))))
+ (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
+ (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (save-excursion
+ (goto-char beg)
+ (insert (format "=%s=" (prog1 (buffer-substring beg end)
+ (delete-region beg end)))))
+ (let ((size (count-lines beg end)))
+ (save-excursion
+ (cond ((= size 0)) ; do nothing for an empty result
+ ((< size org-babel-min-lines-for-block-output)
+ (goto-char beg)
+ (dotimes (n size)
+ (beginning-of-line 1) (insert ": ") (forward-line 1)))
+ (t
+ (goto-char beg)
+ (insert (if results-switches
+ (format "%s%s\n"
+ (funcall maybe-cap "#+begin_example")
+ results-switches)
+ (funcall maybe-cap "#+begin_example\n")))
+ (if (markerp end) (goto-char end) (forward-char (- end beg)))
+ (insert (funcall maybe-cap "#+end_example\n")))))))))
+
+(defun org-babel-update-block-body (new-body)
+ "Update the body of the current code block to NEW-BODY."
+ (if (not (org-babel-where-is-src-block-head))
+ (error "Not in a source block")
+ (save-match-data
+ (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
+ (indent-rigidly (match-beginning 5) (match-end 5) 2)))
+
+(defun org-babel-merge-params (&rest plists)
+ "Combine all parameter association lists in PLISTS.
+Later elements of PLISTS override the values of previous elements.
+This takes into account some special considerations for certain
+parameters when merging lists."
+ (let* ((results-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'results org-babel-common-header-args-w-values))))
+ (exports-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'exports org-babel-common-header-args-w-values))))
+ (variable-index 0)
+ (e-merge (lambda (exclusive-groups &rest result-params)
+ ;; maintain exclusivity of mutually exclusive parameters
+ (let (output)
+ (mapc (lambda (new-params)
+ (mapc (lambda (new-param)
+ (mapc (lambda (exclusive-group)
+ (when (member new-param exclusive-group)
+ (mapcar (lambda (excluded-param)
+ (setq output
+ (delete
+ excluded-param
+ output)))
+ exclusive-group)))
+ exclusive-groups)
+ (setq output (org-uniquify
+ (cons new-param output))))
+ new-params))
+ result-params)
+ output)))
+ params results exports tangle noweb cache vars shebang comments padline)
+
+ (mapc
+ (lambda (plist)
+ (mapc
+ (lambda (pair)
+ (case (car pair)
+ (:var
+ (let ((name (if (listp (cdr pair))
+ (cadr pair)
+ (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
+ (cdr pair))
+ (intern (match-string 1 (cdr pair)))))))
+ (if name
+ (setq vars
+ (append
+ (if (member name (mapcar #'car vars))
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (unless (equal (car p) name) p))
+ vars))
+ vars)
+ (list (cons name pair))))
+ ;; if no name is given and we already have named variables
+ ;; then assign to named variables in order
+ (if (and vars (nth variable-index vars))
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name
+ (car (nth variable-index vars)))
+ "=" (cdr pair)))
+ (incf variable-index))
+ (error "Variable \"%s\" must be assigned a default value"
+ (cdr pair))))))
+ (:results
+ (setq results (funcall e-merge results-exclusive-groups
+ results
+ (split-string
+ (let ((r (cdr pair)))
+ (if (stringp r) r (eval r)))))))
+ (:file
+ (when (cdr pair)
+ (setq results (funcall e-merge results-exclusive-groups
+ results '("file")))
+ (unless (or (member "both" exports)
+ (member "none" exports)
+ (member "code" exports))
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports '("results"))))
+ (setq params (cons pair (assq-delete-all (car pair) params)))))
+ (:exports
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports (split-string (cdr pair)))))
+ (:tangle ;; take the latest -- always overwrite
+ (setq tangle (or (list (cdr pair)) tangle)))
+ (:noweb
+ (setq noweb (funcall e-merge
+ '(("yes" "no" "tangle" "no-export"
+ "strip-export" "eval"))
+ noweb
+ (split-string (or (cdr pair) "")))))
+ (:cache
+ (setq cache (funcall e-merge '(("yes" "no")) cache
+ (split-string (or (cdr pair) "")))))
+ (:padline
+ (setq padline (funcall e-merge '(("yes" "no")) padline
+ (split-string (or (cdr pair) "")))))
+ (:shebang ;; take the latest -- always overwrite
+ (setq shebang (or (list (cdr pair)) shebang)))
+ (:comments
+ (setq comments (funcall e-merge '(("yes" "no")) comments
+ (split-string (or (cdr pair) "")))))
+ (t ;; replace: this covers e.g. :session
+ (setq params (cons pair (assq-delete-all (car pair) params))))))
+ plist))
+ plists)
+ (setq vars (reverse vars))
+ (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
+ (mapc
+ (lambda (hd)
+ (let ((key (intern (concat ":" (symbol-name hd))))
+ (val (eval hd)))
+ (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
+ '(results exports tangle noweb padline cache shebang comments))
+ params))
+
+(defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil
+ "Set to true to use regular expressions to expand noweb references.
+This results in much faster noweb reference expansion but does
+not properly allow code blocks to inherit the \":noweb-ref\"
+header argument from buffer or subtree wide properties.")
+
+(defun org-babel-noweb-p (params context)
+ "Check if PARAMS require expansion in CONTEXT.
+CONTEXT may be one of :tangle, :export or :eval."
+ (let* (intersect
+ (intersect (lambda (as bs)
+ (when as
+ (if (member (car as) bs)
+ (car as)
+ (funcall intersect (cdr as) bs))))))
+ (funcall intersect (case context
+ (:tangle '("yes" "tangle" "no-export" "strip-export"))
+ (:eval '("yes" "no-export" "strip-export" "eval"))
+ (:export '("yes")))
+ (split-string (or (cdr (assoc :noweb params)) "")))))
+
+(defun org-babel-expand-noweb-references (&optional info parent-buffer)
+ "Expand Noweb references in the body of the current source code block.
+
+For example the following reference would be replaced with the
+body of the source-code block named 'example-block'.
+
+<<example-block>>
+
+Note that any text preceding the <<foo>> construct on a line will
+be interposed between the lines of the replacement text. So for
+example if <<foo>> is placed behind a comment, then the entire
+replacement text will also be commented.
+
+This function must be called from inside of the buffer containing
+the source-code block which holds BODY.
+
+In addition the following syntax can be used to insert the
+results of evaluating the source-code block named 'example-block'.
+
+<<example-block()>>
+
+Any optional arguments can be passed to example-block by placing
+the arguments inside the parenthesis following the convention
+defined by `org-babel-lob'. For example
+
+<<example-block(a=9)>>
+
+would set the value of argument \"a\" equal to \"9\". Note that
+these arguments are not evaluated in the current source-code
+block but are passed literally to the \"example-block\"."
+ (let* ((parent-buffer (or parent-buffer (current-buffer)))
+ (info (or info (org-babel-get-src-block-info)))
+ (lang (nth 0 info))
+ (body (nth 1 info))
+ (ob-nww-start org-babel-noweb-wrap-start)
+ (ob-nww-end org-babel-noweb-wrap-end)
+ (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
+ (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
+ ":noweb-ref[ \t]+" "\\)"))
+ (new-body "")
+ (nb-add (lambda (text) (setq new-body (concat new-body text))))
+ (c-wrap (lambda (text)
+ (with-temp-buffer
+ (funcall (intern (concat lang "-mode")))
+ (comment-region (point) (progn (insert text) (point)))
+ (org-babel-trim (buffer-string)))))
+ index source-name evaluate prefix blocks-in-buffer)
+ (with-temp-buffer
+ (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
+ (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
+ (insert body) (goto-char (point-min))
+ (setq index (point))
+ (while (and (re-search-forward (org-babel-noweb-wrap) nil t))
+ (save-match-data (setf source-name (match-string 1)))
+ (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
+ (save-match-data
+ (setq prefix
+ (buffer-substring (match-beginning 0)
+ (save-excursion
+ (beginning-of-line 1) (point)))))
+ ;; add interval to new-body (removing noweb reference)
+ (goto-char (match-beginning 0))
+ (funcall nb-add (buffer-substring index (point)))
+ (goto-char (match-end 0))
+ (setq index (point))
+ (funcall nb-add
+ (with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
+ (mapconcat ;; interpose PREFIX between every line
+ #'identity
+ (split-string
+ (if evaluate
+ (let ((raw (org-babel-ref-resolve source-name)))
+ (if (stringp raw) raw (format "%S" raw)))
+ (or
+ ;; retrieve from the library of babel
+ (nth 2 (assoc (intern source-name)
+ org-babel-library-of-babel))
+ ;; return the contents of headlines literally
+ (save-excursion
+ (when (org-babel-ref-goto-headline-id source-name)
+ (org-babel-ref-headline-body)))
+ ;; find the expansion of reference in this buffer
+ (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+ expansion)
+ (save-excursion
+ (goto-char (point-min))
+ (if *org-babel-use-quick-and-dirty-noweb-expansion*
+ (while (re-search-forward rx nil t)
+ (let* ((i (org-babel-get-src-block-info 'light))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ (org-babel-tangle-comment-links i))
+ body)))
+ (setq expansion (cons sep (cons full expansion)))))
+ (org-babel-map-src-blocks nil
+ (let ((i (org-babel-get-src-block-info 'light)))
+ (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (nth 4 i))
+ source-name)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ ((lambda (cs)
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ (org-babel-tangle-comment-links i))
+ body)))
+ (setq expansion
+ (cons sep (cons full expansion)))))))))
+ (and expansion
+ (mapconcat #'identity (nreverse (cdr expansion)) "")))
+ ;; possibly raise an error if named block doesn't exist
+ (if (member lang org-babel-noweb-error-langs)
+ (error "%s" (concat
+ (org-babel-noweb-wrap source-name)
+ "could not be resolved (see "
+ "`org-babel-noweb-error-langs')"))
+ "")))
+ "[\n\r]") (concat "\n" prefix))))))
+ (funcall nb-add (buffer-substring index (point-max))))
+ new-body))
+
+(defun org-babel-strip-protective-commas (body &optional lang)
+ "Strip protective commas from bodies of source blocks."
+ (with-temp-buffer
+ (insert body)
+ (if (and lang (string= lang "org"))
+ (progn (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\(,\\)" nil t)
+ (replace-match "" nil nil nil 1)))
+ (org-strip-protective-commas (point-min) (point-max)))
+ (buffer-string)))
+
+(defun org-babel-script-escape (str &optional force)
+ "Safely convert tables into elisp lists."
+ (let (in-single in-double out)
+ ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped)))
+ (if (or force
+ (and (stringp str)
+ (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1))))))
+ (org-babel-read
+ (concat
+ "'"
+ (progn
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (case ch
+ (91 (if (or in-double in-single) ; [
+ (cons 91 out)
+ (cons 40 out)))
+ (93 (if (or in-double in-single) ; ]
+ (cons 93 out)
+ (cons 41 out)))
+ (123 (if (or in-double in-single) ; {
+ (cons 123 out)
+ (cons 40 out)))
+ (125 (if (or in-double in-single) ; }
+ (cons 125 out)
+ (cons 41 out)))
+ (44 (if (or in-double in-single) ; ,
+ (cons 44 out) (cons 32 out)))
+ (39 (if in-double ; '
+ (cons 39 out)
+ (setq in-single (not in-single)) (cons 34 out)))
+ (34 (if in-single ; "
+ (append (list 34 32) out)
+ (setq in-double (not in-double)) (cons 34 out)))
+ (t (cons ch out)))))
+ (string-to-list str))
+ (apply #'string (reverse out)))))
+ str))))
+
+(defun org-babel-read (cell &optional inhibit-lisp-eval)
+ "Convert the string value of CELL to a number if appropriate.
+Otherwise if cell looks like lisp (meaning it starts with a
+\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise
+return it unmodified as a string. Optional argument NO-LISP-EVAL
+inhibits lisp evaluation for situations in which is it not
+appropriate."
+ (if (and (stringp cell) (not (equal cell "")))
+ (or (org-babel-number-p cell)
+ (if (and (not inhibit-lisp-eval)
+ (member (substring cell 0 1) '("(" "'" "`" "[")))
+ (eval (read cell))
+ (if (string= (substring cell 0 1) "\"")
+ (read cell)
+ (progn (set-text-properties 0 (length cell) nil cell) cell))))
+ cell))
+
+(defun org-babel-number-p (string)
+ "If STRING represents a number return its value."
+ (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
+ (= (length (substring string (match-beginning 0)
+ (match-end 0)))
+ (length string)))
+ (string-to-number string)))
+
+(defun org-babel-import-elisp-from-file (file-name &optional separator)
+ "Read the results located at FILE-NAME into an elisp table.
+If the table is trivial, then return it as a scalar."
+ (let (result)
+ (save-window-excursion
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (org-table-import file-name separator)
+ (delete-file file-name)
+ (setq result (mapcar (lambda (row)
+ (mapcar #'org-babel-string-read row))
+ (org-table-to-lisp))))
+ (error (message "Error reading results: %s" err) nil)))
+ (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
+ (if (consp (car result))
+ (if (null (cdr (car result)))
+ (caar result)
+ result)
+ (car result))
+ result))))
+
+(defun org-babel-string-read (cell)
+ "Strip nested \"s from around strings."
+ (org-babel-read (or (and (stringp cell)
+ (string-match "\\\"\\(.+\\)\\\"" cell)
+ (match-string 1 cell))
+ cell) t))
+
+(defun org-babel-reverse-string (string)
+ "Return the reverse of STRING."
+ (apply 'string (reverse (string-to-list string))))
+
+(defun org-babel-chomp (string &optional regexp)
+ "Strip trailing spaces and carriage returns from STRING.
+Default regexp used is \"[ \f\t\n\r\v]\" but can be
+overwritten by specifying a regexp as a second argument."
+ (let ((regexp (or regexp "[ \f\t\n\r\v]")))
+ (while (and (> (length string) 0)
+ (string-match regexp (substring string -1)))
+ (setq string (substring string 0 -1)))
+ string))
+
+(defun org-babel-trim (string &optional regexp)
+ "Strip leading and trailing spaces and carriage returns from STRING.
+Like `org-babel-chomp' only it runs on both the front and back
+of the string."
+ (org-babel-chomp (org-babel-reverse-string
+ (org-babel-chomp (org-babel-reverse-string string) regexp))
+ regexp))
+
+(defvar org-babel-org-babel-call-process-region-original nil)
+(defun org-babel-tramp-handle-call-process-region
+ (start end program &optional delete buffer display &rest args)
+ "Use Tramp to handle `call-process-region'.
+Fixes a bug in `tramp-handle-call-process-region'."
+ (if (and (featurep 'tramp) (file-remote-p default-directory))
+ (let ((tmpfile (tramp-compat-make-temp-file "")))
+ (write-region start end tmpfile)
+ (when delete (delete-region start end))
+ (unwind-protect
+ ;; (apply 'call-process program tmpfile buffer display args)
+ ;; bug in tramp
+ (apply 'process-file program tmpfile buffer display args)
+ (delete-file tmpfile)))
+ ;; org-babel-call-process-region-original is the original emacs
+ ;; definition. It is in scope from the let binding in
+ ;; org-babel-execute-src-block
+ (apply org-babel-call-process-region-original
+ start end program delete buffer display args)))
+
+(defun org-babel-local-file-name (file)
+ "Return the local name component of FILE."
+ (if (file-remote-p file)
+ (let (localname)
+ (with-parsed-tramp-file-name file nil
+ localname))
+ file))
+
+(defun org-babel-process-file-name (name &optional no-quote-p)
+ "Prepare NAME to be used in an external process.
+If NAME specifies a remote location, the remote portion of the
+name is removed, since in that case the process will be executing
+remotely. The file name is then processed by `expand-file-name'.
+Unless second argument NO-QUOTE-P is non-nil, the file name is
+additionally processed by `shell-quote-argument'"
+ ((lambda (f) (if no-quote-p f (shell-quote-argument f)))
+ (expand-file-name (org-babel-local-file-name name))))
+
+(defvar org-babel-temporary-directory)
+(unless (or noninteractive (boundp 'org-babel-temporary-directory))
+ (defvar org-babel-temporary-directory
+ (or (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory)
+ org-babel-temporary-directory)
+ (make-temp-file "babel-" t))
+ "Directory to hold temporary files created to execute code blocks.
+Used by `org-babel-temp-file'. This directory will be removed on
+Emacs shutdown."))
+
+(defun org-babel-temp-file (prefix &optional suffix)
+ "Create a temporary file in the `org-babel-temporary-directory'.
+Passes PREFIX and SUFFIX directly to `make-temp-file' with the
+value of `temporary-file-directory' temporarily set to the value
+of `org-babel-temporary-directory'."
+ (if (file-remote-p default-directory)
+ (make-temp-file
+ (concat (file-remote-p default-directory)
+ (expand-file-name
+ prefix temporary-file-directory)
+ nil suffix))
+ (let ((temporary-file-directory
+ (or (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory)
+ org-babel-temporary-directory)
+ temporary-file-directory)))
+ (make-temp-file prefix nil suffix))))
+
+(defun org-babel-remove-temporary-directory ()
+ "Remove `org-babel-temporary-directory' on Emacs shutdown."
+ (when (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory))
+ ;; taken from `delete-directory' in files.el
+ (condition-case nil
+ (progn
+ (mapc (lambda (file)
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (if (eq t (car (file-attributes file)))
+ (delete-directory file)
+ (delete-file file)))
+ ;; We do not want to delete "." and "..".
+ (directory-files org-babel-temporary-directory 'full
+ "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+ (delete-directory org-babel-temporary-directory))
+ (error
+ (message "Failed to remove temporary Org-babel directory %s"
+ (if (boundp 'org-babel-temporary-directory)
+ org-babel-temporary-directory
+ "[directory not defined]"))))))
+
+(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+
+(provide 'ob)
+
+
+
+;;; ob.el ends here
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
new file mode 100755
index 0000000..97241b6
--- /dev/null
+++ b/lisp/org-agenda.el
@@ -0,0 +1,9227 @@
+;;; org-agenda.el --- Dynamic task and appointment lists for Org
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code for creating and using the Agenda for Org-mode.
+;;
+;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
+;; `org-batch-store-agenda-views' are implemented as macros to provide
+;; a convenient way for extracting agenda information from the command
+;; line. The Lisp does not evaluate parameters of a macro call; thus
+;; it is not necessary to quote the parameters passed to one of those
+;; functions. E.g. you can write:
+;;
+;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
+;;
+;; To export an agenda spanning 7 days. If `org-batch-agenda' would
+;; have been implemented as a regular function you'd have to quote the
+;; symbol org-agenda-span. Moreover: To use a symbol as parameter
+;; value you would have to double quote the symbol.
+;;
+;; This is a hack, but it works even when running Org byte-compiled.
+;;
+
+;;; Code:
+
+(require 'org)
+(require 'org-macs)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function diary-add-to-list "diary-lib"
+ (date string specifier &optional marker globcolor literal))
+(declare-function calendar-absolute-from-iso "cal-iso" (date))
+(declare-function calendar-astro-date-string "cal-julian" (&optional date))
+(declare-function calendar-bahai-date-string "cal-bahai" (&optional date))
+(declare-function calendar-chinese-date-string "cal-china" (&optional date))
+(declare-function calendar-coptic-date-string "cal-coptic" (&optional date))
+(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
+(declare-function calendar-french-date-string "cal-french" (&optional date))
+(declare-function calendar-goto-date "cal-move" (date))
+(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date))
+(declare-function calendar-islamic-date-string "cal-islam" (&optional date))
+(declare-function calendar-iso-date-string "cal-iso" (&optional date))
+(declare-function calendar-iso-from-absolute "cal-iso" (date))
+(declare-function calendar-julian-date-string "cal-julian" (&optional date))
+(declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
+(declare-function calendar-persian-date-string "cal-persia" (&optional date))
+(declare-function calendar-check-holidays "holidays" (date))
+
+(declare-function org-datetree-find-date-create "org-datetree"
+ (date &optional keep-restriction))
+(declare-function org-columns-quit "org-colview" ())
+(declare-function diary-date-display-form "diary-lib" (&optional type))
+(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
+(declare-function org-habit-insert-consistency-graphs
+ "org-habit" (&optional line))
+(declare-function org-is-habit-p "org-habit" (&optional pom))
+(declare-function org-habit-parse-todo "org-habit" (&optional pom))
+(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
+(declare-function org-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
+(declare-function org-agenda-columns "org-colview" ())
+(declare-function org-add-archive-files "org-archive" (files))
+(declare-function org-capture "org-capture" (&optional goto keys))
+
+(defvar calendar-mode-map) ; defined in calendar.el
+(defvar org-clock-current-task nil) ; defined in org-clock.el
+(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
+(defvar org-habit-show-habits) ; defined in org-habit.el
+(defvar org-habit-show-habits-only-for-today)
+(defvar org-habit-show-all-today)
+
+;; Defined somewhere in this file, but used before definition.
+(defvar org-agenda-buffer-name "*Org Agenda*")
+(defvar org-agenda-overriding-header nil)
+(defvar org-agenda-title-append nil)
+(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+(defvar original-date) ; dynamically scoped, calendar.el does scope this
+
+(defvar org-agenda-undo-list nil
+ "List of undoable operations in the agenda since last refresh.")
+(defvar org-agenda-pending-undo-list nil
+ "In a series of undo commands, this is the list of remaining undo items.")
+
+(defcustom org-agenda-confirm-kill 1
+ "When set, remote killing from the agenda buffer needs confirmation.
+When t, a confirmation is always needed. When a number N, confirmation is
+only needed when the text to be killed contains more than N non-white lines."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (integer :tag "When more than N lines")))
+
+(defcustom org-agenda-compact-blocks nil
+ "Non-nil means make the block agenda more compact.
+This is done globally by leaving out lines like the agenda span
+name and week number or the separator lines."
+ :group 'org-agenda
+ :type 'boolean)
+
+(defcustom org-agenda-block-separator ?=
+ "The separator between blocks in the agenda.
+If this is a string, it will be used as the separator, with a newline added.
+If it is a character, it will be repeated to fill the window width.
+If nil the separator is disabled. In `org-agenda-custom-commands' this
+addresses the separator between the current and the previous block."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "Disabled" nil)
+ (character)
+ (string)))
+
+(defgroup org-agenda-export nil
+ "Options concerning exporting agenda views in Org-mode."
+ :tag "Org Agenda Export"
+ :group 'org-agenda)
+
+(defcustom org-agenda-with-colors t
+ "Non-nil means use colors in agenda views."
+ :group 'org-agenda-export
+ :type 'boolean)
+
+(defcustom org-agenda-exporter-settings nil
+ "Alist of variable/value pairs that should be active during agenda export.
+This is a good place to set options for ps-print and for htmlize.
+Note that the way this is implemented, the values will be evaluated
+before assigned to the variables. So make sure to quote values you do
+*not* want evaluated, for example
+
+ (setq org-agenda-exporter-settings
+ '((ps-print-color-p 'black-white)))"
+ :group 'org-agenda-export
+ :type '(repeat
+ (list
+ (variable)
+ (sexp :tag "Value"))))
+
+(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
+ "Hook run in a temporary buffer before writing the agenda to an export file.
+A useful function for this hook is `org-agenda-add-entry-text'."
+ :group 'org-agenda-export
+ :type 'hook
+ :options '(org-agenda-add-entry-text))
+
+(defcustom org-agenda-add-entry-text-maxlines 0
+ "Maximum number of entry text lines to be added to agenda.
+This is only relevant when `org-agenda-add-entry-text' is part of
+`org-agenda-before-write-hook', which is the default.
+When this is 0, nothing will happen. When it is greater than 0, it
+specifies the maximum number of lines that will be added for each entry
+that is listed in the agenda view.
+
+Note that this variable is not used during display, only when exporting
+the agenda. For agenda display, see the variables `org-agenda-entry-text-mode'
+and `org-agenda-entry-text-maxlines'."
+ :group 'org-agenda
+ :type 'integer)
+
+(defcustom org-agenda-add-entry-text-descriptive-links t
+ "Non-nil means export org-links as descriptive links in agenda added text.
+This variable applies to the text added to the agenda when
+`org-agenda-add-entry-text-maxlines' is larger than 0.
+When this variable nil, the URL will (also) be shown."
+ :group 'org-agenda
+ :type 'boolean)
+
+(defcustom org-agenda-export-html-style nil
+ "The style specification for exported HTML Agenda files.
+If this variable contains a string, it will replace the default <style>
+section as produced by `htmlize'.
+Since there are different ways of setting style information, this variable
+needs to contain the full HTML structure to provide a style, including the
+surrounding HTML tags. The style specifications should include definitions
+the fonts used by the agenda, here is an example:
+
+ <style type=\"text/css\">
+ p { font-weight: normal; color: gray; }
+ .org-agenda-structure {
+ font-size: 110%;
+ color: #003399;
+ font-weight: 600;
+ }
+ .org-todo {
+ color: #cc6666;
+ font-weight: bold;
+ }
+ .org-agenda-done {
+ color: #339933;
+ }
+ .org-done {
+ color: #339933;
+ }
+ .title { text-align: center; }
+ .todo, .deadline { color: red; }
+ .done { color: green; }
+ </style>
+
+or, if you want to keep the style in a file,
+
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
+
+As the value of this option simply gets inserted into the HTML <head> header,
+you can \"misuse\" it to also add other text to the header."
+ :group 'org-agenda-export
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-agenda-persistent-filter nil
+ "When set, keep filters from one agenda view to the next."
+ :group 'org-agenda
+ :type 'boolean)
+
+(defgroup org-agenda-custom-commands nil
+ "Options concerning agenda views in Org-mode."
+ :tag "Org Agenda Custom Commands"
+ :group 'org-agenda)
+
+(defconst org-sorting-choice
+ '(choice
+ (const time-up) (const time-down)
+ (const category-keep) (const category-up) (const category-down)
+ (const tag-down) (const tag-up)
+ (const priority-up) (const priority-down)
+ (const todo-state-up) (const todo-state-down)
+ (const effort-up) (const effort-down)
+ (const habit-up) (const habit-down)
+ (const alpha-up) (const alpha-down)
+ (const user-defined-up) (const user-defined-down))
+ "Sorting choices.")
+
+;; Keep custom values for `org-agenda-filter-preset' compatible with
+;; the new variable `org-agenda-tag-filter-preset'.
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+ (defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
+
+(defconst org-agenda-custom-commands-local-options
+ `(repeat :tag "Local settings for this command. Remember to quote values"
+ (choice :tag "Setting"
+ (list :tag "Heading for this block"
+ (const org-agenda-overriding-header)
+ (string :tag "Headline"))
+ (list :tag "Files to be searched"
+ (const org-agenda-files)
+ (list
+ (const :format "" quote)
+ (repeat (file))))
+ (list :tag "Sorting strategy"
+ (const org-agenda-sorting-strategy)
+ (list
+ (const :format "" quote)
+ (repeat
+ ,org-sorting-choice)))
+ (list :tag "Prefix format"
+ (const org-agenda-prefix-format :value " %-12:c%?-12t% s")
+ (string))
+ (list :tag "Number of days in agenda"
+ (const org-agenda-span)
+ (choice (const :tag "Day" 'day)
+ (const :tag "Week" 'week)
+ (const :tag "Month" 'month)
+ (const :tag "Year" 'year)
+ (integer :tag "Custom")))
+ (list :tag "Fixed starting date"
+ (const org-agenda-start-day)
+ (string :value "2007-11-01"))
+ (list :tag "Start on day of week"
+ (const org-agenda-start-on-weekday)
+ (choice :value 1
+ (const :tag "Today" nil)
+ (integer :tag "Weekday No.")))
+ (list :tag "Include data from diary"
+ (const org-agenda-include-diary)
+ (boolean))
+ (list :tag "Deadline Warning days"
+ (const org-deadline-warning-days)
+ (integer :value 1))
+ (list :tag "Category filter preset"
+ (const org-agenda-category-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+category or -category"))))
+ (list :tag "Tags filter preset"
+ (const org-agenda-tag-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+tag or -tag"))))
+ (list :tag "Set daily/weekly entry types"
+ (const org-agenda-entry-types)
+ (list
+ (const :format "" quote)
+ (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
+ (const :deadline)
+ (const :scheduled)
+ (const :timestamp)
+ (const :sexp))))
+ (list :tag "Standard skipping condition"
+ :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
+ (const org-agenda-skip-function)
+ (list
+ (const :format "" quote)
+ (list
+ (choice
+ :tag "Skipping range"
+ (const :tag "Skip entry" org-agenda-skip-entry-if)
+ (const :tag "Skip subtree" org-agenda-skip-subtree-if))
+ (repeat :inline t :tag "Conditions for skipping"
+ (choice
+ :tag "Condition type"
+ (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
+ (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+ (list :tag "TODO state is" :inline t
+ (const 'todo)
+ (choice
+ (const :tag "any not-done state" 'todo)
+ (const :tag "any done state" 'done)
+ (const :tag "any state" 'any)
+ (list :tag "Keyword list"
+ (const :format "" quote)
+ (repeat (string :tag "Keyword")))))
+ (list :tag "TODO state is not" :inline t
+ (const 'nottodo)
+ (choice
+ (const :tag "any not-done state" 'todo)
+ (const :tag "any done state" 'done)
+ (const :tag "any state" 'any)
+ (list :tag "Keyword list"
+ (const :format "" quote)
+ (repeat (string :tag "Keyword")))))
+ (const :tag "scheduled" 'scheduled)
+ (const :tag "not scheduled" 'notscheduled)
+ (const :tag "deadline" 'deadline)
+ (const :tag "no deadline" 'notdeadline)
+ (const :tag "timestamp" 'timestamp)
+ (const :tag "no timestamp" 'nottimestamp))))))
+ (list :tag "Non-standard skipping condition"
+ :value (org-agenda-skip-function)
+ (const org-agenda-skip-function)
+ (sexp :tag "Function or form (quoted!)"))
+ (list :tag "Any variable"
+ (variable :tag "Variable")
+ (sexp :tag "Value (sexp)"))))
+ "Selection of examples for agenda command settings.
+This will be spliced into the custom type of
+`org-agenda-custom-commands'.")
+
+
+(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's"
+ ((agenda "") (alltodo))))
+ "Custom commands for the agenda.
+These commands will be offered on the splash screen displayed by the
+agenda dispatcher \\[org-agenda]. Each entry is a list like this:
+
+ (key desc type match settings files)
+
+key The key (one or more characters as a string) to be associated
+ with the command.
+desc A description of the command, when omitted or nil, a default
+ description is built using MATCH.
+type The command type, any of the following symbols:
+ agenda The daily/weekly agenda.
+ todo Entries with a specific TODO keyword, in all agenda files.
+ search Entries containing search words entry or headline.
+ tags Tags/Property/TODO match in all agenda files.
+ tags-todo Tags/P/T match in all agenda files, TODO entries only.
+ todo-tree Sparse tree of specific TODO keyword in *current* file.
+ tags-tree Sparse tree with all tags matches in *current* file.
+ occur-tree Occur sparse tree for *current* file.
+ ... A user-defined function.
+match What to search for:
+ - a single keyword for TODO keyword searches
+ - a tags match expression for tags searches
+ - a word search expression for text searches.
+ - a regular expression for occur searches
+ For all other commands, this should be the empty string.
+settings A list of option settings, similar to that in a let form, so like
+ this: ((opt1 val1) (opt2 val2) ...). The values will be
+ evaluated at the moment of execution, so quote them when needed.
+files A list of files file to write the produced agenda buffer to
+ with the command `org-store-agenda-views'.
+ If a file name ends in \".html\", an HTML version of the buffer
+ is written out. If it ends in \".ps\", a postscript version is
+ produced. Otherwise, only the plain text is written to the file.
+
+You can also define a set of commands, to create a composite agenda buffer.
+In this case, an entry looks like this:
+
+ (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
+
+where
+
+desc A description string to be displayed in the dispatcher menu.
+cmd An agenda command, similar to the above. However, tree commands
+ are not allowed, but instead you can get agenda and global todo list.
+ So valid commands for a set are:
+ (agenda \"\" settings)
+ (alltodo \"\" settings)
+ (stuck \"\" settings)
+ (todo \"match\" settings files)
+ (search \"match\" settings files)
+ (tags \"match\" settings files)
+ (tags-todo \"match\" settings files)
+
+Each command can carry a list of options, and another set of options can be
+given for the whole set of commands. Individual command options take
+precedence over the general options.
+
+When using several characters as key to a command, the first characters
+are prefix commands. For the dispatcher to display useful information, you
+should provide a description for the prefix, like
+
+ (setq org-agenda-custom-commands
+ '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
+ (\"hl\" tags \"+HOME+Lisa\")
+ (\"hp\" tags \"+HOME+Peter\")
+ (\"hk\" tags \"+HOME+Kim\")))"
+ :group 'org-agenda-custom-commands
+ :type `(repeat
+ (choice :value ("x" "Describe command here" tags "" nil)
+ (list :tag "Single command"
+ (string :tag "Access Key(s) ")
+ (option (string :tag "Description"))
+ (choice
+ (const :tag "Agenda" agenda)
+ (const :tag "TODO list" alltodo)
+ (const :tag "Search words" search)
+ (const :tag "Stuck projects" stuck)
+ (const :tag "Tags/Property match (all agenda files)" tags)
+ (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
+ (const :tag "TODO keyword search (all agenda files)" todo)
+ (const :tag "Tags sparse tree (current buffer)" tags-tree)
+ (const :tag "TODO keyword tree (current buffer)" todo-tree)
+ (const :tag "Occur tree (current buffer)" occur-tree)
+ (sexp :tag "Other, user-defined function"))
+ (string :tag "Match (only for some commands)")
+ ,org-agenda-custom-commands-local-options
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (list :tag "Command series, all agenda files"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")
+ (repeat :tag "Component"
+ (choice
+ (list :tag "Agenda"
+ (const :format "" agenda)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "TODO list (all keywords)"
+ (const :format "" alltodo)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Search words"
+ (const :format "" search)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Stuck projects"
+ (const :format "" stuck)
+ (const :tag "" :format "" "")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Tags search"
+ (const :format "" tags)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Tags search, TODO entries only"
+ (const :format "" tags-todo)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "TODO keyword search"
+ (const :format "" todo)
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)
+ (list :tag "Other, user-defined function"
+ (symbol :tag "function")
+ (string :tag "Match")
+ ,org-agenda-custom-commands-local-options)))
+
+ (repeat :tag "Settings for entire command set"
+ (list (variable :tag "Any variable")
+ (sexp :tag "Value")))
+ (option (repeat :tag "Export" (file :tag "Export to"))))
+ (cons :tag "Prefix key documentation"
+ (string :tag "Access Key(s)")
+ (string :tag "Description ")))))
+
+(defcustom org-agenda-query-register ?o
+ "The register holding the current query string.
+The purpose of this is that if you construct a query string interactively,
+you can then use it to define a custom command."
+ :group 'org-agenda-custom-commands
+ :type 'character)
+
+(defcustom org-stuck-projects
+ '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
+ "How to identify stuck projects.
+This is a list of four items:
+1. A tags/todo/property matcher string that is used to identify a project.
+ See the manual for a description of tag and property searches.
+ The entire tree below a headline matched by this is considered one project.
+2. A list of TODO keywords identifying non-stuck projects.
+ If the project subtree contains any headline with one of these todo
+ keywords, the project is considered to be not stuck. If you specify
+ \"*\" as a keyword, any TODO keyword will mark the project unstuck.
+3. A list of tags identifying non-stuck projects.
+ If the project subtree contains any headline with one of these tags,
+ the project is considered to be not stuck. If you specify \"*\" as
+ a tag, any tag will mark the project unstuck. Note that this is about
+ the explicit presence of a tag somewhere in the subtree, inherited
+ tags to not count here. If inherited tags make a project not stuck,
+ use \"-TAG\" in the tags part of the matcher under (1.) above.
+4. An arbitrary regular expression matching non-stuck projects.
+
+If the project turns out to be not stuck, search continues also in the
+subtree to see if any of the subtasks have project status.
+
+See also the variable `org-tags-match-list-sublevels' which applies
+to projects matched by this search as well.
+
+After defining this variable, you may use \\[org-agenda-list-stuck-projects]
+or `C-c a #' to produce the list."
+ :group 'org-agenda-custom-commands
+ :type '(list
+ (string :tag "Tags/TODO match to identify a project")
+ (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
+ (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
+ (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
+
+(defcustom org-agenda-filter-effort-default-operator "<"
+ "The default operator for effort estimate filtering.
+If you select an effort estimate limit without first pressing an operator,
+this one will be used."
+ :group 'org-agenda-custom-commands
+ :type '(choice (const :tag "less or equal" "<")
+ (const :tag "greater or equal"">")
+ (const :tag "equal" "=")))
+
+(defgroup org-agenda-skip nil
+ "Options concerning skipping parts of agenda files."
+ :tag "Org Agenda Skip"
+ :group 'org-agenda)
+
+(defcustom org-agenda-skip-function-global nil
+ "Function to be called at each match during agenda construction.
+If this function returns nil, the current match should not be skipped.
+If the function decided to skip an agenda match, is must return the
+buffer position from which the search should be continued.
+This may also be a Lisp form, which will be evaluated.
+
+This variable will be applied to every agenda match, including
+tags/property searches and TODO lists. So try to make the test function
+do its checking as efficiently as possible. To implement a skipping
+condition just for specific agenda commands, use the variable
+`org-agenda-skip-function' which can be set in the options section
+of custom agenda commands."
+ :group 'org-agenda-skip
+ :type 'sexp)
+
+(defgroup org-agenda-daily/weekly nil
+ "Options concerning the daily/weekly agenda."
+ :tag "Org Agenda Daily/Weekly"
+ :group 'org-agenda)
+(defgroup org-agenda-todo-list nil
+ "Options concerning the global todo list agenda view."
+ :tag "Org Agenda Todo List"
+ :group 'org-agenda)
+(defgroup org-agenda-match-view nil
+ "Options concerning the general tags/property/todo match agenda view."
+ :tag "Org Agenda Match View"
+ :group 'org-agenda)
+(defgroup org-agenda-search-view nil
+ "Options concerning the general tags/property/todo match agenda view."
+ :tag "Org Agenda Match View"
+ :group 'org-agenda)
+
+(defvar org-agenda-archives-mode nil
+ "Non-nil means the agenda will include archived items.
+If this is the symbol `trees', trees in the selected agenda scope
+that are marked with the ARCHIVE tag will be included anyway. When this is
+t, also all archive files associated with the current selection of agenda
+files will be included.")
+
+(defcustom org-agenda-skip-comment-trees t
+ "Non-nil means skip trees that start with the COMMENT keyword.
+When nil, these trees are also scanned by agenda commands."
+ :group 'org-agenda-skip
+ :type 'boolean)
+
+(defcustom org-agenda-todo-list-sublevels t
+ "Non-nil means check also the sublevels of a TODO entry for TODO entries.
+When nil, the sublevels of a TODO entry are not checked, resulting in
+potentially much shorter TODO lists."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :type 'boolean)
+
+(defcustom org-agenda-todo-ignore-with-date nil
+ "Non-nil means don't show entries with a date in the global todo list.
+You can use this if you prefer to mark mere appointments with a TODO keyword,
+but don't want them to show up in the TODO list.
+When this is set, it also covers deadlines and scheduled items, the settings
+of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
+will be ignored.
+See also the variable `org-agenda-tags-todo-honor-ignore-options'."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :type 'boolean)
+
+(defcustom org-agenda-todo-ignore-timestamp nil
+ "Non-nil means don't show entries with a timestamp.
+This applies when creating the global todo list.
+Valid values are:
+
+past Don't show entries for today or in the past.
+
+future Don't show entries with a timestamp in the future.
+ The idea behind this is that if it has a future
+ timestamp, you don't want to think about it until the
+ date.
+
+all Don't show any entries with a timestamp in the global todo list.
+ The idea behind this is that by setting a timestamp, you
+ have already \"taken care\" of this item.
+
+This variable can also have an integer as a value. If positive (N),
+todos with a timestamp N or more days in the future will be ignored. If
+negative (-N), todos with a timestamp N or more days in the past will be
+ignored. If 0, todos with a timestamp either today or in the future will
+be ignored. For example, a value of -1 will exclude todos with a
+timestamp in the past (yesterday or earlier), while a value of 7 will
+exclude todos with a timestamp a week or more in the future.
+
+See also `org-agenda-todo-ignore-with-date'.
+See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
+to make his option also apply to the tags-todo list."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :version "24.1"
+ :type '(choice
+ (const :tag "Ignore future timestamp todos" future)
+ (const :tag "Ignore past or present timestamp todos" past)
+ (const :tag "Ignore all timestamp todos" all)
+ (const :tag "Show timestamp todos" nil)
+ (integer :tag "Ignore if N or more days in past(-) or future(+).")))
+
+(defcustom org-agenda-todo-ignore-scheduled nil
+ "Non-nil means, ignore some scheduled TODO items when making TODO list.
+This applies when creating the global todo list.
+Valid values are:
+
+past Don't show entries scheduled today or in the past.
+
+future Don't show entries scheduled in the future.
+ The idea behind this is that by scheduling it, you don't want to
+ think about it until the scheduled date.
+
+all Don't show any scheduled entries in the global todo list.
+ The idea behind this is that by scheduling it, you have already
+ \"taken care\" of this item.
+
+t Same as `all', for backward compatibility.
+
+This variable can also have an integer as a value. See
+`org-agenda-todo-ignore-timestamp' for more details.
+
+See also `org-agenda-todo-ignore-with-date'.
+See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
+to make his option also apply to the tags-todo list."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :type '(choice
+ (const :tag "Ignore future-scheduled todos" future)
+ (const :tag "Ignore past- or present-scheduled todos" past)
+ (const :tag "Ignore all scheduled todos" all)
+ (const :tag "Ignore all scheduled todos (compatibility)" t)
+ (const :tag "Show scheduled todos" nil)
+ (integer :tag "Ignore if N or more days in past(-) or future(+).")))
+
+(defcustom org-agenda-todo-ignore-deadlines nil
+ "Non-nil means ignore some deadlined TODO items when making TODO list.
+There are different motivations for using different values, please think
+carefully when configuring this variable.
+
+This applies when creating the global todo list.
+Valid values are:
+
+near Don't show near deadline entries. A deadline is near when it is
+ closer than `org-deadline-warning-days' days. The idea behind this
+ is that such items will appear in the agenda anyway.
+
+far Don't show TODO entries where a deadline has been defined, but
+ the deadline is not near. This is useful if you don't want to
+ use the todo list to figure out what to do now.
+
+past Don't show entries with a deadline timestamp for today or in the past.
+
+future Don't show entries with a deadline timestamp in the future, not even
+ when they become `near' ones. Use it with caution.
+
+all Ignore all TODO entries that do have a deadline.
+
+t Same as `near', for backward compatibility.
+
+This variable can also have an integer as a value. See
+`org-agenda-todo-ignore-timestamp' for more details.
+
+See also `org-agenda-todo-ignore-with-date'.
+See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
+to make his option also apply to the tags-todo list."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :type '(choice
+ (const :tag "Ignore near deadlines" near)
+ (const :tag "Ignore near deadlines (compatibility)" t)
+ (const :tag "Ignore far deadlines" far)
+ (const :tag "Ignore all TODOs with a deadlines" all)
+ (const :tag "Show all TODOs, even if they have a deadline" nil)
+ (integer :tag "Ignore if N or more days in past(-) or future(+).")))
+
+(defcustom org-agenda-tags-todo-honor-ignore-options nil
+ "Non-nil means honor todo-list ...ignore options also in tags-todo search.
+The variables
+ `org-agenda-todo-ignore-with-date',
+ `org-agenda-todo-ignore-timestamp',
+ `org-agenda-todo-ignore-scheduled',
+ `org-agenda-todo-ignore-deadlines'
+make the global TODO list skip entries that have time stamps of certain
+kinds. If this option is set, the same options will also apply for the
+tags-todo search, which is the general tags/property matcher
+restricted to unfinished TODO entries only."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :group 'org-agenda-match-view
+ :type 'boolean)
+
+(defcustom org-agenda-skip-scheduled-if-done nil
+ "Non-nil means don't show scheduled items in agenda when they are done.
+This is relevant for the daily/weekly agenda, not for the TODO list. And
+it applies only to the actual date of the scheduling. Warnings about
+an item with a past scheduling dates are always turned off when the item
+is DONE."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
+ "Non-nil means skip scheduling line if same entry shows because of deadline.
+In the agenda of today, an entry can show up multiple times because
+it is both scheduled and has a nearby deadline, and maybe a plain time
+stamp as well.
+When this variable is t, then only the deadline is shown and the fact that
+the entry is scheduled today or was scheduled previously is not shown.
+When this variable is nil, the entry will be shown several times. When
+the variable is the symbol `not-today', then skip scheduled previously,
+but not scheduled today."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Not when scheduled today" not-today)))
+
+(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
+ "Non-nil means skip timestamp line if same entry shows because of deadline.
+In the agenda of today, an entry can show up multiple times
+because it has both a plain timestamp and has a nearby deadline.
+When this variable is t, then only the deadline is shown and the
+fact that the entry has a timestamp for or including today is not
+shown. When this variable is nil, the entry will be shown
+several times."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)))
+
+(defcustom org-agenda-skip-deadline-if-done nil
+ "Non-nil means don't show deadlines when the corresponding item is done.
+When nil, the deadline is still shown and should give you a happy feeling.
+This is relevant for the daily/weekly agenda. And it applied only to the
+actually date of the deadline. Warnings about approaching and past-due
+deadlines are always turned off when the item is DONE."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
+ "Non-nil means skip deadline prewarning when entry is also scheduled.
+This will apply on all days where a prewarning for the deadline would
+be shown, but not at the day when the entry is actually due. On that day,
+the deadline will be shown anyway.
+This variable may be set to nil, t, or a number which will then give
+the number of days before the actual deadline when the prewarnings
+should resume.
+This can be used in a workflow where the first showing of the deadline will
+trigger you to schedule it, and then you don't want to be reminded of it
+because you will take care of it on the day when scheduled."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type '(choice
+ (const :tag "Alwas show prewarning" nil)
+ (const :tag "Remove prewarning if entry is scheduled" t)
+ (integer :tag "Restart prewarning N days before deadline")))
+
+(defcustom org-agenda-skip-additional-timestamps-same-entry nil
+ "When nil, multiple same-day timestamps in entry make multiple agenda lines.
+When non-nil, after the search for timestamps has matched once in an
+entry, the rest of the entry will not be searched."
+ :group 'org-agenda-skip
+ :type 'boolean)
+
+(defcustom org-agenda-skip-timestamp-if-done nil
+ "Non-nil means don't select item by timestamp or -range if it is DONE."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-dim-blocked-tasks t
+ "Non-nil means dim blocked tasks in the agenda display.
+This causes some overhead during agenda construction, but if you
+have turned on `org-enforce-todo-dependencies',
+`org-enforce-todo-checkbox-dependencies', or any other blocking
+mechanism, this will create useful feedback in the agenda.
+
+Instead of t, this variable can also have the value `invisible'.
+Then blocked tasks will be invisible and only become visible when
+they become unblocked. An exemption to this behavior is when a task is
+blocked because of unchecked checkboxes below it. Since checkboxes do
+not show up in the agenda views, making this task invisible you remove any
+trace from agenda views that there is something to do. Therefore, a task
+that is blocked because of checkboxes will never be made invisible, it
+will only be dimmed."
+ :group 'org-agenda-daily/weekly
+ :group 'org-agenda-todo-list
+ :type '(choice
+ (const :tag "Do not dim" nil)
+ (const :tag "Dim to a gray face" t)
+ (const :tag "Make invisible" invisible)))
+
+(defcustom org-timeline-show-empty-dates 3
+ "Non-nil means `org-timeline' also shows dates without an entry.
+When nil, only the days which actually have entries are shown.
+When t, all days between the first and the last date are shown.
+When an integer, show also empty dates, but if there is a gap of more than
+N days, just insert a special line indicating the size of the gap."
+ :group 'org-agenda-skip
+ :type '(choice
+ (const :tag "None" nil)
+ (const :tag "All" t)
+ (integer :tag "at most")))
+
+(defgroup org-agenda-startup nil
+ "Options concerning initial settings in the Agenda in Org Mode."
+ :tag "Org Agenda Startup"
+ :group 'org-agenda)
+
+(defcustom org-agenda-menu-show-matcher t
+ "Non-nil means show the match string in the agenda dispatcher menu.
+When nil, the matcher string is not shown, but is put into the help-echo
+property so than moving the mouse over the command shows it.
+Setting it to nil is good if matcher strings are very long and/or if
+you want to use two-columns display (see `org-agenda-menu-two-columns')."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3")
+
+(defcustom org-agenda-menu-two-columns nil
+ "Non-nil means, use two columns to show custom commands in the dispatcher.
+If you use this, you probably want to set `org-agenda-menu-show-matcher'
+to nil."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3")
+(defcustom org-agenda-finalize-hook nil
+ "Hook run just before displaying an agenda buffer.
+The buffer is still writable when the hook is called.
+
+You can modify some of the buffer substrings but you should be
+extra careful not to modify the text properties of the agenda
+headlines as the agenda display heavily relies on them."
+ :group 'org-agenda-startup
+ :type 'hook)
+
+(defcustom org-agenda-mouse-1-follows-link nil
+ "Non-nil means mouse-1 on a link will follow the link in the agenda.
+A longer mouse click will still set point. Does not work on XEmacs.
+Needs to be set before org.el is loaded."
+ :group 'org-agenda-startup
+ :type 'boolean)
+
+(defcustom org-agenda-start-with-follow-mode nil
+ "The initial value of follow mode in a newly created agenda window."
+ :group 'org-agenda-startup
+ :type 'boolean)
+
+(defcustom org-agenda-follow-indirect nil
+ "Non-nil means `org-agenda-follow-mode' displays only the
+current item's tree, in an indirect buffer."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-show-outline-path t
+ "Non-nil means show outline path in echo area after line motion."
+ :group 'org-agenda-startup
+ :type 'boolean)
+
+(defcustom org-agenda-start-with-entry-text-mode nil
+ "The initial value of entry-text-mode in a newly created agenda window."
+ :group 'org-agenda-startup
+ :type 'boolean)
+
+(defcustom org-agenda-entry-text-maxlines 5
+ "Number of text lines to be added when `E' is pressed in the agenda.
+
+Note that this variable only used during agenda display. Add add entry text
+when exporting the agenda, configure the variable
+`org-agenda-add-entry-ext-maxlines'."
+ :group 'org-agenda
+ :type 'integer)
+
+(defcustom org-agenda-entry-text-exclude-regexps nil
+ "List of regular expressions to clean up entry text.
+The complete matches of all regular expressions in this list will be
+removed from entry text before it is shown in the agenda."
+ :group 'org-agenda
+ :type '(repeat (regexp)))
+
+(defvar org-agenda-entry-text-cleanup-hook nil
+ "Hook that is run after basic cleanup of entry text to be shown in agenda.
+This cleanup is done in a temporary buffer, so the function may inspect and
+change the entire buffer.
+Some default stuff like drawers and scheduling/deadline dates will already
+have been removed when this is called, as will any matches for regular
+expressions listed in `org-agenda-entry-text-exclude-regexps'.")
+
+(defvar org-agenda-include-inactive-timestamps nil
+ "Non-nil means include inactive time stamps in agenda and timeline.
+Dynamically scoped.")
+
+(defgroup org-agenda-windows nil
+ "Options concerning the windows used by the Agenda in Org Mode."
+ :tag "Org Agenda Windows"
+ :group 'org-agenda)
+
+(defcustom org-agenda-window-setup 'reorganize-frame
+ "How the agenda buffer should be displayed.
+Possible values for this option are:
+
+current-window Show agenda in the current window, keeping all other windows.
+other-window Use `switch-to-buffer-other-window' to display agenda.
+reorganize-frame Show only two windows on the current frame, the current
+ window and the agenda.
+other-frame Use `switch-to-buffer-other-frame' to display agenda.
+ Also, when exiting the agenda, kill that frame.
+See also the variable `org-agenda-restore-windows-after-quit'."
+ :group 'org-agenda-windows
+ :type '(choice
+ (const current-window)
+ (const other-frame)
+ (const other-window)
+ (const reorganize-frame)))
+
+(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
+ "The min and max height of the agenda window as a fraction of frame height.
+The value of the variable is a cons cell with two numbers between 0 and 1.
+It only matters if `org-agenda-window-setup' is `reorganize-frame'."
+ :group 'org-agenda-windows
+ :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
+
+(defcustom org-agenda-restore-windows-after-quit nil
+ "Non-nil means restore window configuration upon exiting agenda.
+Before the window configuration is changed for displaying the agenda,
+the current status is recorded. When the agenda is exited with
+`q' or `x' and this option is set, the old state is restored. If
+`org-agenda-window-setup' is `other-frame', the value of this
+option will be ignored."
+ :group 'org-agenda-windows
+ :type 'boolean)
+
+(defcustom org-agenda-ndays nil
+ "Number of days to include in overview display.
+Should be 1 or 7.
+Obsolete, see `org-agenda-span'."
+ :group 'org-agenda-daily/weekly
+ :type 'integer)
+
+(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
+
+(defcustom org-agenda-span 'week
+ "Number of days to include in overview display.
+Can be day, week, month, year, or any number of days.
+Custom commands can set this variable in the options section."
+ :group 'org-agenda-daily/weekly
+ :type '(choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
+ (integer :tag "Custom")))
+
+(defcustom org-agenda-start-on-weekday 1
+ "Non-nil means start the overview always on the specified weekday.
+0 denotes Sunday, 1 denotes Monday etc.
+When nil, always start on the current day.
+Custom commands can set this variable in the options section."
+ :group 'org-agenda-daily/weekly
+ :type '(choice (const :tag "Today" nil)
+ (integer :tag "Weekday No.")))
+
+(defcustom org-agenda-show-all-dates t
+ "Non-nil means `org-agenda' shows every day in the selected range.
+When nil, only the days which actually have entries are shown."
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-format-date 'org-agenda-format-date-aligned
+ "Format string for displaying dates in the agenda.
+Used by the daily/weekly agenda and by the timeline. This should be
+a format string understood by `format-time-string', or a function returning
+the formatted date as a string. The function must take a single argument,
+a calendar-style date list like (month day year)."
+ :group 'org-agenda-daily/weekly
+ :type '(choice
+ (string :tag "Format string")
+ (function :tag "Function")))
+
+(defun org-agenda-format-date-aligned (date)
+ "Format a date string for display in the daily/weekly agenda, or timeline.
+This function makes sure that dates are aligned for easy reading."
+ (require 'cal-iso)
+ (let* ((dayname (calendar-day-name date))
+ (day (cadr date))
+ (day-of-week (calendar-day-of-week date))
+ (month (car date))
+ (monthname (calendar-month-name month))
+ (year (nth 2 date))
+ (iso-week (org-days-to-iso-week
+ (calendar-absolute-from-gregorian date)))
+ (weekyear (cond ((and (= month 1) (>= iso-week 52))
+ (1- year))
+ ((and (= month 12) (<= iso-week 1))
+ (1+ year))
+ (t year)))
+ (weekstring (if (= day-of-week 1)
+ (format " W%02d" iso-week)
+ "")))
+ (format "%-10s %2d %s %4d%s"
+ dayname day monthname year weekstring)))
+
+(defcustom org-agenda-time-leading-zero nil
+ "Non-nil means use leading zero for military times in agenda.
+For example, 9:30am would become 09:30 rather than 9:30."
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-timegrid-use-ampm nil
+ "When set, show AM/PM style timestamps on the timegrid."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(defun org-agenda-time-of-day-to-ampm (time)
+ "Convert TIME of a string like '13:45' to an AM/PM style time string."
+ (let* ((hour-number (string-to-number (substring time 0 -3)))
+ (minute (substring time -2))
+ (ampm "am"))
+ (cond
+ ((equal hour-number 12)
+ (setq ampm "pm"))
+ ((> hour-number 12)
+ (setq ampm "pm")
+ (setq hour-number (- hour-number 12))))
+ (concat
+ (if org-agenda-time-leading-zero
+ (format "%02d" hour-number)
+ (format "%02s" (number-to-string hour-number)))
+ ":" minute ampm)))
+
+(defun org-agenda-time-of-day-to-ampm-maybe (time)
+ "Conditionally convert TIME to AM/PM format
+based on `org-agenda-timegrid-use-ampm'"
+ (if org-agenda-timegrid-use-ampm
+ (org-agenda-time-of-day-to-ampm time)
+ time))
+
+(defcustom org-agenda-weekend-days '(6 0)
+ "Which days are weekend?
+These days get the special face `org-agenda-date-weekend' in the agenda
+and timeline buffers."
+ :group 'org-agenda-daily/weekly
+ :type '(set :greedy t
+ (const :tag "Monday" 1)
+ (const :tag "Tuesday" 2)
+ (const :tag "Wednesday" 3)
+ (const :tag "Thursday" 4)
+ (const :tag "Friday" 5)
+ (const :tag "Saturday" 6)
+ (const :tag "Sunday" 0)))
+
+(defcustom org-agenda-move-date-from-past-immediately-to-today t
+ "Non-nil means jump to today when moving a past date forward in time.
+When using S-right in the agenda to move a a date forward, and the date
+stamp currently points to the past, the first key press will move it
+to today. WHen nil, just move one day forward even if the date stays
+in the past."
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-include-diary nil
+ "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
+Custom commands can set this variable in the options section."
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-include-deadlines t
+ "If non-nil, include entries within their deadline warning period.
+Custom commands can set this variable in the options section."
+ :group 'org-agenda-daily/weekly
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-repeating-timestamp-show-all t
+ "Non-nil means show all occurrences of a repeating stamp in the agenda.
+When set to a list of strings, only show occurrences of repeating
+stamps for these TODO keywords. When nil, only one occurrence is
+shown, either today or the nearest into the future."
+ :group 'org-agenda-daily/weekly
+ :type '(choice
+ (const :tag "Show repeating stamps" t)
+ (repeat :tag "Show repeating stamps for these TODO keywords"
+ (string :tag "TODO Keyword"))
+ (const :tag "Don't show repeating stamps" nil)))
+
+(defcustom org-scheduled-past-days 10000
+ "No. of days to continue listing scheduled items that are not marked DONE.
+When an item is scheduled on a date, it shows up in the agenda on this
+day and will be listed until it is marked done for the number of days
+given here."
+ :group 'org-agenda-daily/weekly
+ :type 'integer)
+
+(defcustom org-agenda-log-mode-items '(closed clock)
+ "List of items that should be shown in agenda log mode.
+This list may contain the following symbols:
+
+ closed Show entries that have been closed on that day.
+ clock Show entries that have received clocked time on that day.
+ state Show all logged state changes.
+Note that instead of changing this variable, you can also press `C-u l' in
+the agenda to display all available LOG items temporarily."
+ :group 'org-agenda-daily/weekly
+ :type '(set :greedy t (const closed) (const clock) (const state)))
+
+(defcustom org-agenda-clock-consistency-checks
+ '(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
+ :gap-ok-around ("4:00")
+ :default-face ((:background "DarkRed") (:foreground "white"))
+ :overlap-face nil :gap-face nil :no-end-time-face nil
+ :long-face nil :short-face nil)
+ "This is a property list, with the following keys:
+
+:max-duration Mark clocking chunks that are longer than this time.
+ This is a time string like \"HH:MM\", or the number
+ of minutes as an integer.
+
+:min-duration Mark clocking chunks that are shorter that this.
+ This is a time string like \"HH:MM\", or the number
+ of minutes as an integer.
+
+:max-gap Mark gaps between clocking chunks that are longer than
+ this duration. A number of minutes, or a string
+ like \"HH:MM\".
+
+:gap-ok-around List of times during the day which are usually not working
+ times. When a gap is detected, but the gap contains any
+ of these times, the gap is *not* reported. For example,
+ if this is (\"4:00\" \"13:00\") then gaps that contain
+ 4:00 in the morning (i.e. the night) and 13:00
+ (i.e. a typical lunch time) do not cause a warning.
+ You should have at least one time during the night in this
+ list, or otherwise the first task each morning will trigger
+ a warning because it follows a long gap.
+
+Furthermore, the following properties can be used to define faces for
+issue display.
+
+:default-face the default face, if the specific face is undefined
+:overlap-face face for overlapping clocks
+:gap-face face for gaps between clocks
+:no-end-time-face face for incomplete clocks
+:long-face face for clock intervals that are too long
+:short-face face for clock intervals that are too short"
+ :group 'org-agenda-daily/weekly
+ :group 'org-clock
+ :version "24.1"
+ :type 'plist)
+
+(defcustom org-agenda-log-mode-add-notes t
+ "Non-nil means add first line of notes to log entries in agenda views.
+If a log item like a state change or a clock entry is associated with
+notes, the first line of these notes will be added to the entry in the
+agenda display."
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-start-with-log-mode nil
+ "The initial value of log-mode in a newly created agenda window.
+See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
+explanations on the possible values."
+ :group 'org-agenda-startup
+ :group 'org-agenda-daily/weekly
+ :type '(choice (const :tag "Don't show log items" nil)
+ (const :tag "Show only log items" 'only)
+ (const :tag "Show all possible log items" 'clockcheck)
+ (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
+ (choice (const :tag "Show closed log items" 'closed)
+ (const :tag "Show clocked log items" 'clock)
+ (const :tag "Show all logged state changes" 'state)))))
+
+(defcustom org-agenda-start-with-clockreport-mode nil
+ "The initial value of clockreport-mode in a newly created agenda window."
+ :group 'org-agenda-startup
+ :group 'org-agenda-daily/weekly
+ :type 'boolean)
+
+(defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
+ "Property list with parameters for the clocktable in clockreport mode.
+This is the display mode that shows a clock table in the daily/weekly
+agenda, the properties for this dynamic block can be set here.
+The usual clocktable parameters are allowed here, but you cannot set
+the properties :name, :tstart, :tend, :block, and :scope - these will
+be overwritten to make sure the content accurately reflects the
+current display in the agenda."
+ :group 'org-agenda-daily/weekly
+ :type 'plist)
+
+(defcustom org-agenda-search-view-always-boolean nil
+ "Non-nil means the search string is interpreted as individual parts.
+
+The search string for search view can either be interpreted as a phrase,
+or as a list of snippets that define a boolean search for a number of
+strings.
+
+When this is non-nil, the string will be split on whitespace, and each
+snippet will be searched individually, and all must match in order to
+select an entry. A snippet is then a single string of non-white
+characters, or a string in double quotes, or a regexp in {} braces.
+If a snippet is preceded by \"-\", the snippet must *not* match.
+\"+\" is syntactic sugar for positive selection. Each snippet may
+be found as a full word or a partial word, but see the variable
+`org-agenda-search-view-force-full-words'.
+
+When this is nil, search will look for the entire search phrase as one,
+with each space character matching any amount of whitespace, including
+line breaks.
+
+Even when this is nil, you can still switch to Boolean search dynamically
+by preceding the first snippet with \"+\" or \"-\". If the first snippet
+is a regexp marked with braces like \"{abc}\", this will also switch to
+boolean search."
+ :group 'org-agenda-search-view
+ :version "24.1"
+ :type 'boolean)
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-search-view-search-words-only
+ 'org-agenda-search-view-always-boolean))
+
+(defcustom org-agenda-search-view-force-full-words nil
+ "Non-nil means, search words must be matches as complete words.
+When nil, they may also match part of a word."
+ :group 'org-agenda-search-view
+ :version "24.1"
+ :type 'boolean)
+
+(defgroup org-agenda-time-grid nil
+ "Options concerning the time grid in the Org-mode Agenda."
+ :tag "Org Agenda Time Grid"
+ :group 'org-agenda)
+
+(defcustom org-agenda-search-headline-for-time t
+ "Non-nil means search headline for a time-of-day.
+If the headline contains a time-of-day in one format or another, it will
+be used to sort the entry into the time sequence of items for a day.
+Some people have time stamps in the headline that refer to the creation
+time or so, and then this produces an unwanted side effect. If this is
+the case for your, use this variable to turn off searching the headline
+for a time."
+ :group 'org-agenda-time-grid
+ :type 'boolean)
+
+(defcustom org-agenda-use-time-grid t
+ "Non-nil means show a time grid in the agenda schedule.
+A time grid is a set of lines for specific times (like every two hours between
+8:00 and 20:00). The items scheduled for a day at specific times are
+sorted in between these lines.
+For details about when the grid will be shown, and what it will look like, see
+the variable `org-agenda-time-grid'."
+ :group 'org-agenda-time-grid
+ :type 'boolean)
+
+(defcustom org-agenda-time-grid
+ '((daily today require-timed)
+ "----------------"
+ (800 1000 1200 1400 1600 1800 2000))
+
+ "The settings for time grid for agenda display.
+This is a list of three items. The first item is again a list. It contains
+symbols specifying conditions when the grid should be displayed:
+
+ daily if the agenda shows a single day
+ weekly if the agenda shows an entire week
+ today show grid on current date, independent of daily/weekly display
+ require-timed show grid only if at least one item has a time specification
+
+The second item is a string which will be placed behind the grid time.
+
+The third item is a list of integers, indicating the times that should have
+a grid line."
+ :group 'org-agenda-time-grid
+ :type
+ '(list
+ (set :greedy t :tag "Grid Display Options"
+ (const :tag "Show grid in single day agenda display" daily)
+ (const :tag "Show grid in weekly agenda display" weekly)
+ (const :tag "Always show grid for today" today)
+ (const :tag "Show grid only if any timed entries are present"
+ require-timed)
+ (const :tag "Skip grid times already present in an entry"
+ remove-match))
+ (string :tag "Grid String")
+ (repeat :tag "Grid Times" (integer :tag "Time"))))
+
+(defcustom org-agenda-show-current-time-in-grid t
+ "Non-nil means show the current time in the time grid."
+ :group 'org-agenda-time-grid
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-current-time-string
+ "now - - - - - - - - - - - - - - - - - - - - - - - - -"
+ "The string for the current time marker in the agenda."
+ :group 'org-agenda-time-grid
+ :version "24.1"
+ :type 'string)
+
+(defgroup org-agenda-sorting nil
+ "Options concerning sorting in the Org-mode Agenda."
+ :tag "Org Agenda Sorting"
+ :group 'org-agenda)
+
+(defcustom org-agenda-sorting-strategy
+ '((agenda habit-down time-up priority-down category-keep)
+ (todo priority-down category-keep)
+ (tags priority-down category-keep)
+ (search category-keep))
+ "Sorting structure for the agenda items of a single day.
+This is a list of symbols which will be used in sequence to determine
+if an entry should be listed before another entry. The following
+symbols are recognized:
+
+time-up Put entries with time-of-day indications first, early first
+time-down Put entries with time-of-day indications first, late first
+category-keep Keep the default order of categories, corresponding to the
+ sequence in `org-agenda-files'.
+category-up Sort alphabetically by category, A-Z.
+category-down Sort alphabetically by category, Z-A.
+tag-up Sort alphabetically by last tag, A-Z.
+tag-down Sort alphabetically by last tag, Z-A.
+priority-up Sort numerically by priority, high priority last.
+priority-down Sort numerically by priority, high priority first.
+todo-state-up Sort by todo state, tasks that are done last.
+todo-state-down Sort by todo state, tasks that are done first.
+effort-up Sort numerically by estimated effort, high effort last.
+effort-down Sort numerically by estimated effort, high effort first.
+user-defined-up Sort according to `org-agenda-cmp-user-defined', high last.
+user-defined-down Sort according to `org-agenda-cmp-user-defined', high first.
+habit-up Put entries that are habits first
+habit-down Put entries that are habits last
+alpha-up Sort headlines alphabetically
+alpha-down Sort headlines alphabetically, reversed
+
+The different possibilities will be tried in sequence, and testing stops
+if one comparison returns a \"not-equal\". For example, the default
+ '(time-up category-keep priority-down)
+means: Pull out all entries having a specified time of day and sort them,
+in order to make a time schedule for the current day the first thing in the
+agenda listing for the day. Of the entries without a time indication, keep
+the grouped in categories, don't sort the categories, but keep them in
+the sequence given in `org-agenda-files'. Within each category sort by
+priority.
+
+Leaving out `category-keep' would mean that items will be sorted across
+categories by priority.
+
+Instead of a single list, this can also be a set of list for specific
+contents, with a context symbol in the car of the list, any of
+`agenda', `todo', `tags', `search' for the corresponding agenda views.
+
+Custom commands can bind this variable in the options section."
+ :group 'org-agenda-sorting
+ :type `(choice
+ (repeat :tag "General" ,org-sorting-choice)
+ (list :tag "Individually"
+ (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
+ (repeat ,org-sorting-choice))
+ (cons (const :tag "Strategy for TODO lists" todo)
+ (repeat ,org-sorting-choice))
+ (cons (const :tag "Strategy for Tags matches" tags)
+ (repeat ,org-sorting-choice))
+ (cons (const :tag "Strategy for search matches" search)
+ (repeat ,org-sorting-choice)))))
+
+(defcustom org-agenda-cmp-user-defined nil
+ "A function to define the comparison `user-defined'.
+This function must receive two arguments, agenda entry a and b.
+If a>b, return +1. If a<b, return -1. If they are equal as seen by
+the user comparison, return nil.
+When this is defined, you can make `user-defined-up' and `user-defined-down'
+part of an agenda sorting strategy."
+ :group 'org-agenda-sorting
+ :type 'symbol)
+
+(defcustom org-sort-agenda-notime-is-late t
+ "Non-nil means items without time are considered late.
+This is only relevant for sorting. When t, items which have no explicit
+time like 15:30 will be considered as 99:01, i.e. later than any items which
+do have a time. When nil, the default time is before 0:00. You can use this
+option to decide if the schedule for today should come before or after timeless
+agenda entries."
+ :group 'org-agenda-sorting
+ :type 'boolean)
+
+(defcustom org-sort-agenda-noeffort-is-high t
+ "Non-nil means items without effort estimate are sorted as high effort.
+This also applies when filtering an agenda view with respect to the
+< or > effort operator. Then, tasks with no effort defined will be treated
+as tasks with high effort.
+When nil, such items are sorted as 0 minutes effort."
+ :group 'org-agenda-sorting
+ :type 'boolean)
+
+(defgroup org-agenda-line-format nil
+ "Options concerning the entry prefix in the Org-mode agenda display."
+ :tag "Org Agenda Line Format"
+ :group 'org-agenda)
+
+(defcustom org-agenda-prefix-format
+ '((agenda . " %i %-12:c%?-12t% s")
+ (timeline . " % s")
+ (todo . " %i %-12:c")
+ (tags . " %i %-12:c")
+ (search . " %i %-12:c"))
+ "Format specifications for the prefix of items in the agenda views.
+An alist with five entries, each for the different agenda types. The
+keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
+The values are format strings.
+
+This format works similar to a printf format, with the following meaning:
+
+ %c the category of the item, \"Diary\" for entries from the diary,
+ or as given by the CATEGORY keyword or derived from the file name
+ %e the effort required by the item
+ %i the icon category of the item, see `org-agenda-category-icon-alist'
+ %T the last tag of the item (ignore inherited tags, which come first)
+ %t the HH:MM time-of-day specification if one applies to the entry
+ %s Scheduling/Deadline information, a short string
+ %(expression) Eval EXPRESSION and replace the control string
+ by the result
+
+All specifiers work basically like the standard `%s' of printf, but may
+contain two additional characters: a question mark just after the `%'
+and a whitespace/punctuation character just before the final letter.
+
+If the first character after `%' is a question mark, the entire field
+will only be included if the corresponding value applies to the current
+entry. This is useful for fields which should have fixed width when
+present, but zero width when absent. For example, \"%?-12t\" will
+result in a 12 character time field if a time of the day is specified,
+but will completely disappear in entries which do not contain a time.
+
+If there is punctuation or whitespace character just before the final
+format letter, this character will be appended to the field value if
+the value is not empty. For example, the format \"%-12:c\" leads to
+\"Diary: \" if the category is \"Diary\". If the category were be
+empty, no additional colon would be inserted.
+
+The default value for the agenda sublist is \" %-12:c%?-12t% s\",
+which means:
+
+- Indent the line with two space characters
+- Give the category a 12 chars wide field, padded with whitespace on
+ the right (because of `-'). Append a colon if there is a category
+ (because of `:').
+- If there is a time-of-day, put it into a 12 chars wide field. If no
+ time, don't put in an empty field, just skip it (because of '?').
+- Finally, put the scheduling information.
+
+See also the variables `org-agenda-remove-times-when-in-prefix' and
+`org-agenda-remove-tags'.
+
+Custom commands can set this variable in the options section."
+ :type '(choice
+ (string :tag "General format")
+ (list :greedy t :tag "View dependent"
+ (cons (const agenda) (string :tag "Format"))
+ (cons (const timeline) (string :tag "Format"))
+ (cons (const todo) (string :tag "Format"))
+ (cons (const tags) (string :tag "Format"))
+ (cons (const search) (string :tag "Format"))))
+ :group 'org-agenda-line-format)
+
+(defvar org-prefix-format-compiled nil
+ "The compiled prefix format and associated variables.
+This is a list where first element is a list of variable bindings, and second
+element is the compiled format expression. See the variable
+`org-agenda-prefix-format'.")
+
+(defcustom org-agenda-todo-keyword-format "%-1s"
+ "Format for the TODO keyword in agenda lines.
+Set this to something like \"%-12s\" if you want all TODO keywords
+to occupy a fixed space in the agenda display."
+ :group 'org-agenda-line-format
+ :type 'string)
+
+(defcustom org-agenda-diary-sexp-prefix nil
+ "A regexp that matches part of a diary sexp entry
+which should be treated as scheduling/deadline information in
+`org-agenda'.
+
+For example, you can use this to extract the `diary-remind-message' from
+`diary-remind' entries."
+ :group 'org-agenda-line-format
+ :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
+
+(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
+ "Text preceding timerange entries in the agenda view.
+This is a list with two strings. The first applies when the range
+is entirely on one day. The second applies if the range spans several days.
+The strings may have two \"%d\" format specifiers which will be filled
+with the sequence number of the days, and the total number of days in the
+range, respectively."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Deadline today ")
+ (choice :tag "Deadline relative"
+ (string :tag "Format string")
+ (function))))
+
+(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
+ "Text preceding scheduled items in the agenda view.
+This is a list with two strings. The first applies when the item is
+scheduled on the current day. The second applies when it has been scheduled
+previously, it may contain a %d indicating that this is the nth time that
+this item is scheduled, due to automatic rescheduling of unfinished items
+for the following day. So this number is one larger than the number of days
+that passed since this item was scheduled first."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Scheduled today ")
+ (string :tag "Scheduled previously")))
+
+(defcustom org-agenda-inactive-leader "["
+ "Text preceding item pulled into the agenda by inactive time stamps.
+These entries are added to the agenda when pressing \"[\"."
+ :group 'org-agenda-line-format
+ :version "24.1"
+ :type '(list
+ (string :tag "Scheduled today ")
+ (string :tag "Scheduled previously")))
+
+(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ")
+ "Text preceding deadline items in the agenda view.
+This is a list with two strings. The first applies when the item has its
+deadline on the current day. The second applies when it is in the past or
+in the future, it may contain %d to capture how many days away the deadline
+is (was)."
+ :group 'org-agenda-line-format
+ :type '(list
+ (string :tag "Deadline today ")
+ (choice :tag "Deadline relative"
+ (string :tag "Format string")
+ (function))))
+
+(defcustom org-agenda-remove-times-when-in-prefix t
+ "Non-nil means remove duplicate time specifications in agenda items.
+When the format `org-agenda-prefix-format' contains a `%t' specifier, a
+time-of-day specification in a headline or diary entry is extracted and
+placed into the prefix. If this option is non-nil, the original specification
+\(a timestamp or -range, or just a plain time(range) specification like
+11:30-4pm) will be removed for agenda display. This makes the agenda less
+cluttered.
+The option can be t or nil. It may also be the symbol `beg', indicating
+that the time should only be removed when it is located at the beginning of
+the headline/diary entry."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "When at beginning of entry" beg)))
+
+(defcustom org-agenda-remove-timeranges-from-blocks nil
+ "Non-nil means remove time ranges specifications in agenda
+items that span on several days."
+ :group 'org-agenda-line-format
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-default-appointment-duration nil
+ "Default duration for appointments that only have a starting time.
+When nil, no duration is specified in such cases.
+When non-nil, this must be the number of minutes, e.g. 60 for one hour."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (integer :tag "Minutes")
+ (const :tag "No default duration")))
+
+(defcustom org-agenda-show-inherited-tags t
+ "Non-nil means show inherited tags in each agenda line."
+ :group 'org-agenda-line-format
+ :type 'boolean)
+
+(defcustom org-agenda-hide-tags-regexp nil
+ "Regular expression used to filter away specific tags in agenda views.
+This means that these tags will be present, but not be shown in the agenda
+line. Secondary filtering will still work on the hidden tags.
+Nil means don't hide any tags."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Hide none" nil)
+ (string :tag "Regexp ")))
+
+(defcustom org-agenda-remove-tags nil
+ "Non-nil means remove the tags from the headline copy in the agenda.
+When this is the symbol `prefix', only remove tags when
+`org-agenda-prefix-format' contains a `%T' specifier."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "When prefix format contains %T" prefix)))
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-remove-tags-when-in-prefix
+ 'org-agenda-remove-tags))
+
+(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
+ "Shift tags in agenda items to this column.
+If this number is positive, it specifies the column. If it is negative,
+it means that the tags should be flushright to that column. For example,
+-80 works well for a normal 80 character screen."
+ :group 'org-agenda-line-format
+ :type 'integer)
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
+
+(defcustom org-agenda-fontify-priorities 'cookies
+ "Non-nil means highlight low and high priorities in agenda.
+When t, the highest priority entries are bold, lowest priority italic.
+However, settings in `org-priority-faces' will overrule these faces.
+When this variable is the symbol `cookies', only fontify the
+cookies, not the entire task.
+This may also be an association list of priority faces, whose
+keys are the character values of `org-highest-priority',
+`org-default-priority', and `org-lowest-priority' (the default values
+are ?A, ?B, and ?C, respectively). The face may be a named face, a
+color as a string, or a list like `(:background \"Red\")'.
+If it is a color, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
+ :group 'org-agenda-line-format
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Defaults" t)
+ (const :tag "Cookies only" cookies)
+ (repeat :tag "Specify"
+ (list (character :tag "Priority" :value ?A)
+ (choice :tag "Face "
+ (string :tag "Color")
+ (sexp :tag "Face"))))))
+
+(defcustom org-agenda-day-face-function nil
+ "Function called to determine what face should be used to display a day.
+The only argument passed to that function is the day. It should
+returns a face, or nil if does not want to specify a face and let
+the normal rules apply."
+ :group 'org-agenda-line-format
+ :version "24.1"
+ :type 'function)
+
+(defcustom org-agenda-category-icon-alist nil
+ "Alist of category icon to be displayed in agenda views.
+
+Each entry should have the following format:
+
+ (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
+
+Where CATEGORY-REGEXP is a regexp matching the categories where
+the icon should be displayed.
+FILE-OR-DATA either a file path or a string containing image data.
+
+The other fields can be omitted safely if not needed:
+TYPE indicates the image type.
+DATA-P is a boolean indicating whether the FILE-OR-DATA string is
+image data.
+PROPS are additional image attributes to assign to the image,
+like, e.g. `:ascent center'.
+
+ (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
+
+If you want to set the display properties yourself, just put a
+list as second element:
+
+ (CATEGORY-REGEXP (MY PROPERTY LIST))
+
+For example, to display a 16px horizontal space for Emacs
+category, you can use:
+
+ (\"Emacs\" '(space . (:width (16))))"
+ :group 'org-agenda-line-format
+ :version "24.1"
+ :type '(alist :key-type (string :tag "Regexp matching category")
+ :value-type (choice (list :tag "Icon"
+ (string :tag "File or data")
+ (symbol :tag "Type")
+ (boolean :tag "Data?")
+ (repeat :tag "Extra image properties" :inline t symbol))
+ (list :tag "Display properties" sexp))))
+
+(defgroup org-agenda-column-view nil
+ "Options concerning column view in the agenda."
+ :tag "Org Agenda Column View"
+ :group 'org-agenda)
+
+(defcustom org-agenda-columns-show-summaries t
+ "Non-nil means show summaries for columns displayed in the agenda view."
+ :group 'org-agenda-column-view
+ :type 'boolean)
+
+(defcustom org-agenda-columns-compute-summary-properties t
+ "Non-nil means recompute all summary properties before column view.
+When column view in the agenda is listing properties that have a summary
+operator, it can go to all relevant buffers and recompute the summaries
+there. This can mean overhead for the agenda column view, but is necessary
+to have thing up to date.
+As a special case, a CLOCKSUM property also makes sure that the clock
+computations are current."
+ :group 'org-agenda-column-view
+ :type 'boolean)
+
+(defcustom org-agenda-columns-add-appointments-to-effort-sum nil
+ "Non-nil means the duration of an appointment will add to day effort.
+The property to which appointment durations will be added is the one given
+in the option `org-effort-property'. If an appointment does not have
+an end time, `org-agenda-default-appointment-duration' will be used. If that
+is not set, an appointment without end time will not contribute to the time
+estimate."
+ :group 'org-agenda-column-view
+ :type 'boolean)
+
+(defcustom org-agenda-auto-exclude-function nil
+ "A function called with a tag to decide if it is filtered on '/ RET'.
+The sole argument to the function, which is called once for each
+possible tag, is a string giving the name of the tag. The
+function should return either nil if the tag should be included
+as normal, or \"-<TAG>\" to exclude the tag.
+Note that for the purpose of tag filtering, only the lower-case version of
+all tags will be considered, so that this function will only ever see
+the lower-case version of all tags."
+ :group 'org-agenda
+ :type 'function)
+
+(defcustom org-agenda-bulk-custom-functions nil
+ "Alist of characters and custom functions for bulk actions.
+For example, this value makes those two functions available:
+
+ '((?R set-category)
+ (?C bulk-cut))
+
+With selected entries in an agenda buffer, `B R' will call
+the custom function `set-category' on the selected entries.
+Note that functions in this alist don't need to be quoted."
+ :type 'alist
+ :version "24.1"
+ :group 'org-agenda)
+
+(defmacro org-agenda-with-point-at-orig-entry (string &rest body)
+ "Execute BODY with point at location given by `org-hd-marker' property.
+If STRING is non-nil, the text property will be fetched from position 0
+in that string. If STRING is nil, it will be fetched from the beginning
+of the current line."
+ (org-with-gensyms (marker)
+ `(let ((,marker (get-text-property (if string 0 (point-at-bol))
+ 'org-hd-marker ,string)))
+ (with-current-buffer (marker-buffer ,marker)
+ (save-excursion
+ (goto-char ,marker)
+ ,@body)))))
+(def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
+
+(defun org-add-agenda-custom-command (entry)
+ "Replace or add a command in `org-agenda-custom-commands'.
+This is mostly for hacking and trying a new command - once the command
+works you probably want to add it to `org-agenda-custom-commands' for good."
+ (let ((ass (assoc (car entry) org-agenda-custom-commands)))
+ (if ass
+ (setcdr ass (cdr entry))
+ (push entry org-agenda-custom-commands))))
+
+;;; Define the org-agenda-mode
+
+(defvar org-agenda-mode-map (make-sparse-keymap)
+ "Keymap for `org-agenda-mode'.")
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-keymap 'org-agenda-mode-map))
+
+(defvar org-agenda-menu) ; defined later in this file.
+(defvar org-agenda-restrict nil) ; defined later in this file.
+(defvar org-agenda-follow-mode nil)
+(defvar org-agenda-entry-text-mode nil)
+(defvar org-agenda-clockreport-mode nil)
+(defvar org-agenda-show-log nil)
+(defvar org-agenda-redo-command nil)
+(defvar org-agenda-query-string nil)
+(defvar org-agenda-mode-hook nil
+ "Hook run after `org-agenda-mode' is turned on.
+The buffer is still writable when this hook is called.")
+(defvar org-agenda-type nil)
+(defvar org-agenda-force-single-file nil)
+(defvar org-agenda-bulk-marked-entries nil
+ "List of markers that refer to marked entries in the agenda.")
+
+;;; Multiple agenda buffers support
+
+(defcustom org-agenda-sticky nil
+ "Non-nil means agenda q key will bury agenda buffers.
+Agenda commands will then show existing buffer instead of generating new ones.
+When nil, `q' will kill the single agenda buffer."
+ :group 'org-agenda
+ :version "24.3"
+ :type 'boolean)
+
+;;;###autoload
+(defun org-toggle-sticky-agenda (&optional arg)
+ "Toggle `org-agenda-sticky'."
+ (interactive "P")
+ (let ((new-value (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not org-agenda-sticky))))
+ (if (equal new-value org-agenda-sticky)
+ (and (org-called-interactively-p 'interactive)
+ (message "Sticky agenda was already %s"
+ (if org-agenda-sticky "enabled" "disabled")))
+ (setq org-agenda-sticky new-value)
+ (org-agenda-kill-all-agenda-buffers)
+ (and (org-called-interactively-p 'interactive)
+ (message "Sticky agenda was %s"
+ (if org-agenda-sticky "enabled" "disabled"))))))
+
+(defvar org-agenda-buffer nil
+ "Agenda buffer currently being generated.")
+
+(defvar org-agenda-last-prefix-arg nil)
+(defvar org-agenda-this-buffer-name nil)
+(defvar org-agenda-doing-sticky-redo nil)
+(defvar org-agenda-this-buffer-is-sticky nil)
+
+(defconst org-agenda-local-vars
+ '(org-agenda-this-buffer-name
+ org-agenda-undo-list
+ org-agenda-pending-undo-list
+ org-agenda-follow-mode
+ org-agenda-entry-text-mode
+ org-agenda-clockreport-mode
+ org-agenda-show-log
+ org-agenda-redo-command
+ org-agenda-query-string
+ org-agenda-type
+ org-agenda-bulk-marked-entries
+ org-agenda-undo-has-started-in
+ org-agenda-info
+ org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays
+ org-agenda-pre-window-conf
+ org-agenda-columns-active
+ org-agenda-tag-filter
+ org-agenda-category-filter
+ org-agenda-markers
+ org-agenda-last-search-view-search-was-boolean
+ org-agenda-filtered-by-category
+ org-agenda-filter-form
+ org-agenda-show-window
+ org-agenda-cycle-counter
+ org-agenda-last-prefix-arg)
+ "Variables that must be local in agenda buffers to allow multiple buffers.")
+
+(defun org-agenda-mode ()
+ "Mode for time-sorted view on action items in Org-mode files.
+
+The following commands are available:
+
+\\{org-agenda-mode-map}"
+ (interactive)
+ (cond (org-agenda-doing-sticky-redo
+ ;; Refreshing sticky agenda-buffer
+ ;;
+ ;; Preserve the value of `org-agenda-local-vars' variables,
+ ;; while letting `kill-all-local-variables' kill the rest
+ (let ((save (buffer-local-variables)))
+ (kill-all-local-variables)
+ (mapc 'make-local-variable org-agenda-local-vars)
+ (dolist (elem save)
+ (let ((var (car elem))
+ (val (cdr elem)))
+ (when (and val
+ (member var org-agenda-local-vars))
+ (set var val)))))
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (org-agenda-sticky
+ ;; Creating a sticky Agenda buffer for the first time
+ (kill-all-local-variables)
+ (mapc 'make-local-variable org-agenda-local-vars)
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (t
+ ;; Creating a non-sticky agenda buffer
+ (kill-all-local-variables)
+ (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil)))
+ (setq org-agenda-undo-list nil
+ org-agenda-pending-undo-list nil
+ org-agenda-bulk-marked-entries nil)
+ (setq major-mode 'org-agenda-mode)
+ ;; Keep global-font-lock-mode from turning on font-lock-mode
+ (org-set-local 'font-lock-global-modes (list 'not major-mode))
+ (setq mode-name "Org-Agenda")
+ (use-local-map org-agenda-mode-map)
+ (easy-menu-add org-agenda-menu)
+ (if org-startup-truncated (setq truncate-lines t))
+ (org-set-local 'line-move-visual nil)
+ (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
+ (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
+ ;; Make sure properties are removed when copying text
+ (make-local-variable 'filter-buffer-substring-functions)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (substring-no-properties (funcall fun start end delete))))
+ (unless org-agenda-keep-modes
+ (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
+ org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
+ org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
+ org-agenda-show-log org-agenda-start-with-log-mode))
+
+ (easy-menu-change
+ '("Agenda") "Agenda Files"
+ (append
+ (list
+ (vector
+ (if (get 'org-agenda-files 'org-restrict)
+ "Restricted to single file"
+ "Edit File List")
+ '(org-edit-agenda-file-list)
+ (not (get 'org-agenda-files 'org-restrict)))
+ "--")
+ (mapcar 'org-file-menu-entry (org-agenda-files))))
+ (org-agenda-set-mode-name)
+ (apply
+ (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
+ (list 'org-agenda-mode-hook)))
+
+(substitute-key-definition 'undo 'org-agenda-undo
+ org-agenda-mode-map global-map)
+(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto)
+(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto)
+(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
+(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
+(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
+(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
+(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
+(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
+(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
+(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all)
+(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
+(org-defkey org-agenda-mode-map "k" 'org-agenda-capture)
+(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
+(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
+(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag)
+(org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
+(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive)
+(org-defkey org-agenda-mode-map "$" 'org-agenda-archive)
+(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
+(org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up)
+(org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down)
+(org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
+(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
+(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset)
+(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
+(org-defkey org-agenda-mode-map "o" 'delete-other-windows)
+(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter)
+(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
+(org-defkey org-agenda-mode-map "t" 'org-agenda-todo)
+(org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation)
+(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
+(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
+(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
+(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
+(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
+(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
+(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
+(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
+(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
+(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
+(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
+
+(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
+(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
+(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
+(let ((l '(1 2 3 4 5 6 7 8 9 0)))
+ (while l (org-defkey org-agenda-mode-map
+ (int-to-string (pop l)) 'digit-argument)))
+
+(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
+(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
+(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
+(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
+(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
+(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
+(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
+(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
+(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
+(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t)))
+(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
+(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
+ 'org-clock-modify-effort-estimate)
+(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
+(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
+(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
+(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
+(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
+(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
+(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
+(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
+(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
+(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
+(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
+(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
+(substitute-key-definition 'next-line 'org-agenda-next-line
+ org-agenda-mode-map global-map)
+(substitute-key-definition 'previous-line 'org-agenda-previous-line
+ org-agenda-mode-map global-map)
+(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
+(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
+(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
+(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
+(org-defkey org-agenda-mode-map "," 'org-agenda-priority)
+(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
+(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
+(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
+(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
+(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
+(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
+(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
+(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
+(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
+(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
+(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
+(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
+(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
+(org-defkey org-agenda-mode-map "f" 'org-agenda-later)
+(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
+(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
+
+(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
+(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
+(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
+(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
+(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
+(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
+(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category)
+(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
+(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
+(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
+
+(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
+(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
+(when org-agenda-mouse-1-follows-link
+ (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
+(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
+ '("Agenda"
+ ("Agenda Files")
+ "--"
+ ("Agenda Dates"
+ ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
+ ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
+ ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
+ "--"
+ ("View"
+ ["Day View" org-agenda-day-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'day)
+ :keys "v d (or just d)"]
+ ["Week View" org-agenda-week-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'week)
+ :keys "v w (or just w)"]
+ ["Month View" org-agenda-month-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'month)
+ :keys "v m"]
+ ["Year View" org-agenda-year-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'year)
+ :keys "v y"]
+ "--"
+ ["Include Diary" org-agenda-toggle-diary
+ :style toggle :selected org-agenda-include-diary
+ :active (org-agenda-check-type nil 'agenda)]
+ ["Include Deadlines" org-agenda-toggle-deadlines
+ :style toggle :selected org-agenda-include-deadlines
+ :active (org-agenda-check-type nil 'agenda)]
+ ["Use Time Grid" org-agenda-toggle-time-grid
+ :style toggle :selected org-agenda-use-time-grid
+ :active (org-agenda-check-type nil 'agenda)]
+ "--"
+ ["Show clock report" org-agenda-clockreport-mode
+ :style toggle :selected org-agenda-clockreport-mode
+ :active (org-agenda-check-type nil 'agenda)]
+ ["Show some entry text" org-agenda-entry-text-mode
+ :style toggle :selected org-agenda-entry-text-mode
+ :active t]
+ "--"
+ ["Show Logbook entries" org-agenda-log-mode
+ :style toggle :selected org-agenda-show-log
+ :active (org-agenda-check-type nil 'agenda 'timeline)
+ :keys "v l (or just l)"]
+ ["Include archived trees" org-agenda-archives-mode
+ :style toggle :selected org-agenda-archives-mode :active t
+ :keys "v a"]
+ ["Include archive files" (org-agenda-archives-mode t)
+ :style toggle :selected (eq org-agenda-archives-mode t) :active t
+ :keys "v A"]
+ "--"
+ ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
+ ["Write view to file" org-agenda-write t]
+ ["Rebuild buffer" org-agenda-redo t]
+ ["Save all Org-mode Buffers" org-save-all-org-buffers t]
+ "--"
+ ["Show original entry" org-agenda-show t]
+ ["Go To (other window)" org-agenda-goto t]
+ ["Go To (this window)" org-agenda-switch-to t]
+ ["Capture with cursor date" org-agenda-capture t]
+ ["Follow Mode" org-agenda-follow-mode
+ :style toggle :selected org-agenda-follow-mode :active t]
+ ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
+ "--"
+ ("TODO"
+ ["Cycle TODO" org-agenda-todo t]
+ ["Next TODO set" org-agenda-todo-nextset t]
+ ["Previous TODO set" org-agenda-todo-previousset t]
+ ["Add note" org-agenda-add-note t])
+ ("Archive/Refile/Delete"
+ ["Archive default" org-agenda-archive-default t]
+ ["Archive default" org-agenda-archive-default-with-confirmation t]
+ ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
+ ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
+ ["Archive subtree" org-agenda-archive t]
+ "--"
+ ["Refile" org-agenda-refile t]
+ "--"
+ ["Delete subtree" org-agenda-kill t])
+ ("Bulk action"
+ ["Mark entry" org-agenda-bulk-mark t]
+ ["Mark all" org-agenda-bulk-mark-all t]
+ ["Mark matching regexp" org-agenda-bulk-mark-regexp t]
+ ["Unmark entry" org-agenda-bulk-unmark t]
+ ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"])
+ ["Act on all marked" org-agenda-bulk-action t]
+ "--"
+ ("Tags and Properties"
+ ["Show all Tags" org-agenda-show-tags t]
+ ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
+ ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
+ "--"
+ ["Column View" org-columns t])
+ ("Deadline/Schedule"
+ ["Schedule" org-agenda-schedule t]
+ ["Set Deadline" org-agenda-deadline t]
+ "--"
+ ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
+ ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
+ ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
+ ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
+ ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
+ ("Clock and Effort"
+ ["Clock in" org-agenda-clock-in t]
+ ["Clock out" org-agenda-clock-out t]
+ ["Clock cancel" org-agenda-clock-cancel t]
+ ["Goto running clock" org-clock-goto t]
+ "--"
+ ["Set Effort" org-agenda-set-effort t]
+ ["Change clocked effort" org-clock-modify-effort-estimate
+ (org-clock-is-active)])
+ ("Priority"
+ ["Set Priority" org-agenda-priority t]
+ ["Increase Priority" org-agenda-priority-up t]
+ ["Decrease Priority" org-agenda-priority-down t]
+ ["Show Priority" org-show-priority t])
+ ("Calendar/Diary"
+ ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
+ "--"
+ ["Create iCalendar File" org-export-icalendar-combine-agenda-files t])
+ "--"
+ ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
+ "--"
+ ("MobileOrg"
+ ["Push Files and Views" org-mobile-push t]
+ ["Get Captured and Flagged" org-mobile-pull t]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
+ ["Show note / unflag" org-agenda-show-the-flagging-note t]
+ "--"
+ ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
+ "--"
+ ["Quit" org-agenda-quit t]
+ ["Exit and Release Buffers" org-agenda-exit t]
+ ))
+
+;;; Agenda undo
+
+(defvar org-agenda-allow-remote-undo t
+ "Non-nil means allow remote undo from the agenda buffer.")
+(defvar org-agenda-undo-has-started-in nil
+ "Buffers that have already seen `undo-start' in the current undo sequence.")
+
+(defun org-agenda-undo ()
+ "Undo a remote editing step in the agenda.
+This undoes changes both in the agenda buffer and in the remote buffer
+that have been changed along."
+ (interactive)
+ (or org-agenda-allow-remote-undo
+ (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
+ (if (not (eq this-command last-command))
+ (setq org-agenda-undo-has-started-in nil
+ org-agenda-pending-undo-list org-agenda-undo-list))
+ (if (not org-agenda-pending-undo-list)
+ (error "No further undo information"))
+ (let* ((entry (pop org-agenda-pending-undo-list))
+ buf line cmd rembuf)
+ (setq cmd (pop entry) line (pop entry))
+ (setq rembuf (nth 2 entry))
+ (org-with-remote-undo rembuf
+ (while (bufferp (setq buf (pop entry)))
+ (if (pop entry)
+ (with-current-buffer buf
+ (let ((last-undo-buffer buf)
+ (inhibit-read-only t))
+ (unless (memq buf org-agenda-undo-has-started-in)
+ (push buf org-agenda-undo-has-started-in)
+ (make-local-variable 'pending-undo-list)
+ (undo-start))
+ (while (and pending-undo-list
+ (listp pending-undo-list)
+ (not (car pending-undo-list)))
+ (pop pending-undo-list))
+ (undo-more 1))))))
+ (org-goto-line line)
+ (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
+
+(defun org-verify-change-for-undo (l1 l2)
+ "Verify that a real change occurred between the undo lists L1 and L2."
+ (while (and l1 (listp l1) (null (car l1))) (pop l1))
+ (while (and l2 (listp l2) (null (car l2))) (pop l2))
+ (not (eq l1 l2)))
+
+;;; Agenda dispatch
+
+(defvar org-agenda-restrict-begin (make-marker))
+(defvar org-agenda-restrict-end (make-marker))
+(defvar org-agenda-last-dispatch-buffer nil)
+(defvar org-agenda-overriding-restriction nil)
+
+(defcustom org-agenda-custom-commands-contexts nil
+ "Alist of custom agenda keys and contextual rules.
+
+For example, if you have a custom agenda command \"p\" and you
+want this command to be accessible only from plain text files,
+use this:
+
+ '((\"p\" (in-file . \"\\.txt\")))
+
+Here are the available contexts definitions:
+
+ in-file: command displayed only in matching files
+ in-mode: command displayed only in matching modes
+ not-in-file: command not displayed in matching files
+ not-in-mode: command not displayed in matching modes
+ [function]: a custom function taking no argument
+
+If you define several checks, the agenda command will be
+accessible if there is at least one valid check.
+
+You can also bind a key to another agenda custom command
+depending on contextual rules.
+
+ '((\"p\" \"q\" (in-file . \"\\.txt\")))
+
+Here it means: in .txt files, use \"p\" as the key for the
+agenda command otherwise associated with \"q\". (The command
+originally associated with \"q\" is not displayed to avoid
+duplicates.)"
+ :version "24.3"
+ :group 'org-agenda-custom-commands
+ :type '(repeat (list :tag "Rule"
+ (string :tag " Agenda key")
+ (string :tag "Replace by command")
+ (repeat :tag "Available when"
+ (choice
+ (cons :tag "Condition"
+ (choice
+ (const :tag "In file" in-file)
+ (const :tag "Not in file" not-in-file)
+ (const :tag "In mode" in-mode)
+ (const :tag "Not in mode" not-in-mode))
+ (regexp))
+ (function :tag "Custom function"))))))
+
+(defvar org-keys nil)
+(defvar org-match nil)
+;;;###autoload
+(defun org-agenda (&optional arg org-keys restriction)
+ "Dispatch agenda commands to collect entries to the agenda buffer.
+Prompts for a command to execute. Any prefix arg will be passed
+on to the selected command. The default selections are:
+
+a Call `org-agenda-list' to display the agenda for current day or week.
+t Call `org-todo-list' to display the global todo list.
+T Call `org-todo-list' to display the global todo list, select only
+ entries with a specific TODO keyword (the user gets a prompt).
+m Call `org-tags-view' to display headlines with tags matching
+ a condition (the user is prompted for the condition).
+M Like `m', but select only TODO entries, no ordinary headlines.
+L Create a timeline for the current buffer.
+e Export views to associated files.
+s Search entries for keywords.
+S Search entries for keywords, only with TODO keywords.
+/ Multi occur across all agenda files and also files listed
+ in `org-agenda-text-search-extra-files'.
+< Restrict agenda commands to buffer, subtree, or region.
+ Press several times to get the desired effect.
+> Remove a previous restriction.
+# List \"stuck\" projects.
+! Configure what \"stuck\" means.
+C Configure custom agenda commands.
+
+More commands can be added by configuring the variable
+`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
+searches can be pre-defined in this way.
+
+If the current buffer is in Org-mode and visiting a file, you can also
+first press `<' once to indicate that the agenda should be temporarily
+\(until the next use of \\[org-agenda]) restricted to the current file.
+Pressing `<' twice means to restrict to the current subtree or region
+\(if active)."
+ (interactive "P")
+ (catch 'exit
+ (let* ((prefix-descriptions nil)
+ (org-agenda-buffer-name org-agenda-buffer-name)
+ (org-agenda-window-setup (if (equal (buffer-name)
+ org-agenda-buffer-name)
+ 'current-window
+ org-agenda-window-setup))
+ (org-agenda-custom-commands-orig org-agenda-custom-commands)
+ (org-agenda-custom-commands
+ ;; normalize different versions
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond ((stringp (cdr x))
+ (push x prefix-descriptions)
+ nil)
+ ((stringp (nth 1 x)) x)
+ ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
+ (t (cons (car x) (cons "" (cdr x))))))
+ org-agenda-custom-commands)))
+ (org-agenda-custom-commands
+ (org-contextualize-keys
+ org-agenda-custom-commands org-agenda-custom-commands-contexts))
+ (buf (current-buffer))
+ (bfn (buffer-file-name (buffer-base-buffer)))
+ entry key type org-match lprops ans)
+ ;; Turn off restriction unless there is an overriding one,
+ (unless org-agenda-overriding-restriction
+ (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
+ ;; There is a request to keep the file list in place
+ (put 'org-agenda-files 'org-restrict nil))
+ (setq org-agenda-restrict nil)
+ (move-marker org-agenda-restrict-begin nil)
+ (move-marker org-agenda-restrict-end nil))
+ ;; Delete old local properties
+ (put 'org-agenda-redo-command 'org-lprops nil)
+ ;; Delete previously set last-arguments
+ (put 'org-agenda-redo-command 'last-args nil)
+ ;; Remember where this call originated
+ (setq org-agenda-last-dispatch-buffer (current-buffer))
+ (unless org-keys
+ (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
+ org-keys (car ans)
+ restriction (cdr ans)))
+ ;; If we have sticky agenda buffers, set a name for the buffer,
+ ;; depending on the invoking keys. The user may still set this
+ ;; as a command option, which will overwrite what we do here.
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (format "*Org Agenda(%s)*" org-keys)))
+ ;; Establish the restriction, if any
+ (when (and (not org-agenda-overriding-restriction) restriction)
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (cond
+ ((eq restriction 'region)
+ (setq org-agenda-restrict t)
+ (move-marker org-agenda-restrict-begin (region-beginning))
+ (move-marker org-agenda-restrict-end (region-end)))
+ ((eq restriction 'subtree)
+ (save-excursion
+ (setq org-agenda-restrict t)
+ (org-back-to-heading t)
+ (move-marker org-agenda-restrict-begin (point))
+ (move-marker org-agenda-restrict-end
+ (progn (org-end-of-subtree t)))))))
+
+ ;; For example the todo list should not need it (but does...)
+ (cond
+ ((setq entry (assoc org-keys org-agenda-custom-commands))
+ (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
+ (progn
+ (setq type (nth 2 entry) org-match (eval (nth 3 entry))
+ lprops (nth 4 entry))
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
+ (format "*Org Agenda(%s)*" org-keys))))
+ (put 'org-agenda-redo-command 'org-lprops lprops)
+ (cond
+ ((eq type 'agenda)
+ (org-let lprops '(org-agenda-list current-prefix-arg)))
+ ((eq type 'alltodo)
+ (org-let lprops '(org-todo-list current-prefix-arg)))
+ ((eq type 'search)
+ (org-let lprops '(org-search-view current-prefix-arg org-match nil)))
+ ((eq type 'stuck)
+ (org-let lprops '(org-agenda-list-stuck-projects
+ current-prefix-arg)))
+ ((eq type 'tags)
+ (org-let lprops '(org-tags-view current-prefix-arg org-match)))
+ ((eq type 'tags-todo)
+ (org-let lprops '(org-tags-view '(4) org-match)))
+ ((eq type 'todo)
+ (org-let lprops '(org-todo-list org-match)))
+ ((eq type 'tags-tree)
+ (org-check-for-org-mode)
+ (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match)))
+ ((eq type 'todo-tree)
+ (org-check-for-org-mode)
+ (org-let lprops
+ '(org-occur (concat "^" org-outline-regexp "[ \t]*"
+ (regexp-quote org-match) "\\>"))))
+ ((eq type 'occur-tree)
+ (org-check-for-org-mode)
+ (org-let lprops '(org-occur org-match)))
+ ((functionp type)
+ (org-let lprops '(funcall type org-match)))
+ ((fboundp type)
+ (org-let lprops '(funcall type org-match)))
+ (t (error "Invalid custom agenda command type %s" type))))
+ (org-agenda-run-series (nth 1 entry) (cddr entry))))
+ ((equal org-keys "C")
+ (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
+ (customize-variable 'org-agenda-custom-commands))
+ ((equal org-keys "a") (call-interactively 'org-agenda-list))
+ ((equal org-keys "s") (call-interactively 'org-search-view))
+ ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
+ ((equal org-keys "t") (call-interactively 'org-todo-list))
+ ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
+ ((equal org-keys "m") (call-interactively 'org-tags-view))
+ ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
+ ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
+ ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
+ (org-add-hook
+ 'post-command-hook
+ (lambda ()
+ (unless (current-message)
+ (let* ((m (org-agenda-get-any-marker))
+ (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
+ (when note
+ (message (concat
+ "FLAGGING-NOTE ([?] for more info): "
+ (org-add-props
+ (replace-regexp-in-string
+ "\\\\n" "//"
+ (copy-sequence note))
+ nil 'face 'org-warning)))))))
+ t t))
+ ((equal org-keys "L")
+ (unless (derived-mode-p 'org-mode)
+ (error "This is not an Org-mode file"))
+ (unless restriction
+ (put 'org-agenda-files 'org-restrict (list bfn))
+ (org-call-with-arg 'org-timeline arg)))
+ ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
+ ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
+ ((equal org-keys "!") (customize-variable 'org-stuck-projects))
+ (t (error "Invalid agenda key"))))))
+
+(defun org-agenda-append-agenda ()
+ "Append another agenda view to the current one.
+This function allows interactive building of block agendas.
+Agenda views are separated by `org-agenda-block-separator'."
+ (interactive)
+ (unless (derived-mode-p 'org-agenda-mode)
+ (error "Can only append from within agenda buffer"))
+ (let ((org-agenda-multi t))
+ (org-agenda)
+ (widen)
+ (org-agenda-finalize)
+ (org-agenda-fit-window-to-buffer)))
+
+(defun org-agenda-normalize-custom-commands (cmds)
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond ((stringp (cdr x)) nil)
+ ((stringp (nth 1 x)) x)
+ ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
+ (t (cons (car x) (cons "" (cdr x))))))
+ cmds)))
+
+(defun org-agenda-get-restriction-and-command (prefix-descriptions)
+ "The user interface for selecting an agenda command."
+ (catch 'exit
+ (let* ((bfn (buffer-file-name (buffer-base-buffer)))
+ (restrict-ok (and bfn (derived-mode-p 'org-mode)))
+ (region-p (org-region-active-p))
+ (custom org-agenda-custom-commands)
+ (selstring "")
+ restriction second-time
+ c entry key type match prefixes rmheader header-end custom1 desc
+ line lines left right n n1)
+ (save-window-excursion
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window " *Agenda Commands*")
+ (erase-buffer)
+ (insert (eval-when-compile
+ (let ((header
+ "Press key for an agenda command: < Buffer, subtree/region restriction
+-------------------------------- > Remove restriction
+a Agenda for current week or day e Export agenda views
+t List of all TODO entries T Entries with special TODO kwd
+m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
+s Search for keywords S Like s, but only TODO entries
+L Timeline for current buffer # List stuck projects (!=configure)
+/ Multi-occur C Configure custom agenda commands
+? Find :FLAGGED: entries * Toggle sticky agenda views
+")
+ (start 0))
+ (while (string-match
+ "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
+ header start)
+ (setq start (match-end 0))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(face bold) header))
+ header)))
+ (setq header-end (move-marker (make-marker) (point)))
+ (while t
+ (setq custom1 custom)
+ (when (eq rmheader t)
+ (org-goto-line 1)
+ (re-search-forward ":" nil t)
+ (delete-region (match-end 0) (point-at-eol))
+ (forward-char 1)
+ (looking-at "-+")
+ (delete-region (match-end 0) (point-at-eol))
+ (move-marker header-end (match-end 0)))
+ (goto-char header-end)
+ (delete-region (point) (point-max))
+
+ ;; Produce all the lines that describe custom commands and prefixes
+ (setq lines nil)
+ (while (setq entry (pop custom1))
+ (setq key (car entry) desc (nth 1 entry)
+ type (nth 2 entry)
+ match (nth 3 entry))
+ (if (> (length key) 1)
+ (add-to-list 'prefixes (string-to-char key))
+ (setq line
+ (format
+ "%-4s%-14s"
+ (org-add-props (copy-sequence key)
+ '(face bold))
+ (cond
+ ((string-match "\\S-" desc) desc)
+ ((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'alltodo) "List of all TODO entries")
+ ((eq type 'search) "Word search")
+ ((eq type 'stuck) "List of stuck projects")
+ ((eq type 'todo) "TODO keyword")
+ ((eq type 'tags) "Tags query")
+ ((eq type 'tags-todo) "Tags (TODO)")
+ ((eq type 'tags-tree) "Tags tree")
+ ((eq type 'todo-tree) "TODO kwd tree")
+ ((eq type 'occur-tree) "Occur tree")
+ ((functionp type) (if (symbolp type)
+ (symbol-name type)
+ "Lambda expression"))
+ (t "???"))))
+ (if org-agenda-menu-show-matcher
+ (setq line
+ (concat line ": "
+ (cond
+ ((stringp match)
+ (setq match (copy-sequence match))
+ (org-add-props match nil 'face 'org-warning))
+ ((listp type)
+ (format "set of %d commands" (length type))))))
+ (if (org-string-nw-p match)
+ (add-text-properties
+ 0 (length line) (list 'help-echo
+ (concat "Matcher: " match)) line)))
+ (push line lines)))
+ (setq lines (nreverse lines))
+ (when prefixes
+ (mapc (lambda (x)
+ (push
+ (format "%s %s"
+ (org-add-props (char-to-string x)
+ nil 'face 'bold)
+ (or (cdr (assoc (concat selstring
+ (char-to-string x))
+ prefix-descriptions))
+ "Prefix key"))
+ lines))
+ prefixes))
+
+ ;; Check if we should display in two columns
+ (if org-agenda-menu-two-columns
+ (progn
+ (setq n (length lines)
+ n1 (+ (/ n 2) (mod n 2))
+ right (nthcdr n1 lines)
+ left (copy-sequence lines))
+ (setcdr (nthcdr (1- n1) left) nil))
+ (setq left lines right nil))
+ (while left
+ (insert "\n" (pop left))
+ (when right
+ (if (< (current-column) 40)
+ (move-to-column 40 t)
+ (insert " "))
+ (insert (pop right))))
+
+ ;; Make the window the right size
+ (goto-char (point-min))
+ (if second-time
+ (if (not (pos-visible-in-window-p (point-max)))
+ (org-fit-window-to-buffer))
+ (setq second-time t)
+ (org-fit-window-to-buffer))
+
+ ;; Ask for selection
+ (message "Press key for agenda command%s:"
+ (if (or restrict-ok org-agenda-overriding-restriction)
+ (if org-agenda-overriding-restriction
+ " (restriction lock active)"
+ (if restriction
+ (format " (restricted to %s)" restriction)
+ " (unrestricted)"))
+ ""))
+ (setq c (read-char-exclusive))
+ (message "")
+ (cond
+ ((assoc (char-to-string c) custom)
+ (setq selstring (concat selstring (char-to-string c)))
+ (throw 'exit (cons selstring restriction)))
+ ((memq c prefixes)
+ (setq selstring (concat selstring (char-to-string c))
+ prefixes nil
+ rmheader (or rmheader t)
+ custom (delq nil (mapcar
+ (lambda (x)
+ (if (or (= (length (car x)) 1)
+ (/= (string-to-char (car x)) c))
+ nil
+ (cons (substring (car x) 1) (cdr x))))
+ custom))))
+ ((eq c ?*)
+ (call-interactively 'org-toggle-sticky-agenda)
+ (sit-for 2))
+ ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
+ (message "Restriction is only possible in Org-mode buffers")
+ (ding) (sit-for 1))
+ ((eq c ?1)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction 'buffer))
+ ((eq c ?0)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction (if region-p 'region 'subtree)))
+ ((eq c ?<)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction
+ (cond
+ ((eq restriction 'buffer)
+ (if region-p 'region 'subtree))
+ ((memq restriction '(subtree region))
+ nil)
+ (t 'buffer))))
+ ((eq c ?>)
+ (org-agenda-remove-restriction-lock 'noupdate)
+ (setq restriction nil))
+ ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
+ (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
+ ((and (> (length selstring) 0) (eq c ?\d))
+ (delete-window)
+ (org-agenda-get-restriction-and-command prefix-descriptions))
+
+ ((equal c ?q) (error "Abort"))
+ (t (error "Invalid key %c" c))))))))
+
+(defun org-agenda-fit-window-to-buffer ()
+ "Fit the window to the buffer size."
+ (and (memq org-agenda-window-setup '(reorganize-frame))
+ (fboundp 'fit-window-to-buffer)
+ (org-fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
+
+(defvar org-cmd nil)
+(defvar org-agenda-overriding-cmd nil)
+(defvar org-agenda-overriding-arguments nil)
+(defvar org-agenda-overriding-cmd-arguments nil)
+(defun org-agenda-run-series (name series)
+ (org-let (nth 1 series) '(org-agenda-prepare name))
+ ;; We need to reset agenda markers here, because when constructing a
+ ;; block agenda, the individual blocks do not do that.
+ (org-agenda-reset-markers)
+ (let* ((org-agenda-multi t)
+ (redo (list 'org-agenda-run-series name (list 'quote series)))
+ (cmds (car series))
+ (gprops (nth 1 series))
+ match ;; The byte compiler incorrectly complains about this. Keep it!
+ org-cmd type lprops)
+ (while (setq org-cmd (pop cmds))
+ (setq type (car org-cmd)
+ match (eval (nth 1 org-cmd))
+ lprops (nth 2 org-cmd))
+ (let ((org-agenda-overriding-arguments
+ (if (eq org-agenda-overriding-cmd org-cmd)
+ (or org-agenda-overriding-arguments
+ org-agenda-overriding-cmd-arguments))))
+ (cond
+ ((eq type 'agenda)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-agenda-list)))
+ ((eq type 'alltodo)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-todo-list)))
+ ((eq type 'search)
+ (org-let2 gprops lprops
+ '(org-search-view current-prefix-arg match nil)))
+ ((eq type 'stuck)
+ (org-let2 gprops lprops
+ '(call-interactively 'org-agenda-list-stuck-projects)))
+ ((eq type 'tags)
+ (org-let2 gprops lprops
+ '(org-tags-view current-prefix-arg match)))
+ ((eq type 'tags-todo)
+ (org-let2 gprops lprops
+ '(org-tags-view '(4) match)))
+ ((eq type 'todo)
+ (org-let2 gprops lprops
+ '(org-todo-list match)))
+ ((fboundp type)
+ (org-let2 gprops lprops
+ '(funcall type match)))
+ (t (error "Invalid type in command series")))))
+ (widen)
+ (let ((inhibit-read-only t))
+ (add-text-properties (point-min) (point-max)
+ `(org-serie t org-serie-redo-cmd ,redo)))
+ (setq org-agenda-redo-command redo)
+ (goto-char (point-min)))
+ (org-agenda-fit-window-to-buffer)
+ (org-let (nth 1 series) '(org-agenda-finalize)))
+
+;;;###autoload
+(defmacro org-batch-agenda (cmd-key &rest parameters)
+ "Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command."
+ (org-eval-in-environment (org-make-parameter-alist parameters)
+ (if (> (length cmd-key) 2)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (princ (buffer-string)))
+(def-edebug-spec org-batch-agenda (form &rest sexp))
+
+(defvar org-agenda-info nil)
+
+;;;###autoload
+(defmacro org-batch-agenda-csv (cmd-key &rest parameters)
+ "Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command.
+
+The output gives a line for each selected agenda item. Each
+item is a list of comma-separated values, like this:
+
+category,head,type,todo,tags,date,time,extra,priority-l,priority-n
+
+category The category of the item
+head The headline, without TODO kwd, TAGS and PRIORITY
+type The type of the agenda entry, can be
+ todo selected in TODO match
+ tagsmatch selected in tags match
+ diary imported from diary
+ deadline a deadline on given date
+ scheduled scheduled on given date
+ timestamp entry has timestamp on given date
+ closed entry was closed on given date
+ upcoming-deadline warning about deadline
+ past-scheduled forwarded scheduled item
+ block entry has date block including g. date
+todo The todo keyword, if any
+tags All tags including inherited ones, separated by colons
+date The relevant date, like 2007-2-14
+time The time, like 15:00-16:50
+extra Sting with extra planning info
+priority-l The priority letter if any was given
+priority-n The computed numerical priority
+agenda-day The day in the agenda where this is listed"
+ (org-eval-in-environment (append '((org-agenda-remove-tags t))
+ (org-make-parameter-alist parameters))
+ (if (> (length cmd-key) 2)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key)))
+ (set-buffer org-agenda-buffer-name)
+ (let* ((lines (org-split-string (buffer-string) "\n"))
+ line)
+ (while (setq line (pop lines))
+ (catch 'next
+ (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
+ (setq org-agenda-info
+ (org-fix-agenda-info (text-properties-at 0 line)))
+ (princ
+ (mapconcat 'org-agenda-export-csv-mapper
+ '(org-category txt type todo tags date time extra
+ priority-letter priority agenda-day)
+ ","))
+ (princ "\n")))))
+(def-edebug-spec org-batch-agenda-csv (form &rest sexp))
+
+(defun org-fix-agenda-info (props)
+ "Make sure all properties on an agenda item have a canonical form.
+This ensures the export commands can easily use it."
+ (let (tmp re)
+ (when (setq tmp (plist-get props 'tags))
+ (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
+ (when (setq tmp (plist-get props 'date))
+ (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
+ (let ((calendar-date-display-form '(year "-" month "-" day)))
+ '((format "%4d, %9s %2s, %4s" dayname monthname day year))
+
+ (setq tmp (calendar-date-string tmp)))
+ (setq props (plist-put props 'date tmp)))
+ (when (setq tmp (plist-get props 'day))
+ (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
+ (let ((calendar-date-display-form '(year "-" month "-" day)))
+ (setq tmp (calendar-date-string tmp)))
+ (setq props (plist-put props 'day tmp))
+ (setq props (plist-put props 'agenda-day tmp)))
+ (when (setq tmp (plist-get props 'txt))
+ (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
+ (plist-put props 'priority-letter (match-string 1 tmp))
+ (setq tmp (replace-match "" t t tmp)))
+ (when (and (setq re (plist-get props 'org-todo-regexp))
+ (setq re (concat "\\`\\.*" re " ?"))
+ (string-match re tmp))
+ (plist-put props 'todo (match-string 1 tmp))
+ (setq tmp (replace-match "" t t tmp)))
+ (plist-put props 'txt tmp)))
+ props)
+
+(defun org-agenda-export-csv-mapper (prop)
+ (let ((res (plist-get org-agenda-info prop)))
+ (setq res
+ (cond
+ ((not res) "")
+ ((stringp res) res)
+ (t (prin1-to-string res))))
+ (while (string-match "," res)
+ (setq res (replace-match ";" t t res)))
+ (org-trim res)))
+
+;;;###autoload
+(defun org-store-agenda-views (&rest parameters)
+ (interactive)
+ (eval (list 'org-batch-store-agenda-views)))
+
+;;;###autoload
+(defmacro org-batch-store-agenda-views (&rest parameters)
+ "Run all custom agenda commands that have a file argument."
+ (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
+ (pop-up-frames nil)
+ (dir default-directory)
+ (pars (org-make-parameter-alist parameters))
+ cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
+ (save-window-excursion
+ (while cmds
+ (setq cmd (pop cmds)
+ thiscmdkey (car cmd)
+ thiscmdcmd (cdr cmd)
+ match (nth 2 thiscmdcmd)
+ bufname (if org-agenda-sticky
+ (or (and (stringp match)
+ (format "*Org Agenda(%s:%s)*" thiscmdkey match))
+ (format "*Org Agenda(%s)*" thiscmdkey))
+ org-agenda-buffer-name)
+ cmd-or-set (nth 2 cmd)
+ opts (nth (if (listp cmd-or-set) 3 4) cmd)
+ files (nth (if (listp cmd-or-set) 4 5) cmd))
+ (if (stringp files) (setq files (list files)))
+ (when files
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda nil thiscmdkey))
+ (set-buffer bufname)
+ (while files
+ (org-eval-in-environment (append org-agenda-exporter-settings
+ opts pars)
+ (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
+ (and (get-buffer bufname)
+ (kill-buffer bufname)))))))
+(def-edebug-spec org-batch-store-agenda-views (&rest sexp))
+
+(defvar org-agenda-current-span nil
+ "The current span used in the agenda view.") ; local variable in the agenda buffer
+(defun org-agenda-mark-header-line (pos)
+ "Mark the line at POS as an agenda structure header."
+ (save-excursion
+ (goto-char pos)
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'org-agenda-structural-header t)
+ (when org-agenda-title-append
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'org-agenda-title-append org-agenda-title-append))))
+
+(defvar org-mobile-creating-agendas) ; defined in org-mobile.el
+(defvar org-agenda-write-buffer-name "Agenda View")
+(defun org-agenda-write (file &optional open nosettings agenda-bufname)
+ "Write the current buffer (an agenda view) as a file.
+Depending on the extension of the file name, plain text (.txt),
+HTML (.html or .htm) or Postscript (.ps) is produced.
+If the extension is .ics, run icalendar export over all files used
+to construct the agenda and limit the export to entries listed in the
+agenda now.
+With prefix argument OPEN, open the new file immediately.
+If NOSETTINGS is given, do not scope the settings of
+`org-agenda-exporter-settings' into the export commands. This is used when
+the settings have already been scoped and we do not wish to overrule other,
+higher priority settings.
+If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
+ (interactive "FWrite agenda to file: \nP")
+ (if (not (file-writable-p file))
+ (error "Cannot write agenda to file %s" file))
+ (org-let (if nosettings nil org-agenda-exporter-settings)
+ '(save-excursion
+ (save-window-excursion
+ (org-agenda-mark-filtered-text)
+ (let ((bs (copy-sequence (buffer-string))) beg)
+ (org-agenda-unmark-filtered-text)
+ (with-temp-buffer
+ (rename-buffer org-agenda-write-buffer-name t)
+ (set-buffer-modified-p nil)
+ (insert bs)
+ (org-agenda-remove-marked-text 'org-filtered)
+ (while (setq beg (text-property-any (point-min) (point-max)
+ 'org-filtered t))
+ (delete-region
+ beg (or (next-single-property-change beg 'org-filtered)
+ (point-max))))
+ (run-hooks 'org-agenda-before-write-hook)
+ (cond
+ ((org-bound-and-true-p org-mobile-creating-agendas)
+ (org-mobile-write-agenda-for-mobile file))
+ ((string-match "\\.html?\\'" file)
+ (require 'htmlize)
+ (set-buffer (htmlize-buffer (current-buffer)))
+ (when org-agenda-export-html-style
+ ;; replace <style> section with org-agenda-export-html-style
+ (goto-char (point-min))
+ (kill-region (- (search-forward "<style") 6)
+ (search-forward "</style>"))
+ (insert org-agenda-export-html-style))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (message "HTML written to %s" file))
+ ((string-match "\\.ps\\'" file)
+ (require 'ps-print)
+ (ps-print-buffer-with-faces file)
+ (message "Postscript written to %s" file))
+ ((string-match "\\.pdf\\'" file)
+ (require 'ps-print)
+ (ps-print-buffer-with-faces
+ (concat (file-name-sans-extension file) ".ps"))
+ (call-process "ps2pdf" nil nil nil
+ (expand-file-name
+ (concat (file-name-sans-extension file) ".ps"))
+ (expand-file-name file))
+ (delete-file (concat (file-name-sans-extension file) ".ps"))
+ (message "PDF written to %s" file))
+ ((string-match "\\.ics\\'" file)
+ (require 'org-icalendar)
+ (let ((org-agenda-marker-table
+ (org-create-marker-find-array
+ (org-agenda-collect-markers)))
+ (org-icalendar-verify-function 'org-check-agenda-marker-table)
+ (org-combined-agenda-icalendar-file file))
+ (apply 'org-export-icalendar 'combine
+ (org-agenda-files nil 'ifmode))))
+ (t
+ (let ((bs (buffer-string)))
+ (find-file file)
+ (erase-buffer)
+ (insert bs)
+ (save-buffer 0)
+ (kill-buffer (current-buffer))
+ (message "Plain text written to %s" file))))))))
+ (set-buffer (or agenda-bufname
+ (and (called-interactively-p 'any) (buffer-name))
+ org-agenda-buffer-name)))
+ (when open (org-open-file file)))
+
+(defvar org-agenda-tag-filter-overlays nil)
+(defvar org-agenda-cat-filter-overlays nil)
+
+(defun org-agenda-mark-filtered-text ()
+ "Mark all text hidden by filtering with a text property."
+ (let ((inhibit-read-only t))
+ (mapc
+ (lambda (o)
+ (when (equal (overlay-buffer o) (current-buffer))
+ (put-text-property
+ (overlay-start o) (overlay-end o)
+ 'org-filtered t)))
+ (append org-agenda-tag-filter-overlays
+ org-agenda-cat-filter-overlays))))
+
+(defun org-agenda-unmark-filtered-text ()
+ "Remove the filtering text property."
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(org-filtered t))))
+
+(defun org-agenda-remove-marked-text (property &optional value)
+ "Delete all text marked with VALUE of PROPERTY.
+VALUE defaults to t."
+ (let (beg)
+ (setq value (or value t))
+ (while (setq beg (text-property-any (point-min) (point-max)
+ property value))
+ (delete-region
+ beg (or (next-single-property-change beg 'org-filtered)
+ (point-max))))))
+
+(defun org-agenda-add-entry-text ()
+ "Add entry text to agenda lines.
+This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
+entry text following headings shown in the agenda.
+Drawers will be excluded, also the line with scheduling/deadline info."
+ (when (and (> org-agenda-add-entry-text-maxlines 0)
+ (not (org-bound-and-true-p org-mobile-creating-agendas)))
+ (let (m txt)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (not (setq m (org-get-at-bol 'org-hd-marker)))
+ (beginning-of-line 2)
+ (setq txt (org-agenda-get-some-entry-text
+ m org-agenda-add-entry-text-maxlines " > "))
+ (end-of-line 1)
+ (if (string-match "\\S-" txt)
+ (insert "\n" txt)
+ (or (eobp) (forward-char 1))))))))
+
+(defun org-agenda-get-some-entry-text (marker n-lines &optional indent
+ &rest keep)
+ "Extract entry text from MARKER, at most N-LINES lines.
+This will ignore drawers etc, just get the text.
+If INDENT is given, prefix every line with this string. If KEEP is
+given, it is a list of symbols, defining stuff that should not be
+removed from the entry content. Currently only `planning' is allowed here."
+ (let (txt drawer-re kwd-time-re ind)
+ (save-excursion
+ (with-current-buffer (marker-buffer marker)
+ (if (not (derived-mode-p 'org-mode))
+ (setq txt "")
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char marker)
+ (end-of-line 1)
+ (setq txt (buffer-substring
+ (min (1+ (point)) (point-max))
+ (progn (outline-next-heading) (point)))
+ drawer-re org-drawer-regexp
+ kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
+ ".*\n?"))
+ (with-temp-buffer
+ (insert txt)
+ (when org-agenda-add-entry-text-descriptive-links
+ (goto-char (point-min))
+ (while (org-activate-bracket-links (point-max))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(face org-link))))
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp (point-max) t)
+ (set-text-properties (match-beginning 0) (match-end 0)
+ nil))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (delete-region
+ (match-beginning 0)
+ (progn (re-search-forward
+ "^[ \t]*:END:.*\n?" nil 'move)
+ (point))))
+ (unless (member 'planning keep)
+ (goto-char (point-min))
+ (while (re-search-forward kwd-time-re nil t)
+ (replace-match "")))
+ (goto-char (point-min))
+ (when org-agenda-entry-text-exclude-regexps
+ (let ((re-list org-agenda-entry-text-exclude-regexps) re)
+ (while (setq re (pop re-list))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (replace-match "")))))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (if (looking-at "[ \t\n]+\\'") (replace-match ""))
+
+ ;; find and remove min common indentation
+ (goto-char (point-min))
+ (untabify (point-min) (point-max))
+ (setq ind (org-get-indentation))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (setq ind (min ind (org-get-indentation))))
+ (beginning-of-line 2))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (move-to-column ind)
+ (delete-region (point-at-bol) (point)))
+ (beginning-of-line 2))
+
+ (run-hooks 'org-agenda-entry-text-cleanup-hook)
+
+ (goto-char (point-min))
+ (when indent
+ (while (and (not (eobp)) (re-search-forward "^" nil t))
+ (replace-match indent t t)))
+ (goto-char (point-min))
+ (while (looking-at "[ \t]*\n") (replace-match ""))
+ (goto-char (point-max))
+ (when (> (org-current-line)
+ n-lines)
+ (org-goto-line (1+ n-lines))
+ (backward-char 1))
+ (setq txt (buffer-substring (point-min) (point)))))))))
+ txt))
+
+(defun org-agenda-collect-markers ()
+ "Collect the markers pointing to entries in the agenda buffer."
+ (let (m markers)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (setq m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker)))
+ (push m markers))
+ (beginning-of-line 2)))
+ (nreverse markers)))
+
+(defun org-create-marker-find-array (marker-list)
+ "Create a alist of files names with all marker positions in that file."
+ (let (f tbl m a p)
+ (while (setq m (pop marker-list))
+ (setq p (marker-position m)
+ f (buffer-file-name (or (buffer-base-buffer
+ (marker-buffer m))
+ (marker-buffer m))))
+ (if (setq a (assoc f tbl))
+ (push (marker-position m) (cdr a))
+ (push (list f p) tbl)))
+ (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
+ tbl)))
+
+(defvar org-agenda-marker-table nil) ; dynamically scoped parameter
+(defun org-check-agenda-marker-table ()
+ "Check of the current entry is on the marker list."
+ (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ a)
+ (and (setq a (assoc file org-agenda-marker-table))
+ (save-match-data
+ (save-excursion
+ (org-back-to-heading t)
+ (member (point) (cdr a)))))))
+
+(defun org-check-for-org-mode ()
+ "Make sure current buffer is in org-mode. Error if not."
+ (or (derived-mode-p 'org-mode)
+ (error "Cannot execute org-mode agenda command on buffer in %s"
+ major-mode)))
+
+;;; Agenda prepare and finalize
+
+(defvar org-agenda-multi nil) ; dynamically scoped
+(defvar org-agenda-pre-window-conf nil)
+(defvar org-agenda-columns-active nil)
+(defvar org-agenda-name nil)
+(defvar org-agenda-tag-filter nil)
+(defvar org-agenda-category-filter nil)
+(defvar org-agenda-top-category-filter nil)
+(defvar org-agenda-tag-filter-while-redo nil)
+(defvar org-agenda-tag-filter-preset nil
+ "A preset of the tags filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single tag preceded
+by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
+(defvar org-agenda-category-filter-preset nil
+ "A preset of the category filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single category
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
+
+(defun org-agenda-use-sticky-p ()
+ "Return non-nil if an agenda buffer named
+`org-agenda-buffer-name' exists and should be shown instead of
+generating a new one."
+ (and
+ ;; turned off by user
+ org-agenda-sticky
+ ;; For multi-agenda buffer already exists
+ (not org-agenda-multi)
+ ;; buffer found
+ (get-buffer org-agenda-buffer-name)
+ ;; C-u parameter is same as last call
+ (with-current-buffer (get-buffer org-agenda-buffer-name)
+ (and
+ (equal current-prefix-arg
+ org-agenda-last-prefix-arg)
+ ;; In case user turned stickiness on, while having existing
+ ;; Agenda buffer active, don't reuse that buffer, because it
+ ;; does not have org variables local
+ org-agenda-this-buffer-is-sticky))))
+
+(defun org-agenda-prepare-window (abuf)
+ "Setup agenda buffer in the window."
+ (let* ((awin (get-buffer-window abuf))
+ wconf)
+ (cond
+ ((equal (current-buffer) abuf) nil)
+ (awin (select-window awin))
+ ((not (setq wconf (current-window-configuration))))
+ ((equal org-agenda-window-setup 'current-window)
+ (org-pop-to-buffer-same-window abuf))
+ ((equal org-agenda-window-setup 'other-window)
+ (org-switch-to-buffer-other-window abuf))
+ ((equal org-agenda-window-setup 'other-frame)
+ (switch-to-buffer-other-frame abuf))
+ ((equal org-agenda-window-setup 'reorganize-frame)
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window abuf)))
+ ;; additional test in case agenda is invoked from within agenda
+ ;; buffer via elisp link
+ (unless (equal (current-buffer) abuf)
+ (org-pop-to-buffer-same-window abuf))
+ (setq org-agenda-pre-window-conf
+ (or org-agenda-pre-window-conf wconf))))
+
+(defun org-agenda-prepare (&optional name)
+ (if (org-agenda-use-sticky-p)
+ (progn
+ ;; Popup existing buffer
+ (org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
+ (message "Sticky Agenda buffer, use `r' to refresh")
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
+ (setq org-todo-keywords-for-agenda nil)
+ (setq org-drawers-for-agenda nil)
+ (unless org-agenda-persistent-filter
+ (setq org-agenda-tag-filter nil
+ org-agenda-category-filter nil))
+ (put 'org-agenda-tag-filter :preset-filter
+ org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter
+ org-agenda-category-filter-preset)
+ (if org-agenda-multi
+ (progn
+ (setq buffer-read-only nil)
+ (goto-char (point-max))
+ (unless (or (bobp) org-agenda-compact-blocks
+ (not org-agenda-block-separator))
+ (insert "\n"
+ (if (stringp org-agenda-block-separator)
+ org-agenda-block-separator
+ (make-string (window-width) org-agenda-block-separator))
+ "\n"))
+ (narrow-to-region (point) (point-max)))
+ (setq org-done-keywords-for-agenda nil)
+
+ ;; Setting any org variables that are in org-agenda-local-vars
+ ;; list need to be done after the prepare call
+ (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
+ (setq buffer-read-only nil)
+ (org-agenda-reset-markers)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (org-agenda-mode)
+ (setq org-agenda-buffer (current-buffer))
+ (setq org-agenda-contributing-files nil)
+ (setq org-agenda-columns-active nil)
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (setq org-todo-keywords-for-agenda
+ (org-uniquify org-todo-keywords-for-agenda))
+ (setq org-done-keywords-for-agenda
+ (org-uniquify org-done-keywords-for-agenda))
+ (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
+ (setq org-agenda-last-prefix-arg current-prefix-arg)
+ (setq org-agenda-this-buffer-name org-agenda-buffer-name)
+ (and name (not org-agenda-name)
+ (org-set-local 'org-agenda-name name)))
+ (setq buffer-read-only nil)))
+
+(defvar org-agenda-overriding-columns-format) ; From org-colview.el
+(defun org-agenda-finalize ()
+ "Finishing touch for the agenda buffer, called just before displaying it."
+ (unless org-agenda-multi
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (org-activate-bracket-links (point-max))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(face org-link)))
+ (org-agenda-align-tags)
+ (unless org-agenda-with-colors
+ (remove-text-properties (point-min) (point-max) '(face nil))))
+ (if (and (boundp 'org-agenda-overriding-columns-format)
+ org-agenda-overriding-columns-format)
+ (org-set-local 'org-agenda-overriding-columns-format
+ org-agenda-overriding-columns-format))
+ (if (and (boundp 'org-agenda-view-columns-initially)
+ org-agenda-view-columns-initially)
+ (org-agenda-columns))
+ (when org-agenda-fontify-priorities
+ (org-agenda-fontify-priorities))
+ (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
+ (org-agenda-dim-blocked-tasks))
+ (org-agenda-mark-clocking-task)
+ (when org-agenda-entry-text-mode
+ (org-agenda-entry-text-hide)
+ (org-agenda-entry-text-show))
+ (if (functionp 'org-habit-insert-consistency-graphs)
+ (org-habit-insert-consistency-graphs))
+ (let ((inhibit-read-only t))
+ (run-hooks 'org-agenda-finalize-hook))
+ (setq org-agenda-type (org-get-at-bol 'org-agenda-type))
+ (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-category-filter 'category))
+ (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))
+
+(defun org-agenda-mark-clocking-task ()
+ "Mark the current clock entry in the agenda if it is present."
+ (mapc (lambda (o)
+ (if (eq (overlay-get o 'type) 'org-agenda-clocking)
+ (delete-overlay o)))
+ (overlays-in (point-min) (point-max)))
+ (when (marker-buffer org-clock-hd-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (let (s ov)
+ (while (setq s (next-single-property-change (point) 'org-hd-marker))
+ (goto-char s)
+ (when (equal (org-get-at-bol 'org-hd-marker)
+ org-clock-hd-marker)
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
+ (overlay-put ov 'type 'org-agenda-clocking)
+ (overlay-put ov 'face 'org-agenda-clocking)
+ (overlay-put ov 'help-echo
+ "The clock is running in this item")))))))
+
+(defun org-agenda-fontify-priorities ()
+ "Make highest priority lines bold, and lowest italic."
+ (interactive)
+ (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
+ (delete-overlay o)))
+ (overlays-in (point-min) (point-max)))
+ (save-excursion
+ (let ((inhibit-read-only t)
+ b e p ov h l)
+ (goto-char (point-min))
+ (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
+ (setq h (or (get-char-property (point) 'org-highest-priority)
+ org-highest-priority)
+ l (or (get-char-property (point) 'org-lowest-priority)
+ org-lowest-priority)
+ p (string-to-char (match-string 1))
+ b (match-beginning 0)
+ e (if (eq org-agenda-fontify-priorities 'cookies)
+ (match-end 0)
+ (point-at-eol))
+ ov (make-overlay b e))
+ (overlay-put
+ ov 'face
+ (cond ((org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-priority-faces))))
+ ((and (listp org-agenda-fontify-priorities)
+ (org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-agenda-fontify-priorities)))))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold)))
+ (overlay-put ov 'org-type 'org-priority)))))
+
+(defun org-agenda-dim-blocked-tasks ()
+ "Dim currently blocked TODO's in the agenda display."
+ (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
+ (delete-overlay o)))
+ (overlays-in (point-min) (point-max)))
+ (save-excursion
+ (let ((inhibit-read-only t)
+ (org-depend-tag-blocked nil)
+ (invis (eq org-agenda-dim-blocked-tasks 'invisible))
+ org-blocked-by-checkboxes
+ invis1 b e p ov h l)
+ (goto-char (point-min))
+ (while (let ((pos (next-single-property-change (point) 'todo-state)))
+ (and pos (goto-char (1+ pos))))
+ (setq org-blocked-by-checkboxes nil invis1 invis)
+ (let ((marker (org-get-at-bol 'org-hd-marker)))
+ (when (and marker
+ (with-current-buffer (marker-buffer marker)
+ (save-excursion (goto-char marker)
+ (org-entry-blocked-p))))
+ (if org-blocked-by-checkboxes (setq invis1 nil))
+ (setq b (if invis1
+ (max (point-min) (1- (point-at-bol)))
+ (point-at-bol))
+ e (point-at-eol)
+ ov (make-overlay b e))
+ (if invis1
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
+ (overlay-put ov 'org-type 'org-blocked-todo)))))))
+
+(defvar org-agenda-skip-function nil
+ "Function to be called at each match during agenda construction.
+If this function returns nil, the current match should not be skipped.
+Otherwise, the function must return a position from where the search
+should be continued.
+This may also be a Lisp form, it will be evaluated.
+Never set this variable using `setq' or so, because then it will apply
+to all future agenda commands. If you do want a global skipping condition,
+use the option `org-agenda-skip-function-global' instead.
+The correct usage for `org-agenda-skip-function' is to bind it with
+`let' to scope it dynamically into the agenda-constructing command.
+A good way to set it is through options in `org-agenda-custom-commands'.")
+
+(defun org-agenda-skip ()
+ "Throw to `:skip' in places that should be skipped.
+Also moves point to the end of the skipped region, so that search can
+continue from there."
+ (let ((p (point-at-bol)) to)
+ (when (org-in-src-block-p) (throw :skip t))
+ (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
+ (get-text-property p :org-archived)
+ (org-end-of-subtree t)
+ (throw :skip t))
+ (and org-agenda-skip-comment-trees
+ (get-text-property p :org-comment)
+ (org-end-of-subtree t)
+ (throw :skip t))
+ (if (equal (char-after p) ?#) (throw :skip t))
+ (when (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
+ (org-agenda-skip-eval org-agenda-skip-function)))
+ (goto-char to)
+ (throw :skip t))))
+
+(defun org-agenda-skip-eval (form)
+ "If FORM is a function or a list, call (or eval) is and return result.
+`save-excursion' and `save-match-data' are wrapped around the call, so point
+and match data are returned to the previous state no matter what these
+functions do."
+ (let (fp)
+ (and form
+ (or (setq fp (functionp form))
+ (consp form))
+ (save-excursion
+ (save-match-data
+ (if fp
+ (funcall form)
+ (eval form)))))))
+
+(defvar org-agenda-markers nil
+ "List of all currently active markers created by `org-agenda'.")
+(defvar org-agenda-last-marker-time (org-float-time)
+ "Creation time of the last agenda marker.")
+
+(defun org-agenda-new-marker (&optional pos)
+ "Return a new agenda marker.
+Org-mode keeps a list of these markers and resets them when they are
+no longer in use."
+ (let ((m (copy-marker (or pos (point)))))
+ (setq org-agenda-last-marker-time (org-float-time))
+ (if org-agenda-buffer
+ (with-current-buffer org-agenda-buffer
+ (push m org-agenda-markers))
+ (push m org-agenda-markers))
+ m))
+
+(defun org-agenda-reset-markers ()
+ "Reset markers created by `org-agenda'."
+ (while org-agenda-markers
+ (move-marker (pop org-agenda-markers) nil)))
+
+(defun org-agenda-save-markers-for-cut-and-paste (beg end)
+ "Save relative positions of markers in region.
+This check for agenda markers in all agenda buffers currently active."
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (eq major-mode 'org-agenda-mode)
+ (mapc (lambda (m) (org-check-and-save-marker m beg end))
+ org-agenda-markers)))))
+
+;;; Entry text mode
+
+(defun org-agenda-entry-text-show-here ()
+ "Add some text from the entry as context to the current line."
+ (let (m txt o)
+ (setq m (org-get-at-bol 'org-hd-marker))
+ (unless (marker-buffer m)
+ (error "No marker points to an entry here"))
+ (setq txt (concat "\n" (org-no-properties
+ (org-agenda-get-some-entry-text
+ m org-agenda-entry-text-maxlines " > "))))
+ (when (string-match "\\S-" txt)
+ (setq o (make-overlay (point-at-bol) (point-at-eol)))
+ (overlay-put o 'evaporate t)
+ (overlay-put o 'org-overlay-type 'agenda-entry-content)
+ (overlay-put o 'after-string txt))))
+
+(defun org-agenda-entry-text-show ()
+ "Add entry context for all agenda lines."
+ (interactive)
+ (save-excursion
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (while (not (bobp))
+ (when (org-get-at-bol 'org-hd-marker)
+ (org-agenda-entry-text-show-here))
+ (beginning-of-line 0))))
+
+(defun org-agenda-entry-text-hide ()
+ "Remove any shown entry context."
+ (delq nil
+ (mapcar (lambda (o)
+ (if (eq (overlay-get o 'org-overlay-type)
+ 'agenda-entry-content)
+ (progn (delete-overlay o) t)))
+ (overlays-in (point-min) (point-max)))))
+
+(defun org-agenda-get-day-face (date)
+ "Return the face DATE should be displayed with."
+ (or (and (functionp org-agenda-day-face-function)
+ (funcall org-agenda-day-face-function date))
+ (cond ((org-agenda-todayp date)
+ 'org-agenda-date-today)
+ ((member (calendar-day-of-week date) org-agenda-weekend-days)
+ 'org-agenda-date-weekend)
+ (t 'org-agenda-date))))
+
+;;; Agenda timeline
+
+(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
+
+(defun org-timeline (&optional dotodo)
+ "Show a time-sorted view of the entries in the current org file.
+Only entries with a time stamp of today or later will be listed. With
+\\[universal-argument] prefix, all unfinished TODO items will also be shown,
+under the current date.
+If the buffer contains an active region, only check the region for
+dates."
+ (interactive "P")
+ (let* ((dopast t)
+ (org-agenda-show-log-scoped org-agenda-show-log)
+ (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
+ (current-buffer))))
+ (date (calendar-current-date))
+ (beg (if (org-region-active-p) (region-beginning) (point-min)))
+ (end (if (org-region-active-p) (region-end) (point-max)))
+ (day-numbers (org-get-all-dates
+ beg end 'no-ranges
+ t org-agenda-show-log-scoped ; always include today
+ org-timeline-show-empty-dates))
+ (org-deadline-warning-days 0)
+ (org-agenda-only-exact-dates t)
+ (today (org-today))
+ (past t)
+ args
+ s e rtn d emptyp)
+ (setq org-agenda-redo-command
+ (list 'progn
+ (list 'org-switch-to-buffer-other-window (current-buffer))
+ (list 'org-timeline (list 'quote dotodo))))
+ (if (not dopast)
+ ;; Remove past dates from the list of dates.
+ (setq day-numbers (delq nil (mapcar (lambda(x)
+ (if (>= x today) x nil))
+ day-numbers))))
+ (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
+ (org-compile-prefix-format 'timeline)
+ (org-set-sorting-strategy 'timeline)
+ (if org-agenda-show-log-scoped (push :closed args))
+ (push :timestamp args)
+ (push :deadline args)
+ (push :scheduled args)
+ (push :sexp args)
+ (if dotodo (push :todo args))
+ (insert "Timeline of file " entry "\n")
+ (add-text-properties (point-min) (point)
+ (list 'face 'org-agenda-structure))
+ (org-agenda-mark-header-line (point-min))
+ (while (setq d (pop day-numbers))
+ (if (and (listp d) (eq (car d) :omitted))
+ (progn
+ (setq s (point))
+ (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
+ (put-text-property s (1- (point)) 'face 'org-agenda-structure))
+ (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
+ (if (and (>= d today)
+ dopast
+ past)
+ (progn
+ (setq past nil)
+ (insert (make-string 79 ?-) "\n")))
+ (setq date (calendar-gregorian-from-absolute d))
+ (setq s (point))
+ (setq rtn (and (not emptyp)
+ (apply 'org-agenda-get-day-entries entry
+ date args)))
+ (if (or rtn (equal d today) org-timeline-show-empty-dates)
+ (progn
+ (insert
+ (if (stringp org-agenda-format-date)
+ (format-time-string org-agenda-format-date
+ (org-time-from-absolute date))
+ (funcall org-agenda-format-date date))
+ "\n")
+ (put-text-property s (1- (point)) 'face
+ (org-agenda-get-day-face date))
+ (put-text-property s (1- (point)) 'org-date-line t)
+ (put-text-property s (1- (point)) 'org-agenda-date-header t)
+ (if (equal d today)
+ (put-text-property s (1- (point)) 'org-today t))
+ (and rtn (insert (org-agenda-finalize-entries rtn) "\n"))
+ (put-text-property s (1- (point)) 'day d)))))
+ (goto-char (point-min))
+ (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
+ (point-min)))
+ (add-text-properties (point-min) (point-max) '(org-agenda-type timeline))
+ (org-agenda-finalize)
+ (setq buffer-read-only t)))
+
+(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
+ "Return a list of all relevant day numbers from BEG to END buffer positions.
+If NO-RANGES is non-nil, include only the start and end dates of a range,
+not every single day in the range. If FORCE-TODAY is non-nil, make
+sure that TODAY is included in the list. If INACTIVE is non-nil, also
+inactive time stamps (those in square brackets) are included.
+When EMPTY is non-nil, also include days without any entries."
+ (let ((re (concat
+ (if pre-re pre-re "")
+ (if inactive org-ts-regexp-both org-ts-regexp)))
+ dates dates1 date day day1 day2 ts1 ts2 pos)
+ (if force-today
+ (setq dates (list (org-today))))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (setq day (time-to-days (org-time-string-to-time
+ (substring (match-string 1) 0 10)
+ (current-buffer) (match-beginning 0))))
+ (or (memq day dates) (push day dates)))
+ (unless no-ranges
+ (goto-char beg)
+ (while (re-search-forward org-tr-regexp end t)
+ (setq pos (match-beginning 0))
+ (setq ts1 (substring (match-string 1) 0 10)
+ ts2 (substring (match-string 2) 0 10)
+ day1 (time-to-days (org-time-string-to-time
+ ts1 (current-buffer) pos))
+ day2 (time-to-days (org-time-string-to-time
+ ts2 (current-buffer) pos)))
+ (while (< (setq day1 (1+ day1)) day2)
+ (or (memq day1 dates) (push day1 dates)))))
+ (setq dates (sort dates '<))
+ (when empty
+ (while (setq day (pop dates))
+ (setq day2 (car dates))
+ (push day dates1)
+ (when (and day2 empty)
+ (if (or (eq empty t)
+ (and (numberp empty) (<= (- day2 day) empty)))
+ (while (< (setq day (1+ day)) day2)
+ (push (list day) dates1))
+ (push (cons :omitted (- day2 day)) dates1))))
+ (setq dates (nreverse dates1)))
+ dates)))
+
+;;; Agenda Daily/Weekly
+
+(defvar org-agenda-start-day nil ; dynamically scoped parameter
+ "Start day for the agenda view.
+Custom commands can set this variable in the options section.")
+(defvar org-starting-day nil) ; local variable in the agenda buffer
+(defvar org-arg-loc nil) ; local variable
+
+(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
+ "List of types searched for when creating the daily/weekly agenda.
+This variable is a list of symbols that controls the types of
+items that appear in the daily/weekly agenda. Allowed symbols in this
+list are are
+
+ :timestamp List items containing a date stamp or date range matching
+ the selected date. This includes sexp entries in
+ angular brackets.
+
+ :sexp List entries resulting from plain diary-like sexps.
+
+ :deadline List deadline due on that date. When the date is today,
+ also list any deadlines past due, or due within
+ `org-deadline-warning-days'. `:deadline' must appear before
+ `:scheduled' if the setting of
+ `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
+ any effect.
+
+ :scheduled List all items which are scheduled for the given date.
+ The diary for *today* also contains items which were
+ scheduled earlier and are not yet marked DONE.
+
+By default, all four types are turned on.
+
+Never set this variable globally using `setq', because then it
+will apply to all future agenda commands. Instead, bind it with
+`let' to scope it dynamically into the agenda-constructing
+command. A good way to set it is through options in
+`org-agenda-custom-commands'. For a more flexible (though
+somewhat less efficient) way of determining what is included in
+the daily/weekly agenda, see `org-agenda-skip-function'.")
+
+(defvar org-agenda-buffer-tmp-name nil)
+;;;###autoload
+(defun org-agenda-list (&optional arg start-day span)
+ "Produce a daily/weekly view from all files in variable `org-agenda-files'.
+The view will be for the current day or week, but from the overview buffer
+you will be able to go to other days/weeks.
+
+With a numeric prefix argument in an interactive call, the agenda will
+span ARG days. Lisp programs should instead specify SPAN to change
+the number of days. SPAN defaults to `org-agenda-span'.
+
+START-DAY defaults to TODAY, or to the most recent match for the weekday
+given in `org-agenda-start-on-weekday'."
+ (interactive "P")
+ (if org-agenda-overriding-arguments
+ (setq arg (car org-agenda-overriding-arguments)
+ start-day (nth 1 org-agenda-overriding-arguments)
+ span (nth 2 org-agenda-overriding-arguments)))
+ (if (and (integerp arg) (> arg 0))
+ (setq span arg arg nil))
+ (catch 'exit
+ (setq org-agenda-buffer-name
+ (or org-agenda-buffer-tmp-name
+ (if org-agenda-sticky
+ (cond ((and org-keys (stringp org-match))
+ (format "*Org Agenda(%s:%s)*" org-keys org-match))
+ (org-keys
+ (format "*Org Agenda(%s)*" org-keys))
+ (t "*Org Agenda(a)*")))
+ org-agenda-buffer-name))
+ (org-agenda-prepare "Day/Week")
+ (setq start-day (or start-day org-agenda-start-day))
+ (if (stringp start-day)
+ ;; Convert to an absolute day number
+ (setq start-day (time-to-days (org-read-date nil t start-day))))
+ (org-compile-prefix-format 'agenda)
+ (org-set-sorting-strategy 'agenda)
+ (let* ((span (org-agenda-ndays-to-span
+ (or span org-agenda-ndays org-agenda-span)))
+ (today (org-today))
+ (sd (or start-day today))
+ (ndays (org-agenda-span-to-ndays span sd))
+ (org-agenda-start-on-weekday
+ (if (eq ndays 7)
+ org-agenda-start-on-weekday))
+ (thefiles (org-agenda-files nil 'ifmode))
+ (files thefiles)
+ (start (if (or (null org-agenda-start-on-weekday)
+ (< ndays 7))
+ sd
+ (let* ((nt (calendar-day-of-week
+ (calendar-gregorian-from-absolute sd)))
+ (n1 org-agenda-start-on-weekday)
+ (d (- nt n1)))
+ (- sd (+ (if (< d 0) 7 0) d)))))
+ (day-numbers (list start))
+ (day-cnt 0)
+ (inhibit-redisplay (not debug-on-error))
+ (org-agenda-show-log-scoped org-agenda-show-log)
+ s e rtn rtnall file date d start-pos end-pos todayp
+ clocktable-start clocktable-end filter)
+ (setq org-agenda-redo-command
+ (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
+ (dotimes (n (1- ndays))
+ (push (1+ (car day-numbers)) day-numbers))
+ (setq day-numbers (nreverse day-numbers))
+ (setq clocktable-start (car day-numbers)
+ clocktable-end (1+ (or (org-last day-numbers) 0)))
+ (org-set-local 'org-starting-day (car day-numbers))
+ (org-set-local 'org-arg-loc arg)
+ (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
+ (unless org-agenda-compact-blocks
+ (let* ((d1 (car day-numbers))
+ (d2 (org-last day-numbers))
+ (w1 (org-days-to-iso-week d1))
+ (w2 (org-days-to-iso-week d2)))
+ (setq s (point))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert (org-agenda-span-name span)
+ "-agenda"
+ (if (< (- d2 d1) 350)
+ (if (= w1 w2)
+ (format " (W%02d)" w1)
+ (format " (W%02d-W%02d)" w1 w2))
+ "")
+ ":\n")))
+ (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
+ 'org-date-line t))
+ (org-agenda-mark-header-line s))
+ (while (setq d (pop day-numbers))
+ (setq date (calendar-gregorian-from-absolute d)
+ s (point))
+ (if (or (setq todayp (= d today))
+ (and (not start-pos) (= d sd)))
+ (setq start-pos (point))
+ (if (and start-pos (not end-pos))
+ (setq end-pos (point))))
+ (setq files thefiles
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (let ((org-agenda-entry-types org-agenda-entry-types))
+ (unless org-agenda-include-deadlines
+ (setq org-agenda-entry-types
+ (delq :deadline org-agenda-entry-types)))
+ (cond
+ ((memq org-agenda-show-log-scoped '(only clockcheck))
+ (setq rtn (org-agenda-get-day-entries
+ file date :closed)))
+ (org-agenda-show-log-scoped
+ (setq rtn (apply 'org-agenda-get-day-entries
+ file date
+ (append '(:closed) org-agenda-entry-types))))
+ (t
+ (setq rtn (apply 'org-agenda-get-day-entries
+ file date
+ org-agenda-entry-types)))))
+ (setq rtnall (append rtnall rtn)))) ;; all entries
+ (if org-agenda-include-diary
+ (let ((org-agenda-search-headline-for-time t))
+ (require 'diary-lib)
+ (setq rtn (org-get-entries-from-diary date))
+ (setq rtnall (append rtnall rtn))))
+ (if (or rtnall org-agenda-show-all-dates)
+ (progn
+ (setq day-cnt (1+ day-cnt))
+ (insert
+ (if (stringp org-agenda-format-date)
+ (format-time-string org-agenda-format-date
+ (org-time-from-absolute date))
+ (funcall org-agenda-format-date date))
+ "\n")
+ (put-text-property s (1- (point)) 'face
+ (org-agenda-get-day-face date))
+ (put-text-property s (1- (point)) 'org-date-line t)
+ (put-text-property s (1- (point)) 'org-agenda-date-header t)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
+ (when todayp
+ (put-text-property s (1- (point)) 'org-today t))
+ (setq rtnall
+ (org-agenda-add-time-grid-maybe rtnall ndays todayp))
+ (if rtnall (insert ;; all entries
+ (org-agenda-finalize-entries rtnall)
+ "\n"))
+ (put-text-property s (1- (point)) 'day d)
+ (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
+ (when (and org-agenda-clockreport-mode clocktable-start)
+ (let ((org-agenda-files (org-agenda-files nil 'ifmode))
+ ;; the above line is to ensure the restricted range!
+ (p (copy-sequence org-agenda-clockreport-parameter-plist))
+ tbl)
+ (setq p (org-plist-delete p :block))
+ (setq p (plist-put p :tstart clocktable-start))
+ (setq p (plist-put p :tend clocktable-end))
+ (setq p (plist-put p :scope 'agenda))
+ (when (and (eq org-agenda-clockreport-mode 'with-filter)
+ (setq filter (or org-agenda-tag-filter-while-redo
+ (get 'org-agenda-tag-filter :preset-filter))))
+ (setq p (plist-put p :tags (mapconcat (lambda (x)
+ (if (string-match "[<>=]" x)
+ ""
+ x))
+ filter ""))))
+ (setq tbl (apply 'org-get-clocktable p))
+ (insert tbl)))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (unless (and (pos-visible-in-window-p (point-min))
+ (pos-visible-in-window-p (point-max)))
+ (goto-char (1- (point-max)))
+ (recenter -1)
+ (if (not (pos-visible-in-window-p (or start-pos 1)))
+ (progn
+ (goto-char (or start-pos 1))
+ (recenter 1))))
+ (goto-char (or start-pos 1))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type agenda
+ org-last-args (,arg ,start-day ,span)
+ org-redo-cmd ,org-agenda-redo-command
+ org-serie-cmd ,org-cmd))
+ (if (eq org-agenda-show-log-scoped 'clockcheck)
+ (org-agenda-show-clocking-issues))
+ (org-agenda-finalize)
+ (setq buffer-read-only t)
+ (message ""))))
+
+(defun org-agenda-ndays-to-span (n)
+ "Return a span symbol for a span of N days, or N if none matches."
+ (cond ((symbolp n) n)
+ ((= n 1) 'day)
+ ((= n 7) 'week)
+ (t n)))
+
+(defun org-agenda-span-to-ndays (span &optional start-day)
+ "Return ndays from SPAN, possibly starting at START-DAY."
+ (cond ((numberp span) span)
+ ((eq span 'day) 1)
+ ((eq span 'week) 7)
+ ((eq span 'month)
+ (let ((date (calendar-gregorian-from-absolute start-day)))
+ (calendar-last-day-of-month (car date) (caddr date))))
+ ((eq span 'year)
+ (let ((date (calendar-gregorian-from-absolute start-day)))
+ (if (calendar-leap-year-p (caddr date)) 366 365)))))
+
+(defun org-agenda-span-name (span)
+ "Return a SPAN name."
+ (if (null span)
+ ""
+ (if (symbolp span)
+ (capitalize (symbol-name span))
+ (format "%d days" span))))
+
+;;; Agenda word search
+
+(defvar org-agenda-search-history nil)
+
+(defvar org-search-syntax-table nil
+ "Special syntax table for org-mode search.
+In this table, we have single quotes not as word constituents, to
+that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
+
+(defvar org-mode-syntax-table) ; From org.el
+(defun org-search-syntax-table ()
+ (unless org-search-syntax-table
+ (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
+ (modify-syntax-entry ?' "." org-search-syntax-table)
+ (modify-syntax-entry ?` "." org-search-syntax-table))
+ org-search-syntax-table)
+
+(defvar org-agenda-last-search-view-search-was-boolean nil)
+
+;;;###autoload
+(defun org-search-view (&optional todo-only string edit-at)
+ "Show all entries that contain a phrase or words or regular expressions.
+
+With optional prefix argument TODO-ONLY, only consider entries that are
+TODO entries. The argument STRING can be used to pass a default search
+string into this function. If EDIT-AT is non-nil, it means that the
+user should get a chance to edit this string, with cursor at position
+EDIT-AT.
+
+The search string can be viewed either as a phrase that should be found as
+is, or it can be broken into a number of snippets, each of which must match
+in a Boolean way to select an entry. The default depends on the variable
+`org-agenda-search-view-always-boolean'.
+Even if this is turned off (the default) you can always switch to
+Boolean search dynamically by preceding the first word with \"+\" or \"-\".
+
+The default is a direct search of the whole phrase, where each space in
+the search string can expand to an arbitrary amount of whitespace,
+including newlines.
+
+If using a Boolean search, the search string is split on whitespace and
+each snippet is searched separately, with logical AND to select an entry.
+Words prefixed with a minus must *not* occur in the entry. Words without
+a prefix or prefixed with a plus must occur in the entry. Matching is
+case-insensitive. Words are enclosed by word delimiters (i.e. they must
+match whole words, not parts of a word) if
+`org-agenda-search-view-force-full-words' is set (default is nil).
+
+Boolean search snippets enclosed by curly braces are interpreted as
+regular expressions that must or (when preceded with \"-\") must not
+match in the entry. Snippets enclosed into double quotes will be taken
+as a whole, to include whitespace.
+
+- If the search string starts with an asterisk, search only in headlines.
+- If (possibly after the leading star) the search string starts with an
+ exclamation mark, this also means to look at TODO entries only, an effect
+ that can also be achieved with a prefix argument.
+- If (possibly after star and exclamation mark) the search string starts
+ with a colon, this will mean that the (non-regexp) snippets of the
+ Boolean search must match as full words.
+
+This command searches the agenda files, and in addition the files listed
+in `org-agenda-text-search-extra-files'."
+ (interactive "P")
+ (if org-agenda-overriding-arguments
+ (setq todo-only (car org-agenda-overriding-arguments)
+ string (nth 1 org-agenda-overriding-arguments)
+ edit-at (nth 2 org-agenda-overriding-arguments)))
+ (let* ((props (list 'face nil
+ 'done-face 'org-agenda-done
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'mouse-face 'highlight
+ 'help-echo (format "mouse-2 or RET jump to location")))
+ (full-words org-agenda-search-view-force-full-words)
+ (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
+ regexp rtn rtnall files file pos
+ marker category category-pos tags c neg re boolean
+ ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
+ (unless (and (not edit-at)
+ (stringp string)
+ (string-match "\\S-" string))
+ (setq string (read-string
+ (if org-agenda-search-view-always-boolean
+ "[+-]Word/{Regexp} ...: "
+ "Phrase or [+-]Word/{Regexp} ...: ")
+ (cond
+ ((integerp edit-at) (cons string edit-at))
+ (edit-at string))
+ 'org-agenda-search-history)))
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp string)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "S") "s")) string)
+ (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
+ (org-agenda-prepare "SEARCH")
+ (org-compile-prefix-format 'search)
+ (org-set-sorting-strategy 'search)
+ (setq org-agenda-redo-command
+ (list 'org-search-view (if todo-only t nil)
+ (list 'if 'current-prefix-arg nil string)))
+ (setq org-agenda-query-string string)
+ (if (equal (string-to-char string) ?*)
+ (setq hdl-only t
+ words (substring string 1))
+ (setq words string))
+ (when (equal (string-to-char words) ?!)
+ (setq todo-only t
+ words (substring words 1)))
+ (when (equal (string-to-char words) ?:)
+ (setq full-words t
+ words (substring words 1)))
+ (if (or org-agenda-search-view-always-boolean
+ (member (string-to-char words) '(?- ?+ ?\{)))
+ (setq boolean t))
+ (setq words (org-split-string words))
+ (let (www w)
+ (while (setq w (pop words))
+ (while (and (string-match "\\\\\\'" w) words)
+ (setq w (concat (substring w 0 -1) " " (pop words))))
+ (push w www))
+ (setq words (nreverse www) www nil)
+ (while (setq w (pop words))
+ (when (and (string-match "\\`[-+]?{" w)
+ (not (string-match "}\\'" w)))
+ (while (and words (not (string-match "}\\'" (car words))))
+ (setq w (concat w " " (pop words))))
+ (setq w (concat w " " (pop words))))
+ (push w www))
+ (setq words (nreverse www)))
+ (setq org-agenda-last-search-view-search-was-boolean boolean)
+ (when boolean
+ (let (wds w)
+ (while (setq w (pop words))
+ (if (or (equal (substring w 0 1) "\"")
+ (and (> (length w) 1)
+ (member (substring w 0 1) '("+" "-"))
+ (equal (substring w 1 2) "\"")))
+ (while (and words (not (equal (substring w -1) "\"")))
+ (setq w (concat w " " (pop words)))))
+ (and (string-match "\\`\\([-+]?\\)\"" w)
+ (setq w (replace-match "\\1" nil nil w)))
+ (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
+ (push w wds))
+ (setq words (nreverse wds))))
+ (if boolean
+ (mapc (lambda (w)
+ (setq c (string-to-char w))
+ (if (equal c ?-)
+ (setq neg t w (substring w 1))
+ (if (equal c ?+)
+ (setq neg nil w (substring w 1))
+ (setq neg nil)))
+ (if (string-match "\\`{.*}\\'" w)
+ (setq re (substring w 1 -1))
+ (if full-words
+ (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
+ (setq re (regexp-quote (downcase w)))))
+ (if neg (push re regexps-) (push re regexps+)))
+ words)
+ (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
+ regexps+))
+ (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
+ (if (not regexps+)
+ (setq regexp org-outline-regexp-bol)
+ (setq regexp (pop regexps+))
+ (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
+ regexp))))
+ (setq files (org-agenda-files nil 'ifmode))
+ (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
+ (pop org-agenda-text-search-extra-files)
+ (setq files (org-add-archive-files files)))
+ (setq files (append files org-agenda-text-search-extra-files)
+ rtnall nil)
+ (while (setq file (pop files))
+ (setq ee nil)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ (if (not buffer)
+ ;; If file does not exist, make sure an error message is sent
+ (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
+ file))))
+ (with-current-buffer buffer
+ (with-syntax-table (org-search-syntax-table)
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (let ((case-fold-search t))
+ (save-excursion
+ (save-restriction
+ (if org-agenda-restrict
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ (goto-char (point-min))
+ (unless (or (org-at-heading-p)
+ (outline-next-heading))
+ (throw 'nextfile t))
+ (goto-char (max (point-min) (1- (point))))
+ (while (re-search-forward regexp nil t)
+ (org-back-to-heading t)
+ (skip-chars-forward "* ")
+ (setq beg (point-at-bol)
+ beg1 (point)
+ end (progn (outline-next-heading) (point)))
+ (catch :skip
+ (goto-char beg)
+ (org-agenda-skip)
+ (setq str (buffer-substring-no-properties
+ (point-at-bol)
+ (if hdl-only (point-at-eol) end)))
+ (mapc (lambda (wr) (when (string-match wr str)
+ (goto-char (1- end))
+ (throw :skip t)))
+ regexps-)
+ (mapc (lambda (wr) (unless (string-match wr str)
+ (goto-char (1- end))
+ (throw :skip t)))
+ (if todo-only
+ (cons (concat "^\*+[ \t]+" org-not-done-regexp)
+ regexps+)
+ regexps+))
+ (goto-char beg)
+ (setq marker (org-agenda-new-marker (point))
+ category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position)
+ tags (org-get-tags-at (point))
+ txt (org-agenda-format-item
+ ""
+ (buffer-substring-no-properties
+ beg1 (point-at-eol))
+ category tags t))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'priority 1000 'org-category category
+ 'org-category-position category-pos
+ 'type "search")
+ (push txt ee)
+ (goto-char (1- end))))))))))
+ (setq rtn (nreverse ee))
+ (setq rtnall (append rtnall rtn)))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Search words: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure))
+ (setq pos (point))
+ (insert string "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
+ (add-text-properties pos (1- (point))
+ (list 'face 'org-agenda-structure))))
+ (org-agenda-mark-header-line (point-min))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type search
+ org-last-args (,todo-only ,string ,edit-at)
+ org-redo-cmd ,org-agenda-redo-command
+ org-serie-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
+
+;;; Agenda TODO list
+
+(defvar org-select-this-todo-keyword nil)
+(defvar org-last-arg nil)
+
+;;;###autoload
+(defun org-todo-list (&optional arg)
+ "Show all (not done) TODO entries from all agenda file in a single list.
+The prefix arg can be used to select a specific TODO keyword and limit
+the list to these. When using \\[universal-argument], you will be prompted
+for a keyword. A numeric prefix directly selects the Nth keyword in
+`org-todo-keywords-1'."
+ (interactive "P")
+ (if org-agenda-overriding-arguments
+ (setq arg org-agenda-overriding-arguments))
+ (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
+ (let* ((today (org-today))
+ (date (calendar-gregorian-from-absolute today))
+ (kwds org-todo-keywords-for-agenda)
+ (completion-ignore-case t)
+ (org-select-this-todo-keyword
+ (if (stringp arg) arg
+ (and arg (integerp arg) (> arg 0)
+ (nth (1- arg) kwds))))
+ rtn rtnall files file pos)
+ (when (equal arg '(4))
+ (setq org-select-this-todo-keyword
+ (org-icompleting-read "Keyword (or KWD1|K2D2|...): "
+ (mapcar 'list kwds) nil nil)))
+ (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp org-select-this-todo-keyword)
+ (format "*Org Agenda(%s:%s)*" (or org-keys "t")
+ org-select-this-todo-keyword)
+ (format "*Org Agenda(%s)*" (or org-keys "t")))))
+ (org-agenda-prepare "TODO")
+ (org-compile-prefix-format 'todo)
+ (org-set-sorting-strategy 'todo)
+ (setq org-agenda-redo-command
+ `(org-todo-list (or (and (numberp current-prefix-arg)
+ current-prefix-arg)
+ ,org-select-this-todo-keyword
+ current-prefix-arg ,arg)))
+ (setq files (org-agenda-files nil 'ifmode)
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq rtn (org-agenda-get-day-entries file date :todo))
+ (setq rtnall (append rtnall rtn))))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Global list of TODO items of type: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure
+ 'short-heading
+ (concat "ToDo: "
+ (or org-select-this-todo-keyword "ALL"))))
+ (org-agenda-mark-header-line (point-min))
+ (setq pos (point))
+ (insert (or org-select-this-todo-keyword "ALL") "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Available with `N r': (0)[ALL]")
+ (let ((n 0) s)
+ (mapc (lambda (x)
+ (setq s (format "(%d)%s" (setq n (1+ n)) x))
+ (if (> (+ (current-column) (string-width s) 1) (frame-width))
+ (insert "\n "))
+ (insert " " s))
+ kwds))
+ (insert "\n"))
+ (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+ (org-agenda-mark-header-line (point-min))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type todo
+ org-last-args ,arg
+ org-redo-cmd ,org-agenda-redo-command
+ org-serie-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
+
+;;; Agenda tags match
+
+;;;###autoload
+(defun org-tags-view (&optional todo-only match)
+ "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
+The prefix arg TODO-ONLY limits the search to TODO entries."
+ (interactive "P")
+ (if org-agenda-overriding-arguments
+ (setq todo-only (car org-agenda-overriding-arguments)
+ match (nth 1 org-agenda-overriding-arguments)))
+ (let* ((org-tags-match-list-sublevels
+ org-tags-match-list-sublevels)
+ (completion-ignore-case t)
+ rtn rtnall files file pos matcher
+ buffer)
+ (when (and (stringp match) (not (string-match "\\S-" match)))
+ (setq match nil))
+ (setq matcher (org-make-tags-matcher match)
+ match (car matcher) matcher (cdr matcher))
+ (catch 'exit
+ (if org-agenda-sticky
+ (setq org-agenda-buffer-name
+ (if (stringp match)
+ (format "*Org Agenda(%s:%s)*"
+ (or org-keys (or (and todo-only "M") "m")) match)
+ (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
+ (org-agenda-prepare (concat "TAGS " match))
+ (org-compile-prefix-format 'tags)
+ (org-set-sorting-strategy 'tags)
+ (setq org-agenda-query-string match)
+ (setq org-agenda-redo-command
+ (list 'org-tags-view `(quote ,todo-only)
+ (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
+ (setq files (org-agenda-files nil 'ifmode)
+ rtnall nil)
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (setq buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ (if (not buffer)
+ ;; If file does not exist, error message to agenda
+ (setq rtn (list
+ (format "ORG-AGENDA-ERROR: No such org-file %s" file))
+ rtnall (append rtnall rtn))
+ (with-current-buffer buffer
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (save-excursion
+ (save-restriction
+ (if org-agenda-restrict
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ (setq rtn (org-scan-tags 'agenda matcher todo-only))
+ (setq rtnall (append rtnall rtn))))))))
+ (if org-agenda-overriding-header
+ (insert (org-add-props (copy-sequence org-agenda-overriding-header)
+ nil 'face 'org-agenda-structure) "\n")
+ (insert "Headlines with TAGS match: ")
+ (add-text-properties (point-min) (1- (point))
+ (list 'face 'org-agenda-structure
+ 'short-heading
+ (concat "Match: " match)))
+ (setq pos (point))
+ (insert match "\n")
+ (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (setq pos (point))
+ (unless org-agenda-multi
+ (insert "Press `C-u r' to search again with new search string\n"))
+ (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+ (org-agenda-mark-header-line (point-min))
+ (when rtnall
+ (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (goto-char (point-min))
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (add-text-properties (point-min) (point-max)
+ `(org-agenda-type tags
+ org-last-args (,todo-only ,match)
+ org-redo-cmd ,org-agenda-redo-command
+ org-serie-cmd ,org-cmd))
+ (org-agenda-finalize)
+ (setq buffer-read-only t))))
+
+;;; Agenda Finding stuck projects
+
+(defvar org-agenda-skip-regexp nil
+ "Regular expression used in skipping subtrees for the agenda.
+This is basically a temporary global variable that can be set and then
+used by user-defined selections using `org-agenda-skip-function'.")
+
+(defvar org-agenda-overriding-header nil
+ "When set during agenda, todo and tags searches it replaces the header.
+This variable should not be set directly, but custom commands can bind it
+in the options section.")
+
+(defun org-agenda-skip-entry-when-regexp-matches ()
+ "Check if the current entry contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of this entry, causing agenda commands
+to skip the entry but continuing the search in the subtree. This is a
+function that can be put into `org-agenda-skip-function' for the duration
+of a command."
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip end)))
+
+(defun org-agenda-skip-subtree-when-regexp-matches ()
+ "Check if the current subtree contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of this tree, causing agenda commands
+to skip this subtree. This is a function that can be put into
+`org-agenda-skip-function' for the duration of a command."
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip end)))
+
+(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
+ "Check if the current subtree contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of the current entry (NOT the tree),
+causing agenda commands to skip the entry but continuing the search in
+the subtree. This is a function that can be put into
+`org-agenda-skip-function' for the duration of a command. An important
+use of this function is for the stuck project list."
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ (entry-end (save-excursion (outline-next-heading) (1- (point))))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip entry-end)))
+
+(defun org-agenda-skip-entry-if (&rest conditions)
+ "Skip entry if any of CONDITIONS is true.
+See `org-agenda-skip-if' for details."
+ (org-agenda-skip-if nil conditions))
+
+(defun org-agenda-skip-subtree-if (&rest conditions)
+ "Skip entry if any of CONDITIONS is true.
+See `org-agenda-skip-if' for details."
+ (org-agenda-skip-if t conditions))
+
+(defun org-agenda-skip-if (subtree conditions)
+ "Checks current entity for CONDITIONS.
+If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
+the entry (i.e. the text before the next heading) is checked.
+
+CONDITIONS is a list of symbols, boolean OR is used to combine the results
+from different tests. Valid conditions are:
+
+scheduled Check if there is a scheduled cookie
+notscheduled Check if there is no scheduled cookie
+deadline Check if there is a deadline
+notdeadline Check if there is no deadline
+timestamp Check if there is a timestamp (also deadline or scheduled)
+nottimestamp Check if there is no timestamp (also deadline or scheduled)
+regexp Check if regexp matches
+notregexp Check if regexp does not match.
+todo Check if TODO keyword matches
+nottodo Check if TODO keyword does not match
+
+The regexp is taken from the conditions list, it must come right after
+the `regexp' or `notregexp' element.
+
+`todo' and `nottodo' accept as an argument a list of todo
+keywords, which may include \"*\" to match any todo keyword.
+
+ (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\"))
+
+would skip all entries with \"TODO\" or \"WAITING\" keywords.
+
+Instead of a list, a keyword class may be given. For example:
+
+ (org-agenda-skip-entry-if 'nottodo 'done)
+
+would skip entries that haven't been marked with any of \"DONE\"
+keywords. Possible classes are: `todo', `done', `any'.
+
+If any of these conditions is met, this function returns the end point of
+the entity, causing the search to continue from there. This is a function
+that can be put into `org-agenda-skip-function' for the duration of a command."
+ (let (beg end m)
+ (org-back-to-heading t)
+ (setq beg (point)
+ end (if subtree
+ (progn (org-end-of-subtree t) (point))
+ (progn (outline-next-heading) (1- (point)))))
+ (goto-char beg)
+ (and
+ (or
+ (and (memq 'scheduled conditions)
+ (re-search-forward org-scheduled-time-regexp end t))
+ (and (memq 'notscheduled conditions)
+ (not (re-search-forward org-scheduled-time-regexp end t)))
+ (and (memq 'deadline conditions)
+ (re-search-forward org-deadline-time-regexp end t))
+ (and (memq 'notdeadline conditions)
+ (not (re-search-forward org-deadline-time-regexp end t)))
+ (and (memq 'timestamp conditions)
+ (re-search-forward org-ts-regexp end t))
+ (and (memq 'nottimestamp conditions)
+ (not (re-search-forward org-ts-regexp end t)))
+ (and (setq m (memq 'regexp conditions))
+ (stringp (nth 1 m))
+ (re-search-forward (nth 1 m) end t))
+ (and (setq m (memq 'notregexp conditions))
+ (stringp (nth 1 m))
+ (not (re-search-forward (nth 1 m) end t)))
+ (and (or
+ (setq m (memq 'nottodo conditions))
+ (setq m (memq 'todo-unblocked conditions))
+ (setq m (memq 'nottodo-unblocked conditions))
+ (setq m (memq 'todo conditions)))
+ (org-agenda-skip-if-todo m end)))
+ end)))
+
+(defun org-agenda-skip-if-todo (args end)
+ "Helper function for `org-agenda-skip-if', do not use it directly.
+ARGS is a list with first element either `todo', `nottodo',
+`todo-unblocked' or `nottodo-unblocked'. The remainder is either
+a list of TODO keywords, or a state symbol `todo' or `done' or
+`any'."
+ (let ((kw (car args))
+ (arg (cadr args))
+ todo-wds todo-re)
+ (setq todo-wds
+ (org-uniquify
+ (cond
+ ((listp arg) ;; list of keywords
+ (if (member "*" arg)
+ (mapcar 'substring-no-properties org-todo-keywords-1)
+ arg))
+ ((symbolp arg) ;; keyword class name
+ (cond
+ ((eq arg 'todo)
+ (org-delete-all org-done-keywords
+ (mapcar 'substring-no-properties
+ org-todo-keywords-1)))
+ ((eq arg 'done) org-done-keywords)
+ ((eq arg 'any)
+ (mapcar 'substring-no-properties org-todo-keywords-1)))))))
+ (setq todo-re
+ (concat "^\\*+[ \t]+\\<\\("
+ (mapconcat 'identity todo-wds "\\|")
+ "\\)\\>"))
+ (cond
+ ((eq kw 'todo) (re-search-forward todo-re end t))
+ ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
+ ((eq kw 'todo-unblocked)
+ (catch 'unblocked
+ (while (re-search-forward todo-re end t)
+ (or (org-entry-blocked-p) (throw 'unblocked t)))
+ nil))
+ ((eq kw 'nottodo-unblocked)
+ (catch 'unblocked
+ (while (re-search-forward todo-re end t)
+ (or (org-entry-blocked-p) (throw 'unblocked nil)))
+ t))
+ )))
+
+;;;###autoload
+(defun org-agenda-list-stuck-projects (&rest ignore)
+ "Create agenda view for projects that are stuck.
+Stuck projects are project that have no next actions. For the definitions
+of what a project is and how to check if it stuck, customize the variable
+`org-stuck-projects'."
+ (interactive)
+ (let* ((org-agenda-skip-function
+ 'org-agenda-skip-entry-when-regexp-matches-in-subtree)
+ ;; We could have used org-agenda-skip-if here.
+ (org-agenda-overriding-header
+ (or org-agenda-overriding-header "List of stuck projects: "))
+ (matcher (nth 0 org-stuck-projects))
+ (todo (nth 1 org-stuck-projects))
+ (todo-wds (if (member "*" todo)
+ (progn
+ (org-agenda-prepare-buffers (org-agenda-files
+ nil 'ifmode))
+ (org-delete-all
+ org-done-keywords-for-agenda
+ (copy-sequence org-todo-keywords-for-agenda)))
+ todo))
+ (todo-re (concat "^\\*+[ \t]+\\("
+ (mapconcat 'identity todo-wds "\\|")
+ "\\)\\>"))
+ (tags (nth 2 org-stuck-projects))
+ (tags-re (if (member "*" tags)
+ (concat org-outline-regexp-bol
+ (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
+ (if tags
+ (concat org-outline-regexp-bol
+ ".*:\\("
+ (mapconcat 'identity tags "\\|")
+ (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
+ (gen-re (nth 3 org-stuck-projects))
+ (re-list
+ (delq nil
+ (list
+ (if todo todo-re)
+ (if tags tags-re)
+ (and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
+ gen-re)))))
+ (setq org-agenda-skip-regexp
+ (if re-list
+ (mapconcat 'identity re-list "\\|")
+ (error "No information how to identify unstuck projects")))
+ (org-tags-view nil matcher)
+ (with-current-buffer org-agenda-buffer-name
+ (setq org-agenda-redo-command
+ `(org-agenda-list-stuck-projects ,current-prefix-arg)))))
+
+;;; Diary integration
+
+(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
+(defvar diary-list-entries-hook)
+(defvar diary-time-regexp)
+(defun org-get-entries-from-diary (date)
+ "Get the (Emacs Calendar) diary entries for DATE."
+ (require 'diary-lib)
+ (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
+ (diary-display-hook '(fancy-diary-display))
+ (diary-display-function 'fancy-diary-display)
+ (pop-up-frames nil)
+ (diary-list-entries-hook
+ (cons 'org-diary-default-entry diary-list-entries-hook))
+ (diary-file-name-prefix-function nil) ; turn this feature off
+ (diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
+ entries
+ (org-disable-agenda-to-diary t))
+ (save-excursion
+ (save-window-excursion
+ (funcall (if (fboundp 'diary-list-entries)
+ 'diary-list-entries 'list-diary-entries)
+ date 1)))
+ (if (not (get-buffer diary-fancy-buffer))
+ (setq entries nil)
+ (with-current-buffer diary-fancy-buffer
+ (setq buffer-read-only nil)
+ (if (zerop (buffer-size))
+ ;; No entries
+ (setq entries nil)
+ ;; Omit the date and other unnecessary stuff
+ (org-agenda-cleanup-fancy-diary)
+ ;; Add prefix to each line and extend the text properties
+ (if (zerop (buffer-size))
+ (setq entries nil)
+ (setq entries (buffer-substring (point-min) (- (point-max) 1)))
+ (setq entries
+ (with-temp-buffer
+ (insert entries) (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
+ (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
+ (replace-match (concat "; " (match-string 1)))))
+ (buffer-string)))))
+ (set-buffer-modified-p nil)
+ (kill-buffer diary-fancy-buffer)))
+ (when entries
+ (setq entries (org-split-string entries "\n"))
+ (setq entries
+ (mapcar
+ (lambda (x)
+ (setq x (org-agenda-format-item "" x "Diary" nil 'time))
+ ;; Extend the text properties to the beginning of the line
+ (org-add-props x (text-properties-at (1- (length x)) x)
+ 'type "diary" 'date date 'face 'org-agenda-diary))
+ entries)))))
+
+(defvar org-agenda-cleanup-fancy-diary-hook nil
+ "Hook run when the fancy diary buffer is cleaned up.")
+
+(defun org-agenda-cleanup-fancy-diary ()
+ "Remove unwanted stuff in buffer created by `fancy-diary-display'.
+This gets rid of the date, the underline under the date, and
+the dummy entry installed by `org-mode' to ensure non-empty diary for each
+date. It also removes lines that contain only whitespace."
+ (goto-char (point-min))
+ (if (looking-at ".*?:[ \t]*")
+ (progn
+ (replace-match "")
+ (re-search-forward "\n=+$" nil t)
+ (replace-match "")
+ (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
+ (re-search-forward "\n=+$" nil t)
+ (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
+ (goto-char (point-min))
+ (while (re-search-forward "^ +\n" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (if (re-search-forward "^Org-mode dummy\n?" nil t)
+ (replace-match ""))
+ (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
+
+;; Make sure entries from the diary have the right text properties.
+(eval-after-load "diary-lib"
+ '(if (boundp 'diary-modify-entry-list-string-function)
+ ;; We can rely on the hook, nothing to do
+ nil
+ ;; Hook not available, must use advice to make this work
+ (defadvice add-to-diary-list (before org-mark-diary-entry activate)
+ "Make the position visible."
+ (if (and org-disable-agenda-to-diary ;; called from org-agenda
+ (stringp string)
+ buffer-file-name)
+ (setq string (org-modify-diary-entry-string string))))))
+
+(defun org-modify-diary-entry-string (string)
+ "Add text properties to string, allowing org-mode to act on it."
+ (org-add-props string nil
+ 'mouse-face 'highlight
+ 'help-echo (if buffer-file-name
+ (format "mouse-2 or RET jump to diary file %s"
+ (abbreviate-file-name buffer-file-name))
+ "")
+ 'org-agenda-diary-link t
+ 'org-marker (org-agenda-new-marker (point-at-bol))))
+
+(defun org-diary-default-entry ()
+ "Add a dummy entry to the diary.
+Needed to avoid empty dates which mess up holiday display."
+ ;; Catch the error if dealing with the new add-to-diary-alist
+ (when org-disable-agenda-to-diary
+ (condition-case nil
+ (org-add-to-diary-list original-date "Org-mode dummy" "")
+ (error
+ (org-add-to-diary-list original-date "Org-mode dummy" "" nil)))))
+
+(defun org-add-to-diary-list (&rest args)
+ (if (fboundp 'diary-add-to-list)
+ (apply 'diary-add-to-list args)
+ (apply 'add-to-diary-list args)))
+
+(defvar org-diary-last-run-time nil)
+
+;;;###autoload
+(defun org-diary (&rest args)
+ "Return diary information from org files.
+This function can be used in a \"sexp\" diary entry in the Emacs calendar.
+It accesses org files and extracts information from those files to be
+listed in the diary. The function accepts arguments specifying what
+items should be listed. For a list of arguments allowed here, see the
+variable `org-agenda-entry-types'.
+
+The call in the diary file should look like this:
+
+ &%%(org-diary) ~/path/to/some/orgfile.org
+
+Use a separate line for each org file to check. Or, if you omit the file name,
+all files listed in `org-agenda-files' will be checked automatically:
+
+ &%%(org-diary)
+
+If you don't give any arguments (as in the example above), the default
+arguments (:deadline :scheduled :timestamp :sexp) are used.
+So the example above may also be written as
+
+ &%%(org-diary :deadline :timestamp :sexp :scheduled)
+
+The function expects the lisp variables `entry' and `date' to be provided
+by the caller, because this is how the calendar works. Don't use this
+function from a program - use `org-agenda-get-day-entries' instead."
+ (when (> (- (org-float-time)
+ org-agenda-last-marker-time)
+ 5)
+ ;; I am not sure if this works with sticky agendas, because the marker
+ ;; list is then no longer a global variable.
+ (org-agenda-reset-markers))
+ (org-compile-prefix-format 'agenda)
+ (org-set-sorting-strategy 'agenda)
+ (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
+ (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
+ (list entry)
+ (org-agenda-files t)))
+ (time (org-float-time))
+ file rtn results)
+ (when (or (not org-diary-last-run-time)
+ (> (- time
+ org-diary-last-run-time)
+ 3))
+ (org-agenda-prepare-buffers files))
+ (setq org-diary-last-run-time time)
+ ;; If this is called during org-agenda, don't return any entries to
+ ;; the calendar. Org Agenda will list these entries itself.
+ (if org-disable-agenda-to-diary (setq files nil))
+ (while (setq file (pop files))
+ (setq rtn (apply 'org-agenda-get-day-entries file date args))
+ (setq results (append results rtn)))
+ (if results
+ (concat (org-agenda-finalize-entries results) "\n"))))
+
+;;; Agenda entry finders
+
+(defun org-agenda-get-day-entries (file date &rest args)
+ "Does the work for `org-diary' and `org-agenda'.
+FILE is the path to a file to be checked for entries. DATE is date like
+the one returned by `calendar-current-date'. ARGS are symbols indicating
+which kind of entries should be extracted. For details about these, see
+the documentation of `org-diary'."
+ (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
+ (let* ((org-startup-folded nil)
+ (org-startup-align-all-tables nil)
+ (buffer (if (file-exists-p file)
+ (org-get-agenda-file-buffer file)
+ (error "No such file %s" file)))
+ arg results rtn deadline-results)
+ (if (not buffer)
+ ;; If file does not exist, make sure an error message ends up in diary
+ (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
+ (with-current-buffer buffer
+ (unless (derived-mode-p 'org-mode)
+ (error "Agenda file %s is not in `org-mode'" file))
+ (setq org-agenda-buffer (or org-agenda-buffer buffer))
+ (let ((case-fold-search nil))
+ (save-excursion
+ (save-restriction
+ (if org-agenda-restrict
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ ;; The way we repeatedly append to `results' makes it O(n^2) :-(
+ (while (setq arg (pop args))
+ (cond
+ ((and (eq arg :todo)
+ (equal date (calendar-gregorian-from-absolute
+ (org-today))))
+ (setq rtn (org-agenda-get-todos))
+ (setq results (append results rtn)))
+ ((eq arg :timestamp)
+ (setq rtn (org-agenda-get-blocks))
+ (setq results (append results rtn))
+ (setq rtn (org-agenda-get-timestamps deadline-results))
+ (setq results (append results rtn)))
+ ((eq arg :sexp)
+ (setq rtn (org-agenda-get-sexps))
+ (setq results (append results rtn)))
+ ((eq arg :scheduled)
+ (setq rtn (org-agenda-get-scheduled deadline-results))
+ (setq results (append results rtn)))
+ ((eq arg :closed)
+ (setq rtn (org-agenda-get-progress))
+ (setq results (append results rtn)))
+ ((eq arg :deadline)
+ (setq rtn (org-agenda-get-deadlines))
+ (setq deadline-results (copy-sequence rtn))
+ (setq results (append results rtn))))))))
+ results))))
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defun org-agenda-get-todos ()
+ "Return the TODO information for agenda display."
+ (let* ((props (list 'face nil
+ 'done-face 'org-agenda-done
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'mouse-face 'highlight
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (regexp (format org-heading-keyword-regexp-format
+ (cond
+ ((and org-select-this-todo-keyword
+ (equal org-select-this-todo-keyword "*"))
+ org-todo-regexp)
+ (org-select-this-todo-keyword
+ (concat "\\("
+ (mapconcat 'identity
+ (org-split-string
+ org-select-this-todo-keyword
+ "|")
+ "\\|") "\\)"))
+ (t org-not-done-regexp))))
+ marker priority category category-pos tags todo-state
+ ee txt beg end)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (save-match-data
+ (beginning-of-line)
+ (org-agenda-skip)
+ (setq beg (point) end (save-excursion (outline-next-heading) (point)))
+ (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
+ (goto-char (1+ beg))
+ (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
+ (throw :skip nil)))
+ (goto-char (match-beginning 2))
+ (setq marker (org-agenda-new-marker (match-beginning 0))
+ category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position)
+ txt (org-trim
+ (buffer-substring (match-beginning 2) (match-end 0)))
+ tags (org-get-tags-at (point))
+ txt (org-agenda-format-item "" txt category tags t)
+ priority (1+ (org-get-priority txt))
+ todo-state (org-get-todo-state))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker
+ 'priority priority 'org-category category
+ 'org-category-position category-pos
+ 'type "todo" 'todo-state todo-state)
+ (push txt ee)
+ (if org-agenda-todo-list-sublevels
+ (goto-char (match-end 2))
+ (org-end-of-subtree 'invisible))))
+ (nreverse ee)))
+
+(defun org-agenda-todo-custom-ignore-p (time n)
+ "Check whether timestamp is farther away than n number of days.
+This function is invoked if `org-agenda-todo-ignore-deadlines',
+`org-agenda-todo-ignore-scheduled' or
+`org-agenda-todo-ignore-timestamp' is set to an integer."
+ (let ((days (org-days-to-time time)))
+ (if (>= n 0)
+ (>= days n)
+ (<= days n))))
+
+;;;###autoload
+(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+ (&optional end)
+ "Do we have a reason to ignore this TODO entry because it has a time stamp?"
+ (when (or org-agenda-todo-ignore-with-date
+ org-agenda-todo-ignore-scheduled
+ org-agenda-todo-ignore-deadlines
+ org-agenda-todo-ignore-timestamp)
+ (setq end (or end (save-excursion (outline-next-heading) (point))))
+ (save-excursion
+ (or (and org-agenda-todo-ignore-with-date
+ (re-search-forward org-ts-regexp end t))
+ (and org-agenda-todo-ignore-scheduled
+ (re-search-forward org-scheduled-time-regexp end t)
+ (cond
+ ((eq org-agenda-todo-ignore-scheduled 'future)
+ (> (org-days-to-time (match-string 1)) 0))
+ ((eq org-agenda-todo-ignore-scheduled 'past)
+ (<= (org-days-to-time (match-string 1)) 0))
+ ((numberp org-agenda-todo-ignore-scheduled)
+ (org-agenda-todo-custom-ignore-p
+ (match-string 1) org-agenda-todo-ignore-scheduled))
+ (t)))
+ (and org-agenda-todo-ignore-deadlines
+ (re-search-forward org-deadline-time-regexp end t)
+ (cond
+ ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
+ ((eq org-agenda-todo-ignore-deadlines 'far)
+ (not (org-deadline-close (match-string 1))))
+ ((eq org-agenda-todo-ignore-deadlines 'future)
+ (> (org-days-to-time (match-string 1)) 0))
+ ((eq org-agenda-todo-ignore-deadlines 'past)
+ (<= (org-days-to-time (match-string 1)) 0))
+ ((numberp org-agenda-todo-ignore-deadlines)
+ (org-agenda-todo-custom-ignore-p
+ (match-string 1) org-agenda-todo-ignore-deadlines))
+ (t (org-deadline-close (match-string 1)))))
+ (and org-agenda-todo-ignore-timestamp
+ (let ((buffer (current-buffer))
+ (regexp
+ (concat
+ org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
+ (start (point)))
+ ;; Copy current buffer into a temporary one
+ (with-temp-buffer
+ (insert-buffer-substring buffer start end)
+ (goto-char (point-min))
+ ;; Delete SCHEDULED and DEADLINE items
+ (while (re-search-forward regexp end t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ ;; No search for timestamp left
+ (when (re-search-forward org-ts-regexp nil t)
+ (cond
+ ((eq org-agenda-todo-ignore-timestamp 'future)
+ (> (org-days-to-time (match-string 1)) 0))
+ ((eq org-agenda-todo-ignore-timestamp 'past)
+ (<= (org-days-to-time (match-string 1)) 0))
+ ((numberp org-agenda-todo-ignore-timestamp)
+ (org-agenda-todo-custom-ignore-p
+ (match-string 1) org-agenda-todo-ignore-timestamp))
+ (t))))))))))
+
+(defconst org-agenda-no-heading-message
+ "No heading for this item in buffer or region.")
+
+(defun org-agenda-get-timestamps (&optional deadline-results)
+ "Return the date stamp information for agenda display."
+ (let* ((props (list 'face 'org-agenda-calendar-event
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'mouse-face 'highlight
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (d1 (calendar-absolute-from-gregorian date))
+ mm
+ (deadline-position-alist
+ (mapcar (lambda (a) (and (setq mm (get-text-property
+ 0 'org-hd-marker a))
+ (cons (marker-position mm) a)))
+ deadline-results))
+ (remove-re org-ts-regexp)
+ (regexp
+ (concat
+ (if org-agenda-include-inactive-timestamps "[[<]" "<")
+ (regexp-quote
+ (substring
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time ; DATE bound by calendar
+ (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
+ 1 11))
+ "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
+ "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
+ marker hdmarker deadlinep scheduledp clockp closedp inactivep
+ donep tmp priority category category-pos ee txt timestr tags
+ b0 b3 e3 head todo-state end-of-match show-all warntime)
+ (goto-char (point-min))
+ (while (setq end-of-match (re-search-forward regexp nil t))
+ (setq b0 (match-beginning 0)
+ b3 (match-beginning 3) e3 (match-end 3)
+ todo-state (save-match-data (ignore-errors (org-get-todo-state)))
+ show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all)))
+ (catch :skip
+ (and (org-at-date-range-p) (throw :skip nil))
+ (org-agenda-skip)
+ (if (and (match-end 1)
+ (not (= d1 (org-time-string-to-absolute
+ (match-string 1) d1 nil show-all
+ (current-buffer) b0))))
+ (throw :skip nil))
+ (if (and e3
+ (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
+ (throw :skip nil))
+ (setq tmp (buffer-substring (max (point-min)
+ (- b0 org-ds-keyword-length))
+ b0)
+ timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
+ inactivep (= (char-after b0) ?\[)
+ deadlinep (string-match org-deadline-regexp tmp)
+ scheduledp (string-match org-scheduled-regexp tmp)
+ closedp (and org-agenda-include-inactive-timestamps
+ (string-match org-closed-string tmp))
+ clockp (and org-agenda-include-inactive-timestamps
+ (or (string-match org-clock-string tmp)
+ (string-match "]-+\\'" tmp)))
+ warntime (org-entry-get (point) "APPT_WARNTIME")
+ donep (member todo-state org-done-keywords))
+ (if (or scheduledp deadlinep closedp clockp
+ (and donep org-agenda-skip-timestamp-if-done))
+ (throw :skip t))
+ (if (string-match ">" timestr)
+ ;; substring should only run to end of time stamp
+ (setq timestr (substring timestr 0 (match-end 0))))
+ (setq marker (org-agenda-new-marker b0)
+ category (org-get-category b0)
+ category-pos (get-text-property b0 'org-category-position))
+ (save-excursion
+ (if (not (re-search-backward org-outline-regexp-bol nil t))
+ (setq txt org-agenda-no-heading-message)
+ (goto-char (match-beginning 0))
+ (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown)
+ (assoc (point) deadline-position-alist))
+ (throw :skip nil))
+ (setq hdmarker (org-agenda-new-marker)
+ tags (org-get-tags-at))
+ (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (setq head (or (match-string 1) ""))
+ (setq txt (org-agenda-format-item
+ (if inactivep org-agenda-inactive-leader nil)
+ head category tags timestr
+ remove-re t)))
+ (setq priority (org-get-priority txt))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker hdmarker)
+ (org-add-props txt nil 'priority priority
+ 'org-category category 'date date
+ 'org-category-position category-pos
+ 'todo-state todo-state
+ 'warntime warntime
+ 'type "timestamp")
+ (push txt ee))
+ (if org-agenda-skip-additional-timestamps-same-entry
+ (outline-next-heading)
+ (goto-char end-of-match))))
+ (nreverse ee)))
+
+(defun org-agenda-get-sexps ()
+ "Return the sexp information for agenda display."
+ (require 'diary-lib)
+ (let* ((props (list 'face 'org-agenda-calendar-sexp
+ 'mouse-face 'highlight
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (regexp "^&?%%(")
+ marker category extra category-pos ee txt tags entry
+ result beg b sexp sexp-entry todo-state warntime)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (setq beg (match-beginning 0))
+ (goto-char (1- (match-end 0)))
+ (setq b (point))
+ (forward-sexp 1)
+ (setq sexp (buffer-substring b (point)))
+ (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
+ (org-trim (match-string 1))
+ ""))
+ (setq result (org-diary-sexp-entry sexp sexp-entry date))
+ (when result
+ (setq marker (org-agenda-new-marker beg)
+ category (org-get-category beg)
+ category-pos (get-text-property beg 'org-category-position)
+ tags (save-excursion (org-backward-heading-same-level 0)
+ (org-get-tags-at))
+ todo-state (org-get-todo-state)
+ warntime (org-entry-get (point) "APPT_WARNTIME"))
+
+ (dolist (r (if (stringp result)
+ (list result)
+ result)) ;; we expect a list here
+ (when (and org-agenda-diary-sexp-prefix
+ (string-match org-agenda-diary-sexp-prefix r))
+ (setq extra (match-string 0 r)
+ r (replace-match "" nil nil r)))
+ (if (string-match "\\S-" r)
+ (setq txt r)
+ (setq txt "SEXP entry returned empty string"))
+
+ (setq txt (org-agenda-format-item
+ extra txt category tags 'time))
+ (org-add-props txt props 'org-marker marker)
+ (org-add-props txt nil
+ 'org-category category 'date date 'todo-state todo-state
+ 'org-category-position category-pos 'tags tags
+ 'type "sexp" 'warntime warntime)
+ (push txt ee)))))
+ (nreverse ee)))
+
+;; Calendar sanity: define some functions that are independent of
+;; `calendar-date-style'.
+;; Normally I would like to use ISO format when calling the diary functions,
+;; but to make sure we still have Emacs 22 compatibility we bind
+;; also `european-calendar-style' and use european format
+(defun org-anniversary (year month day &optional mark)
+ "Like `diary-anniversary', but with fixed (ISO) order of arguments."
+ (org-no-warnings
+ (let ((calendar-date-style 'european) (european-calendar-style t))
+ (diary-anniversary day month year mark))))
+(defun org-cyclic (N year month day &optional mark)
+ "Like `diary-cyclic', but with fixed (ISO) order of arguments."
+ (org-no-warnings
+ (let ((calendar-date-style 'european) (european-calendar-style t))
+ (diary-cyclic N day month year mark))))
+(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
+ "Like `diary-block', but with fixed (ISO) order of arguments."
+ (org-no-warnings
+ (let ((calendar-date-style 'european) (european-calendar-style t))
+ (diary-block D1 M1 Y1 D2 M2 Y2 mark))))
+(defun org-date (year month day &optional mark)
+ "Like `diary-date', but with fixed (ISO) order of arguments."
+ (org-no-warnings
+ (let ((calendar-date-style 'european) (european-calendar-style t))
+ (diary-date day month year mark))))
+(defalias 'org-float 'diary-float)
+
+;; Define the` org-class' function
+(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
+ "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
+DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
+SKIP-WEEKS is any number of ISO weeks in the block period for which the
+item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
+`holidays', then any date that is known by the Emacs calendar to be a
+holiday will also be skipped."
+ (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
+ (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
+ (d (calendar-absolute-from-gregorian date)))
+ (and
+ (<= date1 d)
+ (<= d date2)
+ (= (calendar-day-of-week date) dayname)
+ (or (not skip-weeks)
+ (progn
+ (require 'cal-iso)
+ (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
+ (not (and (memq 'holidays skip-weeks)
+ (calendar-check-holidays date)))
+ entry)))
+
+(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
+ "Like `org-class', but honor `calendar-date-style'.
+The order of the first 2 times 3 arguments depends on the variable
+`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
+So for American calendars, give this as MONTH DAY YEAR, for European as
+DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
+DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
+is any number of ISO weeks in the block period for which the item should
+be skipped.
+
+This function is here only for backward compatibility and it is deprecated,
+please use `org-class' instead."
+ (let* ((date1 (org-order-calendar-date-args m1 d1 y1))
+ (date2 (org-order-calendar-date-args m2 d2 y2)))
+ (org-class
+ (nth 2 date1) (car date1) (nth 1 date1)
+ (nth 2 date2) (car date2) (nth 1 date2)
+ dayname skip-weeks)))
+(make-obsolete 'org-diary-class 'org-class "")
+
+(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
+(defalias 'org-get-closed 'org-agenda-get-progress)
+(defun org-agenda-get-progress ()
+ "Return the logged TODO entries for agenda display."
+ (let* ((props (list 'mouse-face 'highlight
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (items (if (consp org-agenda-show-log-scoped)
+ org-agenda-show-log-scoped
+ (if (eq org-agenda-show-log-scoped 'clockcheck)
+ '(clock)
+ org-agenda-log-mode-items)))
+ (parts
+ (delq nil
+ (list
+ (if (memq 'closed items) (concat "\\<" org-closed-string))
+ (if (memq 'clock items) (concat "\\<" org-clock-string))
+ (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
+ (parts-re (if parts (mapconcat 'identity parts "\\|")
+ (error "`org-agenda-log-mode-items' is empty")))
+ (regexp (concat
+ "\\(" parts-re "\\)"
+ " *\\["
+ (regexp-quote
+ (substring
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time ; DATE bound by calendar
+ (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
+ 1 11))))
+ (org-agenda-search-headline-for-time nil)
+ marker hdmarker priority category category-pos tags closedp
+ statep clockp state ee txt extra timestr rest clocked)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (setq marker (org-agenda-new-marker (match-beginning 0))
+ closedp (equal (match-string 1) org-closed-string)
+ statep (equal (string-to-char (match-string 1)) ?-)
+ clockp (not (or closedp statep))
+ state (and statep (match-string 2))
+ category (org-get-category (match-beginning 0))
+ category-pos (get-text-property (match-beginning 0) 'org-category-position)
+ timestr (buffer-substring (match-beginning 0) (point-at-eol)))
+ (when (string-match "\\]" timestr)
+ ;; substring should only run to end of time stamp
+ (setq rest (substring timestr (match-end 0))
+ timestr (substring timestr 0 (match-end 0)))
+ (if (and (not closedp) (not statep)
+ (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
+ rest))
+ (progn (setq timestr (concat (substring timestr 0 -1)
+ "-" (match-string 1 rest) "]"))
+ (setq clocked (match-string 2 rest)))
+ (setq clocked "-")))
+ (save-excursion
+ (setq extra
+ (cond
+ ((not org-agenda-log-mode-add-notes) nil)
+ (statep
+ (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
+ (match-string 1)))
+ (clockp
+ (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
+ (match-string 1)))))
+ (if (not (re-search-backward org-outline-regexp-bol nil t))
+ (setq txt org-agenda-no-heading-message)
+ (goto-char (match-beginning 0))
+ (setq hdmarker (org-agenda-new-marker)
+ tags (org-get-tags-at))
+ (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (setq txt (match-string 1))
+ (when extra
+ (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
+ (setq txt (concat (substring txt 0 (match-beginning 1))
+ " - " extra " " (match-string 2 txt)))
+ (setq txt (concat txt " - " extra))))
+ (setq txt (org-agenda-format-item
+ (cond
+ (closedp "Closed: ")
+ (statep (concat "State: (" state ")"))
+ (t (concat "Clocked: (" clocked ")")))
+ txt category tags timestr)))
+ (setq priority 100000)
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
+ 'priority priority 'org-category category
+ 'org-category-position category-pos
+ 'type "closed" 'date date
+ 'undone-face 'org-warning 'done-face 'org-agenda-done)
+ (push txt ee))
+ (goto-char (point-at-eol))))
+ (nreverse ee)))
+
+(defun org-agenda-show-clocking-issues ()
+ "Add overlays, showing issues with clocking.
+See also the user option `org-agenda-clock-consistency-checks'."
+ (interactive)
+ (let* ((pl org-agenda-clock-consistency-checks)
+ (re (concat "^[ \t]*"
+ org-clock-string
+ "[ \t]+"
+ "\\(\\[.*?\\]\\)" ; group 1 is first stamp
+ "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
+ (tlstart 0.)
+ (tlend 0.)
+ (maxtime (org-hh:mm-string-to-minutes
+ (or (plist-get pl :max-duration) "24:00")))
+ (mintime (org-hh:mm-string-to-minutes
+ (or (plist-get pl :min-duration) 0)))
+ (maxgap (org-hh:mm-string-to-minutes
+ ;; default 30:00 means never complain
+ (or (plist-get pl :max-gap) "30:00")))
+ (gapok (mapcar 'org-hh:mm-string-to-minutes
+ (plist-get pl :gap-ok-around)))
+ (def-face (or (plist-get pl :default-face)
+ '((:background "DarkRed") (:foreground "white"))))
+ issue face m te ts dt ov)
+ (goto-char (point-min))
+ (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
+ (setq issue nil face def-face)
+ (catch 'next
+ (setq m (org-get-at-bol 'org-marker)
+ te nil ts nil)
+ (unless (and m (markerp m))
+ (setq issue "No valid clock line") (throw 'next t))
+ (org-with-point-at m
+ (save-excursion
+ (goto-char (point-at-bol))
+ (unless (looking-at re)
+ (error "No valid Clock line")
+ (throw 'next t))
+ (unless (match-end 3)
+ (setq issue "No end time"
+ face (or (plist-get pl :no-end-time-face) face))
+ (throw 'next t))
+ (setq ts (match-string 1)
+ te (match-string 3)
+ ts (org-float-time
+ (apply 'encode-time (org-parse-time-string ts)))
+ te (org-float-time
+ (apply 'encode-time (org-parse-time-string te)))
+ dt (- te ts))))
+ (cond
+ ((> dt (* 60 maxtime))
+ ;; a very long clocking chunk
+ (setq issue (format "Clocking interval is very long: %s"
+ (org-minutes-to-hh:mm-string
+ (floor (/ (float dt) 60.))))
+ face (or (plist-get pl :long-face) face)))
+ ((< dt (* 60 mintime))
+ ;; a very short clocking chunk
+ (setq issue (format "Clocking interval is very short: %s"
+ (org-minutes-to-hh:mm-string
+ (floor (/ (float dt) 60.))))
+ face (or (plist-get pl :short-face) face)))
+ ((and (> tlend 0) (< ts tlend))
+ ;; Two clock entries are overlapping
+ (setq issue (format "Clocking overlap: %d minutes"
+ (/ (- tlend ts) 60))
+ face (or (plist-get pl :overlap-face) face)))
+ ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
+ ;; There is a gap, lets see if we need to report it
+ (unless (org-agenda-check-clock-gap tlend ts gapok)
+ (setq issue (format "Clocking gap: %d minutes"
+ (/ (- ts tlend) 60))
+ face (or (plist-get pl :gap-face) face))))
+ (t nil)))
+ (setq tlend (or te tlend) tlstart (or ts tlstart))
+ (when issue
+ ;; OK, there was some issue, add an overlay to show the issue
+ (setq ov (make-overlay (point-at-bol) (point-at-eol)))
+ (overlay-put ov 'before-string
+ (concat
+ (org-add-props
+ (format "%-43s" (concat " " issue))
+ nil
+ 'face face)
+ "\n"))
+ (overlay-put ov 'evaporate t)))))
+
+(defun org-agenda-check-clock-gap (t1 t2 ok-list)
+ "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
+ (catch 'exit
+ (unless ok-list
+ ;; there are no OK times for gaps...
+ (throw 'exit nil))
+ (if (> (- (/ t2 36000) (/ t1 36000)) 24)
+ ;; This is more than 24 hours, so it is OK.
+ ;; because we have at least one OK time, that must be in the
+ ;; 24 hour interval.
+ (throw 'exit t))
+ ;; We have a shorter gap.
+ ;; Now we have to get the minute of the day when these times are
+ (let* ((t1dec (decode-time (seconds-to-time t1)))
+ (t2dec (decode-time (seconds-to-time t2)))
+ ;; compute the minute on the day
+ (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
+ (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
+ (when (< min2 min1)
+ ;; if min2 is smaller than min1, this means it is on the next day.
+ ;; Wrap it to after midnight.
+ (setq min2 (+ min2 1440)))
+ ;; Now check if any of the OK times is in the gap
+ (mapc (lambda (x)
+ ;; Wrap the time to after midnight if necessary
+ (if (< x min1) (setq x (+ x 1440)))
+ ;; Check if in interval
+ (and (<= min1 x) (>= min2 x) (throw 'exit t)))
+ ok-list)
+ ;; Nope, this gap is not OK
+ nil)))
+
+(defun org-agenda-get-deadlines ()
+ "Return the deadline information for agenda display."
+ (let* ((props (list 'mouse-face 'highlight
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (regexp org-deadline-time-regexp)
+ (todayp (org-agenda-todayp date)) ; DATE bound by calendar
+ (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
+ d2 diff dfrac wdays pos pos1 category category-pos
+ tags suppress-prewarning ee txt head face s todo-state
+ show-all upcomingp donep timestr warntime)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (setq suppress-prewarning nil)
+ (catch :skip
+ (org-agenda-skip)
+ (when (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (save-match-data
+ (string-match org-scheduled-time-regexp
+ (buffer-substring (point-at-bol)
+ (point-at-eol)))))
+ (setq suppress-prewarning
+ (if (integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ org-agenda-skip-deadline-prewarning-if-scheduled
+ 0)))
+ (setq s (match-string 1)
+ txt nil
+ pos (1- (match-beginning 1))
+ todo-state (save-match-data (org-get-todo-state))
+ show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all))
+ d2 (org-time-string-to-absolute
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
+ diff (- d2 d1)
+ wdays (if suppress-prewarning
+ (let ((org-deadline-warning-days suppress-prewarning))
+ (org-get-wdays s))
+ (org-get-wdays s))
+ dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
+ upcomingp (and todayp (> diff 0)))
+ ;; When to show a deadline in the calendar:
+ ;; If the expiration is within wdays warning time.
+ ;; Past-due deadlines are only shown on the current date
+ (if (and (or (and (<= diff wdays)
+ (and todayp (not org-agenda-only-exact-dates)))
+ (= diff 0)))
+ (save-excursion
+ ;; (setq todo-state (org-get-todo-state))
+ (setq donep (member todo-state org-done-keywords))
+ (if (and donep
+ (or org-agenda-skip-deadline-if-done
+ (not (= diff 0))))
+ (setq txt nil)
+ (setq category (org-get-category)
+ warntime (org-entry-get (point) "APPT_WARNTIME")
+ category-pos (get-text-property (point) 'org-category-position))
+ (if (not (re-search-backward "^\\*+[ \t]+" nil t))
+ (setq txt org-agenda-no-heading-message)
+ (goto-char (match-end 0))
+ (setq pos1 (match-beginning 0))
+ (setq tags (org-get-tags-at pos1))
+ (setq head (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "^\r\n")
+ (point))))
+ (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (setq timestr
+ (concat (substring s (match-beginning 1)) " "))
+ (setq timestr 'time))
+ (setq txt (org-agenda-format-item
+ (if (= diff 0)
+ (car org-agenda-deadline-leaders)
+ (if (functionp
+ (nth 1 org-agenda-deadline-leaders))
+ (funcall
+ (nth 1 org-agenda-deadline-leaders)
+ diff date)
+ (format (nth 1 org-agenda-deadline-leaders)
+ diff)))
+ head category tags
+ (if (not (= diff 0)) nil timestr)))))
+ (when txt
+ (setq face (org-agenda-deadline-face dfrac))
+ (org-add-props txt props
+ 'org-marker (org-agenda-new-marker pos)
+ 'warntime warntime
+ 'org-hd-marker (org-agenda-new-marker pos1)
+ 'priority (+ (- diff)
+ (org-get-priority txt))
+ 'org-category category
+ 'org-category-position category-pos
+ 'todo-state todo-state
+ 'type (if upcomingp "upcoming-deadline" "deadline")
+ 'date (if upcomingp date d2)
+ 'face (if donep 'org-agenda-done face)
+ 'undone-face face 'done-face 'org-agenda-done)
+ (push txt ee))))))
+ (nreverse ee)))
+
+(defun org-agenda-deadline-face (fraction)
+ "Return the face to displaying a deadline item.
+FRACTION is what fraction of the head-warning time has passed."
+ (let ((faces org-agenda-deadline-faces) f)
+ (catch 'exit
+ (while (setq f (pop faces))
+ (if (>= fraction (car f)) (throw 'exit (cdr f)))))))
+
+(defun org-agenda-get-scheduled (&optional deadline-results)
+ "Return the scheduled information for agenda display."
+ (let* ((props (list 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'done-face 'org-agenda-done
+ 'mouse-face 'highlight
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (regexp org-scheduled-time-regexp)
+ (todayp (org-agenda-todayp date)) ; DATE bound by calendar
+ (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
+ mm
+ (deadline-position-alist
+ (mapcar (lambda (a) (and (setq mm (get-text-property
+ 0 'org-hd-marker a))
+ (cons (marker-position mm) a)))
+ deadline-results))
+ d2 diff pos pos1 category category-pos tags donep
+ ee txt head pastschedp todo-state face timestr s habitp show-all
+ did-habit-check-p warntime)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (setq s (match-string 1)
+ txt nil
+ pos (1- (match-beginning 1))
+ todo-state (save-match-data (org-get-todo-state))
+ show-all (or (eq org-agenda-repeating-timestamp-show-all t)
+ (member todo-state
+ org-agenda-repeating-timestamp-show-all))
+ d2 (org-time-string-to-absolute
+ (match-string 1) d1 'past show-all
+ (current-buffer) pos)
+ diff (- d2 d1)
+ warntime (org-entry-get (point) "APPT_WARNTIME"))
+ (setq pastschedp (and todayp (< diff 0)))
+ (setq did-habit-check-p nil)
+ ;; When to show a scheduled item in the calendar:
+ ;; If it is on or past the date.
+ (when (or (and (< diff 0)
+ (< (abs diff) org-scheduled-past-days)
+ (and todayp (not org-agenda-only-exact-dates)))
+ (= diff 0)
+ ;; org-is-habit-p uses org-entry-get, which is expansive
+ ;; so we go extra mile to only call it once
+ (and todayp
+ (boundp 'org-habit-show-all-today)
+ org-habit-show-all-today
+ (setq did-habit-check-p t)
+ (setq habitp (and (functionp 'org-is-habit-p)
+ (org-is-habit-p)))))
+ (save-excursion
+ (setq donep (member todo-state org-done-keywords))
+ (if (and donep
+ (or org-agenda-skip-scheduled-if-done
+ (not (= diff 0))
+ (and (functionp 'org-is-habit-p)
+ (org-is-habit-p))))
+ (setq txt nil)
+ (setq habitp (if did-habit-check-p habitp
+ (and (functionp 'org-is-habit-p)
+ (org-is-habit-p))))
+ (setq category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position))
+ (if (not (re-search-backward "^\\*+[ \t]+" nil t))
+ (setq txt org-agenda-no-heading-message)
+ (goto-char (match-end 0))
+ (setq pos1 (match-beginning 0))
+ (if habitp
+ (if (or (not org-habit-show-habits)
+ (and (not todayp)
+ (boundp 'org-habit-show-habits-only-for-today)
+ org-habit-show-habits-only-for-today))
+ (throw :skip nil))
+ (if (and
+ (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
+ (and org-agenda-skip-scheduled-if-deadline-is-shown
+ pastschedp))
+ (setq mm (assoc pos1 deadline-position-alist)))
+ (throw :skip nil)))
+ (setq tags (org-get-tags-at))
+ (setq head (buffer-substring-no-properties
+ (point)
+ (progn (skip-chars-forward "^\r\n") (point))))
+ (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (setq timestr
+ (concat (substring s (match-beginning 1)) " "))
+ (setq timestr 'time))
+ (setq txt (org-agenda-format-item
+ (if (= diff 0)
+ (car org-agenda-scheduled-leaders)
+ (format (nth 1 org-agenda-scheduled-leaders)
+ (- 1 diff)))
+ head category tags
+ (if (not (= diff 0)) nil timestr)
+ nil habitp))))
+ (when txt
+ (setq face
+ (cond
+ ((and (not habitp) pastschedp)
+ 'org-scheduled-previously)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled))
+ habitp (and habitp (org-habit-parse-todo)))
+ (org-add-props txt props
+ 'undone-face face
+ 'face (if donep 'org-agenda-done face)
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker pos1)
+ 'type (if pastschedp "past-scheduled" "scheduled")
+ 'date (if pastschedp d2 date)
+ 'warntime warntime
+ 'priority (if habitp
+ (org-habit-get-priority habitp)
+ (+ 94 (- 5 diff) (org-get-priority txt)))
+ 'org-category category
+ 'category-position category-pos
+ 'org-habit-p habitp
+ 'todo-state todo-state)
+ (push txt ee))))))
+ (nreverse ee)))
+
+(defun org-agenda-get-blocks ()
+ "Return the date-range information for agenda display."
+ (let* ((props (list 'face nil
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'mouse-face 'highlight
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name buffer-file-name))))
+ (regexp org-tr-regexp)
+ (d0 (calendar-absolute-from-gregorian date))
+ marker hdmarker ee txt d1 d2 s1 s2 category category-pos
+ todo-state tags pos head donep)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (setq pos (point))
+ (let ((start-time (match-string 1))
+ (end-time (match-string 2)))
+ (setq s1 (match-string 1)
+ s2 (match-string 2)
+ d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
+ d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
+ (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
+ ;; Only allow days between the limits, because the normal
+ ;; date stamps will catch the limits.
+ (save-excursion
+ (setq todo-state (org-get-todo-state))
+ (setq donep (member todo-state org-done-keywords))
+ (if (and donep org-agenda-skip-timestamp-if-done)
+ (throw :skip t))
+ (setq marker (org-agenda-new-marker (point)))
+ (setq category (org-get-category)
+ category-pos (get-text-property (point) 'org-category-position))
+ (if (not (re-search-backward org-outline-regexp-bol nil t))
+ (setq txt org-agenda-no-heading-message)
+ (goto-char (match-beginning 0))
+ (setq hdmarker (org-agenda-new-marker (point)))
+ (setq tags (org-get-tags-at))
+ (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (setq head (match-string 1))
+ (let ((remove-re
+ (if org-agenda-remove-timeranges-from-blocks
+ (concat
+ "<" (regexp-quote s1) ".*?>"
+ "--"
+ "<" (regexp-quote s2) ".*?>")
+ nil)))
+ (setq txt (org-agenda-format-item
+ (format
+ (nth (if (= d1 d2) 0 1)
+ org-agenda-timerange-leaders)
+ (1+ (- d0 d1)) (1+ (- d2 d1)))
+ head category tags
+ (cond ((and (= d1 d0) (= d2 d0))
+ (concat "<" start-time ">--<" end-time ">"))
+ ((= d1 d0)
+ (concat "<" start-time ">"))
+ ((= d2 d0)
+ (concat "<" end-time ">")))
+ remove-re t))))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker hdmarker
+ 'type "block" 'date date
+ 'todo-state todo-state
+ 'priority (org-get-priority txt) 'org-category category
+ 'org-category-position category-pos)
+ (push txt ee))))
+ (goto-char pos)))
+ ;; Sort the entries by expiration date.
+ (nreverse ee)))
+
+;;; Agenda presentation and sorting
+
+(defvar org-prefix-has-time nil
+ "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%t'.")
+(defvar org-prefix-has-tag nil
+ "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%T'.")
+(defvar org-prefix-has-effort nil
+ "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%e'.")
+(defvar org-prefix-category-length nil
+ "Used by `org-compile-prefix-format' to remember the category field width.")
+(defvar org-prefix-category-max-length nil
+ "Used by `org-compile-prefix-format' to remember the category field width.")
+
+(defun org-agenda-get-category-icon (category)
+ "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
+ (dolist (entry org-agenda-category-icon-alist)
+ (when (org-string-match-p (car entry) category)
+ (if (listp (cadr entry))
+ (return (cadr entry))
+ (return (apply 'create-image (cdr entry)))))))
+
+(defun org-agenda-format-item (extra txt &optional category tags dotime
+ remove-re habitp)
+ "Format TXT to be inserted into the agenda buffer.
+In particular, it adds the prefix and corresponding text properties. EXTRA
+must be a string and replaces the `%s' specifier in the prefix format.
+CATEGORY (string, symbol or nil) may be used to overrule the default
+category taken from local variable or file name. It will replace the `%c'
+specifier in the format. DOTIME, when non-nil, indicates that a
+time-of-day should be extracted from TXT for sorting of this entry, and for
+the `%t' specifier in the format. When DOTIME is a string, this string is
+searched for a time before TXT is. TAGS can be the tags of the headline.
+Any match of REMOVE-RE will be removed from TXT."
+ ;; We keep the org-prefix-* variable values along with a compiled
+ ;; formatter, so that multiple agendas existing at the same time, do
+ ;; not step on each other toes.
+ ;;
+ ;; It was inconvenient to make these variables buffer local in
+ ;; Agenda buffers, because this function expects to be called with
+ ;; the buffer where item comes from being current, and not agenda
+ ;; buffer
+ (let* ((bindings (car org-prefix-format-compiled))
+ (formatter (cadr org-prefix-format-compiled)))
+ (loop for (var value) in bindings
+ do (set var value))
+ (save-match-data
+ ;; Diary entries sometimes have extra whitespace at the beginning
+ (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
+
+ ;; Fix the tags part in txt
+ (setq txt (org-agenda-fix-displayed-tags
+ txt tags
+ org-agenda-show-inherited-tags
+ org-agenda-hide-tags-regexp))
+ (let* ((category (or category
+ (if (stringp org-category)
+ org-category
+ (and org-category (symbol-name org-category)))
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "")))
+ (category-icon (org-agenda-get-category-icon category))
+ (category-icon (if category-icon
+ (propertize " " 'display category-icon)
+ ""))
+ ;; time, tag, effort are needed for the eval of the prefix format
+ (tag (if tags (nth (1- (length tags)) tags) ""))
+ time effort neffort
+ (ts (if dotime (concat
+ (if (stringp dotime) dotime "")
+ (and org-agenda-search-headline-for-time txt))))
+ (time-of-day (and dotime (org-get-time-of-day ts)))
+ stamp plain s0 s1 s2 rtn srp l
+ duration thecategory)
+ (and (derived-mode-p 'org-mode) buffer-file-name
+ (add-to-list 'org-agenda-contributing-files buffer-file-name))
+ (when (and dotime time-of-day)
+ ;; Extract starting and ending time and move them to prefix
+ (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
+ (setq plain (string-match org-plain-time-of-day-regexp ts)))
+ (setq s0 (match-string 0 ts)
+ srp (and stamp (match-end 3))
+ s1 (match-string (if plain 1 2) ts)
+ s2 (match-string (if plain 8 (if srp 4 6)) ts))
+
+ ;; If the times are in TXT (not in DOTIMES), and the prefix will list
+ ;; them, we might want to remove them there to avoid duplication.
+ ;; The user can turn this off with a variable.
+ (if (and org-prefix-has-time
+ org-agenda-remove-times-when-in-prefix (or stamp plain)
+ (string-match (concat (regexp-quote s0) " *") txt)
+ (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
+ (if (eq org-agenda-remove-times-when-in-prefix 'beg)
+ (= (match-beginning 0) 0)
+ t))
+ (setq txt (replace-match "" nil nil txt))))
+ ;; Normalize the time(s) to 24 hour
+ (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
+ (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
+
+ ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-minutes-to-hh:mm-string
+ (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration))))
+
+ ;; Compute the duration
+ (when s2
+ (setq duration (- (org-hh:mm-string-to-minutes s2)
+ (org-hh:mm-string-to-minutes s1)))))
+
+ (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ txt)
+ ;; Tags are in the string
+ (if (or (eq org-agenda-remove-tags t)
+ (and org-agenda-remove-tags
+ org-prefix-has-tag))
+ (setq txt (replace-match "" t t txt))
+ (setq txt (replace-match
+ (concat (make-string (max (- 50 (length txt)) 1) ?\ )
+ (match-string 2 txt))
+ t t txt))))
+ (when (derived-mode-p 'org-mode)
+ (setq effort
+ (condition-case nil
+ (org-get-effort
+ (or (get-text-property 0 'org-hd-marker txt)
+ (get-text-property 0 'org-marker txt)))
+ (error nil)))
+ (when effort
+ (setq neffort (org-duration-string-to-minutes effort)
+ effort (setq effort (concat "[" effort "]")))))
+ ;; prevent erroring out with %e format when there is no effort
+ (or effort (setq effort ""))
+
+ (when remove-re
+ (while (string-match remove-re txt)
+ (setq txt (replace-match "" t t txt))))
+
+ ;; Set org-heading property on `txt' to mark the start of the
+ ;; heading.
+ (add-text-properties 0 (length txt) '(org-heading t) txt)
+
+ ;; Prepare the variables needed in the eval of the compiled format
+ (setq time (cond (s2 (concat
+ (org-agenda-time-of-day-to-ampm-maybe s1)
+ "-" (org-agenda-time-of-day-to-ampm-maybe s2)
+ (if org-agenda-timegrid-use-ampm " ")))
+ (s1 (concat
+ (org-agenda-time-of-day-to-ampm-maybe s1)
+ (if org-agenda-timegrid-use-ampm
+ "........ "
+ "......")))
+ (t ""))
+ extra (or (and (not habitp) extra) "")
+ category (if (symbolp category) (symbol-name category) category)
+ thecategory (copy-sequence category))
+ (if (string-match org-bracket-link-regexp category)
+ (progn
+ (setq l (if (match-end 3)
+ (- (match-end 3) (match-beginning 3))
+ (- (match-end 1) (match-beginning 1))))
+ (when (< l (or org-prefix-category-length 0))
+ (setq category (copy-sequence category))
+ (org-add-props category nil
+ 'extra-space (make-string
+ (- org-prefix-category-length l 1) ?\ ))))
+ (if (and org-prefix-category-max-length
+ (>= (length category) org-prefix-category-max-length))
+ (setq category (substring category 0 (1- org-prefix-category-max-length)))))
+ ;; Evaluate the compiled format
+ (setq rtn (concat (eval formatter) txt))
+
+ ;; And finally add the text properties
+ (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
+ (org-add-props rtn nil
+ 'org-category (if thecategory (downcase thecategory) category)
+ 'tags (mapcar 'org-downcase-keep-props tags)
+ 'org-highest-priority org-highest-priority
+ 'org-lowest-priority org-lowest-priority
+ 'time-of-day time-of-day
+ 'duration duration
+ 'effort effort
+ 'effort-minutes neffort
+ 'txt txt
+ 'time time
+ 'extra extra
+ 'format org-prefix-format-compiled
+ 'dotime dotime)))))
+
+(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
+ "Remove tags string from TXT, and add a modified list of tags.
+The modified list may contain inherited tags, and tags matched by
+`org-agenda-hide-tags-regexp' will be removed."
+ (when (or add-inherited hide-re)
+ (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt)
+ (setq txt (substring txt 0 (match-beginning 0))))
+ (setq tags
+ (delq nil
+ (mapcar (lambda (tg)
+ (if (or (and hide-re (string-match hide-re tg))
+ (and (not add-inherited)
+ (get-text-property 0 'inherited tg)))
+ nil
+ tg))
+ tags)))
+ (when tags
+ (let ((have-i (get-text-property 0 'inherited (car tags)))
+ i)
+ (setq txt (concat txt " :"
+ (mapconcat
+ (lambda (x)
+ (setq i (get-text-property 0 'inherited x))
+ (if (and have-i (not i))
+ (progn
+ (setq have-i nil)
+ (concat ":" x))
+ x))
+ tags ":")
+ (if have-i "::" ":"))))))
+ txt)
+
+(defun org-downcase-keep-props (s)
+ (let ((props (text-properties-at 0 s)))
+ (setq s (downcase s))
+ (add-text-properties 0 (length s) props s)
+ s))
+
+(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
+(defvar org-agenda-sorting-strategy-selected nil)
+
+(defun org-agenda-add-time-grid-maybe (list ndays todayp)
+ (catch 'exit
+ (cond ((not org-agenda-use-time-grid) (throw 'exit list))
+ ((and todayp (member 'today (car org-agenda-time-grid))))
+ ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
+ ((member 'weekly (car org-agenda-time-grid)))
+ (t (throw 'exit list)))
+ (let* ((have (delq nil (mapcar
+ (lambda (x) (get-text-property 1 'time-of-day x))
+ list)))
+ (string (nth 1 org-agenda-time-grid))
+ (gridtimes (nth 2 org-agenda-time-grid))
+ (req (car org-agenda-time-grid))
+ (remove (member 'remove-match req))
+ new time)
+ (if (and (member 'require-timed req) (not have))
+ ;; don't show empty grid
+ (throw 'exit list))
+ (while (setq time (pop gridtimes))
+ (unless (and remove (member time have))
+ (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
+ (push (org-agenda-format-item
+ nil string "" nil
+ (concat (substring time 0 -2) ":" (substring time -2)))
+ new)
+ (put-text-property
+ 2 (length (car new)) 'face 'org-time-grid (car new))))
+ (when (and todayp org-agenda-show-current-time-in-grid)
+ (push (org-agenda-format-item
+ nil
+ org-agenda-current-time-string
+ "" nil
+ (format-time-string "%H:%M "))
+ new)
+ (put-text-property
+ 2 (length (car new)) 'face 'org-agenda-current-time (car new)))
+
+ (if (member 'time-up org-agenda-sorting-strategy-selected)
+ (append new list)
+ (append list new)))))
+
+(defun org-compile-prefix-format (key)
+ "Compile the prefix format into a Lisp form that can be evaluated.
+The resulting form and associated variable bindings is returned
+and stored in the variable `org-prefix-format-compiled'."
+ (setq org-prefix-has-time nil org-prefix-has-tag nil
+ org-prefix-category-length nil
+ org-prefix-has-effort nil)
+ (let ((s (cond
+ ((stringp org-agenda-prefix-format)
+ org-agenda-prefix-format)
+ ((assq key org-agenda-prefix-format)
+ (cdr (assq key org-agenda-prefix-format)))
+ (t " %-12:c%?-12t% s")))
+ (start 0)
+ varform vars var e c f opt)
+ (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)"
+ s start)
+ (setq var (or (cdr (assoc (match-string 4 s)
+ '(("c" . category) ("t" . time) ("s" . extra)
+ ("i" . category-icon) ("T" . tag) ("e" . effort))))
+ 'eval)
+ c (or (match-string 3 s) "")
+ opt (match-beginning 1)
+ start (1+ (match-beginning 0)))
+ (if (equal var 'time) (setq org-prefix-has-time t))
+ (if (equal var 'tag) (setq org-prefix-has-tag t))
+ (if (equal var 'effort) (setq org-prefix-has-effort t))
+ (setq f (concat "%" (match-string 2 s) "s"))
+ (when (equal var 'category)
+ (setq org-prefix-category-length
+ (floor (abs (string-to-number (match-string 2 s)))))
+ (setq org-prefix-category-max-length
+ (let ((x (match-string 2 s)))
+ (save-match-data
+ (if (string-match "\\.[0-9]+" x)
+ (string-to-number (substring (match-string 0 x) 1)))))))
+ (if (eq var 'eval)
+ (setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
+ (if opt
+ (setq varform
+ `(if (equal "" ,var)
+ ""
+ (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
+ (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
+ (setq s (replace-match "%s" t nil s))
+ (push varform vars))
+ (setq vars (nreverse vars))
+ (with-current-buffer (or org-agenda-buffer (current-buffer))
+ (setq org-prefix-format-compiled
+ (list
+ `((org-prefix-has-time ,org-prefix-has-time)
+ (org-prefix-has-tag ,org-prefix-has-tag)
+ (org-prefix-category-length ,org-prefix-category-length)
+ (org-prefix-has-effort ,org-prefix-has-effort))
+ `(format ,s ,@vars))))))
+
+(defun org-set-sorting-strategy (key)
+ (if (symbolp (car org-agenda-sorting-strategy))
+ ;; the old format
+ (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
+ (setq org-agenda-sorting-strategy-selected
+ (or (cdr (assq key org-agenda-sorting-strategy))
+ (cdr (assq 'agenda org-agenda-sorting-strategy))
+ '(time-up category-keep priority-down)))))
+
+(defun org-get-time-of-day (s &optional string mod24)
+ "Check string S for a time of day.
+If found, return it as a military time number between 0 and 2400.
+If not found, return nil.
+The optional STRING argument forces conversion into a 5 character wide string
+HH:MM."
+ (save-match-data
+ (when
+ (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
+ (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (let* ((h (string-to-number (match-string 1 s)))
+ (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
+ (ampm (if (match-end 4) (downcase (match-string 4 s))))
+ (am-p (equal ampm "am"))
+ (h1 (cond ((not ampm) h)
+ ((= h 12) (if am-p 0 12))
+ (t (+ h (if am-p 0 12)))))
+ (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
+ (mod h1 24) h1))
+ (t0 (+ (* 100 h2) m))
+ (t1 (concat (if (>= h1 24) "+" " ")
+ (if (and org-agenda-time-leading-zero
+ (< t0 1000)) "0" "")
+ (if (< t0 100) "0" "")
+ (if (< t0 10) "0" "")
+ (int-to-string t0))))
+ (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
+
+(defvar org-agenda-before-sorting-filter-function nil
+ "Function to be applied to agenda items prior to sorting.
+Prior to sorting also means just before they are inserted into the agenda.
+
+To aid sorting, you may revisit the original entries and add more text
+properties which will later be used by the sorting functions.
+
+The function should take a string argument, an agenda line.
+It has access to the text properties in that line, which contain among
+other things, the property `org-hd-marker' that points to the entry
+where the line comes from. Note that not all lines going into the agenda
+have this property, only most.
+
+The function should return the modified string. It is probably best
+to ONLY change text properties.
+
+You can also use this function as a filter, by returning nil for lines
+you don't want to have in the agenda at all. For this application, you
+could bind the variable in the options section of a custom command.")
+
+(defun org-agenda-finalize-entries (list &optional nosort)
+ "Sort and concatenate the agenda items."
+ (setq list (mapcar 'org-agenda-highlight-todo list))
+ (if nosort
+ list
+ (when org-agenda-before-sorting-filter-function
+ (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list))))
+ (mapconcat 'identity (sort list 'org-entries-lessp) "\n")))
+
+(defun org-agenda-highlight-todo (x)
+ (let ((org-done-keywords org-done-keywords-for-agenda)
+ (case-fold-search nil)
+ re)
+ (if (eq x 'line)
+ (save-excursion
+ (beginning-of-line 1)
+ (setq re (org-get-at-bol 'org-todo-regexp))
+ (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
+ (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
+ (add-text-properties (match-beginning 0) (match-end 1)
+ (list 'face (org-get-todo-face 1)))
+ (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
+ (delete-region (match-beginning 1) (1- (match-end 0)))
+ (goto-char (match-beginning 1))
+ (insert (format org-agenda-todo-keyword-format s)))))
+ (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
+ (setq re (get-text-property 0 'org-todo-regexp x))
+ (when (and re
+ ;; Test `pl' because if there's no heading content,
+ ;; there's no point matching to highlight. Note
+ ;; that if we didn't test `pl' first, and there
+ ;; happened to be no keyword from `org-todo-regexp'
+ ;; on this heading line, then the `equal' comparison
+ ;; afterwards would spuriously succeed in the case
+ ;; where `pl' is nil -- causing an args-out-of-range
+ ;; error when we try to add text properties to text
+ ;; that isn't there.
+ pl
+ (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
+ x pl) pl))
+ (add-text-properties
+ (or (match-end 1) (match-end 0)) (match-end 0)
+ (list 'face (org-get-todo-face (match-string 2 x)))
+ x)
+ (when (match-end 1)
+ (setq x (concat (substring x 0 (match-end 1))
+ (format org-agenda-todo-keyword-format
+ (match-string 2 x))
+ (org-add-props " " (text-properties-at 0 x))
+ (substring x (match-end 3)))))))
+ x)))
+
+(defsubst org-cmp-priority (a b)
+ "Compare the priorities of string A and B."
+ (let ((pa (or (get-text-property 1 'priority a) 0))
+ (pb (or (get-text-property 1 'priority b) 0)))
+ (cond ((> pa pb) +1)
+ ((< pa pb) -1))))
+
+(defsubst org-cmp-effort (a b)
+ "Compare the effort values of string A and B."
+ (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
+ (ea (or (get-text-property 1 'effort-minutes a) def))
+ (eb (or (get-text-property 1 'effort-minutes b) def)))
+ (cond ((> ea eb) +1)
+ ((< ea eb) -1))))
+
+(defsubst org-cmp-category (a b)
+ "Compare the string values of categories of strings A and B."
+ (let ((ca (or (get-text-property 1 'org-category a) ""))
+ (cb (or (get-text-property 1 'org-category b) "")))
+ (cond ((string-lessp ca cb) -1)
+ ((string-lessp cb ca) +1))))
+
+(defsubst org-cmp-todo-state (a b)
+ "Compare the todo states of strings A and B."
+ (let* ((ma (or (get-text-property 1 'org-marker a)
+ (get-text-property 1 'org-hd-marker a)))
+ (mb (or (get-text-property 1 'org-marker b)
+ (get-text-property 1 'org-hd-marker b)))
+ (fa (and ma (marker-buffer ma)))
+ (fb (and mb (marker-buffer mb)))
+ (todo-kwds
+ (or (and fa (with-current-buffer fa org-todo-keywords-1))
+ (and fb (with-current-buffer fb org-todo-keywords-1))))
+ (ta (or (get-text-property 1 'todo-state a) ""))
+ (tb (or (get-text-property 1 'todo-state b) ""))
+ (la (- (length (member ta todo-kwds))))
+ (lb (- (length (member tb todo-kwds))))
+ (donepa (member ta org-done-keywords-for-agenda))
+ (donepb (member tb org-done-keywords-for-agenda)))
+ (cond ((and donepa (not donepb)) -1)
+ ((and (not donepa) donepb) +1)
+ ((< la lb) -1)
+ ((< lb la) +1))))
+
+(defsubst org-cmp-alpha (a b)
+ "Compare the headlines, alphabetically."
+ (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
+ (plb (text-property-any 0 (length b) 'org-heading t b))
+ (ta (and pla (substring a pla)))
+ (tb (and plb (substring b plb))))
+ (when pla
+ (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
+ "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
+ (setq ta (substring ta (match-end 0))))
+ (setq ta (downcase ta)))
+ (when plb
+ (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
+ "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
+ (setq tb (substring tb (match-end 0))))
+ (setq tb (downcase tb)))
+ (cond ((not ta) +1)
+ ((not tb) -1)
+ ((string-lessp ta tb) -1)
+ ((string-lessp tb ta) +1))))
+
+(defsubst org-cmp-tag (a b)
+ "Compare the string values of the first tags of A and B."
+ (let ((ta (car (last (get-text-property 1 'tags a))))
+ (tb (car (last (get-text-property 1 'tags b)))))
+ (cond ((not ta) +1)
+ ((not tb) -1)
+ ((string-lessp ta tb) -1)
+ ((string-lessp tb ta) +1))))
+
+(defsubst org-cmp-time (a b)
+ "Compare the time-of-day values of strings A and B."
+ (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
+ (ta (or (get-text-property 1 'time-of-day a) def))
+ (tb (or (get-text-property 1 'time-of-day b) def)))
+ (cond ((< ta tb) -1)
+ ((< tb ta) +1))))
+
+(defsubst org-cmp-habit-p (a b)
+ "Compare the todo states of strings A and B."
+ (let ((ha (get-text-property 1 'org-habit-p a))
+ (hb (get-text-property 1 'org-habit-p b)))
+ (cond ((and ha (not hb)) -1)
+ ((and (not ha) hb) +1))))
+
+(defsubst org-em (x y list) (or (memq x list) (memq y list)))
+
+(defun org-entries-lessp (a b)
+ "Predicate for sorting agenda entries."
+ ;; The following variables will be used when the form is evaluated.
+ ;; So even though the compiler complains, keep them.
+ (let* ((ss org-agenda-sorting-strategy-selected)
+ (time-up (and (org-em 'time-up 'time-down ss)
+ (org-cmp-time a b)))
+ (time-down (if time-up (- time-up) nil))
+ (priority-up (and (org-em 'priority-up 'priority-down ss)
+ (org-cmp-priority a b)))
+ (priority-down (if priority-up (- priority-up) nil))
+ (effort-up (and (org-em 'effort-up 'effort-down ss)
+ (org-cmp-effort a b)))
+ (effort-down (if effort-up (- effort-up) nil))
+ (category-up (and (or (org-em 'category-up 'category-down ss)
+ (memq 'category-keep ss))
+ (org-cmp-category a b)))
+ (category-down (if category-up (- category-up) nil))
+ (category-keep (if category-up +1 nil))
+ (tag-up (and (org-em 'tag-up 'tag-down ss)
+ (org-cmp-tag a b)))
+ (tag-down (if tag-up (- tag-up) nil))
+ (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss)
+ (org-cmp-todo-state a b)))
+ (todo-state-down (if todo-state-up (- todo-state-up) nil))
+ (habit-up (and (org-em 'habit-up 'habit-down ss)
+ (org-cmp-habit-p a b)))
+ (habit-down (if habit-up (- habit-up) nil))
+ (alpha-up (and (org-em 'alpha-up 'alpha-down ss)
+ (org-cmp-alpha a b)))
+ (alpha-down (if alpha-up (- alpha-up) nil))
+ (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
+ user-defined-up user-defined-down)
+ (if (and need-user-cmp org-agenda-cmp-user-defined
+ (functionp org-agenda-cmp-user-defined))
+ (setq user-defined-up
+ (funcall org-agenda-cmp-user-defined a b)
+ user-defined-down (if user-defined-up (- user-defined-up) nil)))
+ (cdr (assoc
+ (eval (cons 'or org-agenda-sorting-strategy-selected))
+ '((-1 . t) (1 . nil) (nil . nil))))))
+
+;;; Agenda restriction lock
+
+(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
+ "Overlay to mark the headline to which agenda commands are restricted.")
+(overlay-put org-agenda-restriction-lock-overlay
+ 'face 'org-agenda-restriction-lock)
+(overlay-put org-agenda-restriction-lock-overlay
+ 'help-echo "Agendas are currently limited to this subtree.")
+(org-detach-overlay org-agenda-restriction-lock-overlay)
+
+(defun org-agenda-set-restriction-lock (&optional type)
+ "Set restriction lock for agenda, to current subtree or file.
+Restriction will be the file if TYPE is `file', or if type is the
+universal prefix '(4), or if the cursor is before the first headline
+in the file. Otherwise, restriction will be to the current subtree."
+ (interactive "P")
+ (and (equal type '(4)) (setq type 'file))
+ (setq type (cond
+ (type type)
+ ((org-at-heading-p) 'subtree)
+ ((condition-case nil (org-back-to-heading t) (error nil))
+ 'subtree)
+ (t 'file)))
+ (if (eq type 'subtree)
+ (progn
+ (setq org-agenda-restrict t)
+ (setq org-agenda-overriding-restriction 'subtree)
+ (put 'org-agenda-files 'org-restrict
+ (list (buffer-file-name (buffer-base-buffer))))
+ (org-back-to-heading t)
+ (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol))
+ (move-marker org-agenda-restrict-begin (point))
+ (move-marker org-agenda-restrict-end
+ (save-excursion (org-end-of-subtree t)))
+ (message "Locking agenda restriction to subtree"))
+ (put 'org-agenda-files 'org-restrict
+ (list (buffer-file-name (buffer-base-buffer))))
+ (setq org-agenda-restrict nil)
+ (setq org-agenda-overriding-restriction 'file)
+ (move-marker org-agenda-restrict-begin nil)
+ (move-marker org-agenda-restrict-end nil)
+ (message "Locking agenda restriction to file"))
+ (setq current-prefix-arg nil)
+ (org-agenda-maybe-redo))
+
+(defun org-agenda-remove-restriction-lock (&optional noupdate)
+ "Remove the agenda restriction lock."
+ (interactive "P")
+ (org-detach-overlay org-agenda-restriction-lock-overlay)
+ (org-detach-overlay org-speedbar-restriction-lock-overlay)
+ (setq org-agenda-overriding-restriction nil)
+ (setq org-agenda-restrict nil)
+ (put 'org-agenda-files 'org-restrict nil)
+ (move-marker org-agenda-restrict-begin nil)
+ (move-marker org-agenda-restrict-end nil)
+ (setq current-prefix-arg nil)
+ (message "Agenda restriction lock removed")
+ (or noupdate (org-agenda-maybe-redo)))
+
+(defun org-agenda-maybe-redo ()
+ "If there is any window showing the agenda view, update it."
+ (let ((w (get-buffer-window org-agenda-buffer-name t))
+ (w0 (selected-window)))
+ (when w
+ (select-window w)
+ (org-agenda-redo)
+ (select-window w0)
+ (if org-agenda-overriding-restriction
+ (message "Agenda view shifted to new %s restriction"
+ org-agenda-overriding-restriction)
+ (message "Agenda restriction lock removed")))))
+
+;;; Agenda commands
+
+(defun org-agenda-check-type (error &rest types)
+ "Check if agenda buffer is of allowed type.
+If ERROR is non-nil, throw an error, otherwise just return nil."
+ (if (not org-agenda-type)
+ (error "No Org agenda currently displayed")
+ (if (memq org-agenda-type types)
+ t
+ (if error
+ (error "Not allowed in %s-type agenda buffers" org-agenda-type)
+ nil))))
+
+(defun org-agenda-Quit (&optional arg)
+ "Exit agenda by removing the window or the buffer."
+ (interactive)
+ (if org-agenda-columns-active
+ (org-columns-quit)
+ (let ((buf (current-buffer)))
+ (if (eq org-agenda-window-setup 'other-frame)
+ (progn
+ (org-agenda-reset-markers)
+ (kill-buffer buf)
+ (org-columns-remove-overlays)
+ (setq org-agenda-archives-mode nil)
+ (delete-frame))
+ (and (not (eq org-agenda-window-setup 'current-window))
+ (not (one-window-p))
+ (delete-window))
+ (org-agenda-reset-markers)
+ (kill-buffer buf)
+ (org-columns-remove-overlays)
+ (setq org-agenda-archives-mode nil)))
+ ;; Maybe restore the pre-agenda window configuration.
+ (and org-agenda-restore-windows-after-quit
+ (not (eq org-agenda-window-setup 'other-frame))
+ org-agenda-pre-window-conf
+ (set-window-configuration org-agenda-pre-window-conf)
+ (setq org-agenda-pre-window-conf nil))))
+
+(defun org-agenda-quit ()
+ "Exit agenda by killing agenda buffer or burying it when
+`org-agenda-sticky' is non-NIL"
+ (interactive)
+ (if (and (eq org-indirect-buffer-display 'other-window)
+ org-last-indirect-buffer)
+ (delete-window (get-buffer-window org-last-indirect-buffer)))
+ (if org-agenda-columns-active
+ (org-columns-quit)
+ (if org-agenda-sticky
+ (let ((buf (current-buffer)))
+ (if (eq org-agenda-window-setup 'other-frame)
+ (progn
+ (delete-frame))
+ (and (not (eq org-agenda-window-setup 'current-window))
+ (not (one-window-p))
+ (delete-window)))
+ (with-current-buffer buf
+ (bury-buffer)
+ ;; Maybe restore the pre-agenda window configuration.
+ (and org-agenda-restore-windows-after-quit
+ (not (eq org-agenda-window-setup 'other-frame))
+ org-agenda-pre-window-conf
+ (set-window-configuration org-agenda-pre-window-conf)
+ (setq org-agenda-pre-window-conf nil))))
+ (org-agenda-Quit))))
+
+(defun org-agenda-exit ()
+ "Exit agenda by removing the window or the buffer.
+Also kill all Org-mode buffers which have been loaded by `org-agenda'.
+Org-mode buffers visited directly by the user will not be touched."
+ (interactive)
+ (org-release-buffers org-agenda-new-buffers)
+ (setq org-agenda-new-buffers nil)
+ (org-agenda-Quit))
+
+(defun org-agenda-kill-all-agenda-buffers ()
+ "Kill all buffers in `org-agena-mode'.
+This is used when toggling sticky agendas. You can also explicitly invoke it
+with `C-c a C-k'."
+ (interactive)
+ (let (blist)
+ (dolist (buf (buffer-list))
+ (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
+ (push buf blist)))
+ (mapc 'kill-buffer blist)))
+
+(defun org-agenda-execute (arg)
+ "Execute another agenda command, keeping same window.
+So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
+in the agenda."
+ (interactive "P")
+ (let ((org-agenda-window-setup 'current-window))
+ (org-agenda arg)))
+
+(defun org-agenda-redo (&optional all)
+ "Rebuild possibly ALL agenda view(s) in the current buffer."
+ (interactive "P")
+ (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
+ (cpa (unless (eq all t) current-prefix-arg))
+ (org-agenda-doing-sticky-redo org-agenda-sticky)
+ (org-agenda-sticky nil)
+ (org-agenda-buffer-name (or org-agenda-this-buffer-name
+ org-agenda-buffer-name))
+ (org-agenda-keep-modes t)
+ (tag-filter org-agenda-tag-filter)
+ (tag-preset (get 'org-agenda-tag-filter :preset-filter))
+ (top-cat-filter org-agenda-top-category-filter)
+ (cat-filter org-agenda-category-filter)
+ (cat-preset (get 'org-agenda-category-filter :preset-filter))
+ (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
+ (cols org-agenda-columns-active)
+ (line (org-current-line))
+ (window-line (- line (org-current-line (window-start))))
+ (lprops (get 'org-agenda-redo-command 'org-lprops))
+ (redo-cmd (get-text-property p 'org-redo-cmd))
+ (last-args (get-text-property p 'org-last-args))
+ (org-agenda-overriding-cmd (get-text-property p 'org-serie-cmd))
+ (org-agenda-overriding-cmd-arguments
+ (unless (eq all t)
+ (cond ((listp last-args)
+ (cons (or cpa (car last-args)) (cdr last-args)))
+ ((stringp last-args)
+ last-args))))
+ (serie-redo-cmd (get-text-property p 'org-serie-redo-cmd)))
+ (put 'org-agenda-tag-filter :preset-filter nil)
+ (put 'org-agenda-category-filter :preset-filter nil)
+ (and cols (org-columns-quit))
+ (message "Rebuilding agenda buffer...")
+ (if serie-redo-cmd
+ (eval serie-redo-cmd)
+ (org-let lprops '(eval redo-cmd)))
+ (setq org-agenda-undo-list nil
+ org-agenda-pending-undo-list nil)
+ (message "Rebuilding agenda buffer...done")
+ (put 'org-agenda-tag-filter :preset-filter tag-preset)
+ (put 'org-agenda-category-filter :preset-filter cat-preset)
+ (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
+ (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
+ (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter))
+ (and cols (org-called-interactively-p 'any) (org-agenda-columns))
+ (org-goto-line line)
+ (recenter window-line)))
+
+(defvar org-global-tags-completion-table nil)
+(defvar org-agenda-filter-form nil)
+(defvar org-agenda-filtered-by-category nil)
+
+(defun org-agenda-filter-by-category (strip)
+ "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+ (interactive "P")
+ (if (and org-agenda-filtered-by-category
+ org-agenda-category-filter)
+ (org-agenda-filter-show-all-cat)
+ (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
+ (if cat (org-agenda-filter-apply
+ (list (concat (if strip "-" "+") cat)) 'category)
+ (error "No category at point")))))
+
+(defun org-find-top-category (&optional pos)
+ (save-excursion
+ (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
+ (if pos (goto-char pos))
+ ;; Skip up to the topmost parent
+ (while (ignore-errors (outline-up-heading 1) t))
+ (ignore-errors
+ (nth 4 (org-heading-components))))))
+
+(defvar org-agenda-filtered-by-top-category nil)
+
+(defun org-agenda-filter-by-top-category (strip)
+ "Keep only those lines in the agenda buffer that have a specific category.
+The category is that of the current line."
+ (interactive "P")
+ (if org-agenda-filtered-by-top-category
+ (progn
+ (setq org-agenda-filtered-by-top-category nil
+ org-agenda-top-category-filter nil)
+ (org-agenda-filter-show-all-cat))
+ (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker))))
+ (if cat (org-agenda-filter-top-category-apply cat strip)
+ (error "No top-level category at point")))))
+
+(defun org-agenda-filter-by-tag (strip &optional char narrow)
+ "Keep only those lines in the agenda buffer that have a specific tag.
+The tag is selected with its fast selection letter, as configured.
+With prefix argument STRIP, remove all lines that do have the tag.
+A lisp caller can specify CHAR. NARROW means that the new tag should be
+used to narrow the search - the interactive user can also press `-' or `+'
+to switch to narrowing."
+ (interactive "P")
+ (let* ((alist org-tag-alist-for-agenda)
+ (tag-chars (mapconcat
+ (lambda (x) (if (and (not (symbolp (car x)))
+ (cdr x))
+ (char-to-string (cdr x))
+ ""))
+ alist ""))
+ (efforts (org-split-string
+ (or (cdr (assoc (concat org-effort-property "_ALL")
+ org-global-properties))
+ "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"
+ "")))
+ (effort-op org-agenda-filter-effort-default-operator)
+ (effort-prompt "")
+ (inhibit-read-only t)
+ (current org-agenda-tag-filter)
+ maybe-refresh a n tag)
+ (unless char
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
+ (if narrow "Narrow" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " ""))
+ (setq char (read-char-exclusive)))
+ (when (member char '(?+ ?-))
+ ;; Narrowing down
+ (cond ((equal char ?-) (setq strip t narrow t))
+ ((equal char ?+) (setq strip nil narrow t)))
+ (message
+ "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
+ (setq char (read-char-exclusive)))
+ (when (member char '(?< ?> ?= ??))
+ ;; An effort operator
+ (setq effort-op (char-to-string char))
+ (setq alist nil) ; to make sure it will be interpreted as effort.
+ (unless (equal char ??)
+ (loop for i from 0 to 9 do
+ (setq effort-prompt
+ (concat
+ effort-prompt " ["
+ (if (= i 9) "0" (int-to-string (1+ i)))
+ "]" (nth i efforts))))
+ (message "Effort%s: %s " effort-op effort-prompt)
+ (setq char (read-char-exclusive))
+ (when (or (< char ?0) (> char ?9))
+ (error "Need 1-9,0 to select effort"))))
+ (when (equal char ?\t)
+ (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
+ (org-set-local 'org-global-tags-completion-table
+ (org-global-tags-completion-table)))
+ (let ((completion-ignore-case t))
+ (setq tag (org-icompleting-read
+ "Tag: " org-global-tags-completion-table))))
+ (cond
+ ((equal char ?\r)
+ (org-agenda-filter-show-all-tag)
+ (when org-agenda-auto-exclude-function
+ (setq org-agenda-tag-filter '())
+ (dolist (tag (org-agenda-get-represented-tags))
+ (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
+ (if modifier
+ (push modifier org-agenda-tag-filter))))
+ (if (not (null org-agenda-tag-filter))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
+ (setq maybe-refresh t))
+ ((equal char ?/)
+ (org-agenda-filter-show-all-tag)
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (setq maybe-refresh t))
+ ((equal char ?. )
+ (setq org-agenda-tag-filter
+ (mapcar (lambda(tag) (concat "+" tag))
+ (org-get-at-bol 'tags)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
+ (setq maybe-refresh t))
+ ((or (equal char ?\ )
+ (setq a (rassoc char alist))
+ (and (>= char ?0) (<= char ?9)
+ (setq n (if (= char ?0) 9 (- char ?0 1))
+ tag (concat effort-op (nth n efforts))
+ a (cons tag nil)))
+ (and (= char ??)
+ (setq tag "?eff")
+ a (cons tag nil))
+ (and tag (setq a (cons tag nil))))
+ (org-agenda-filter-show-all-tag)
+ (setq tag (car a))
+ (setq org-agenda-tag-filter
+ (cons (concat (if strip "-" "+") tag)
+ (if narrow current nil)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag)
+ (setq maybe-refresh t))
+ (t (error "Invalid tag selection character %c" char)))
+ (when (and maybe-refresh
+ (eq org-agenda-clockreport-mode 'with-filter))
+ (org-agenda-redo))))
+
+(defun org-agenda-get-represented-tags ()
+ "Get a list of all tags currently represented in the agenda."
+ (let (p tags)
+ (save-excursion
+ (goto-char (point-min))
+ (while (setq p (next-single-property-change (point) 'tags))
+ (goto-char p)
+ (mapc (lambda (x) (add-to-list 'tags x))
+ (get-text-property (point) 'tags))))
+ tags))
+
+(defun org-agenda-filter-by-tag-refine (strip &optional char)
+ "Refine the current filter. See `org-agenda-filter-by-tag'."
+ (interactive "P")
+ (org-agenda-filter-by-tag strip char 'refine))
+
+(defun org-agenda-filter-make-matcher ()
+ "Create the form that tests a line for agenda filter."
+ (let (f f1)
+ ;; first compute the tag-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-tag-filter
+ :preset-filter) org-agenda-tag-filter)))
+ (if (member x '("-" "+"))
+ (setq f1 (if (equal x "-") 'tags '(not tags)))
+ (if (string-match "[<=>?]" x)
+ (setq f1 (org-agenda-filter-effort-form x))
+ (setq f1 (list 'member (downcase (substring x 1)) 'tags)))
+ (if (equal (string-to-char x) ?-)
+ (setq f1 (list 'not f1))))
+ (push f1 f))
+ ;; then compute the category-filter matcher
+ (dolist (x (delete-dups
+ (append (get 'org-agenda-category-filter
+ :preset-filter) org-agenda-category-filter)))
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
+ (setq f1 (list 'equal (substring x 1) 'cat)))
+ (push f1 f))
+ (cons 'and (nreverse f))))
+
+(defun org-agenda-filter-effort-form (e)
+ "Return the form to compare the effort of the current line with what E says.
+E looks like \"+<2:25\"."
+ (let (op)
+ (setq e (substring e 1))
+ (setq op (string-to-char e) e (substring e 1))
+ (setq op (cond ((equal op ?<) '<=)
+ ((equal op ?>) '>=)
+ ((equal op ??) op)
+ (t '=)))
+ (list 'org-agenda-compare-effort (list 'quote op)
+ (org-duration-string-to-minutes e))))
+
+(defun org-agenda-compare-effort (op value)
+ "Compare the effort of the current line with VALUE, using OP.
+If the line does not have an effort defined, return nil."
+ (let ((eff (org-get-at-bol 'effort-minutes)))
+ (if (equal op ??)
+ (not eff)
+ (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
+ value))))
+
+(defun org-agenda-filter-apply (filter type)
+ "Set FILTER as the new agenda filter and apply it."
+ (let (tags cat)
+ (if (eq type 'tag)
+ (setq org-agenda-tag-filter filter)
+ (setq org-agenda-category-filter filter))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher))
+ (if (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-")))
+ ;; Only set `org-agenda-filtered-by-category' to t
+ ;; when a unique category is used as the filter
+ (setq org-agenda-filtered-by-category t))
+ (org-agenda-set-mode-name)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (org-get-at-bol 'org-marker)
+ (progn
+ (setq tags (org-get-at-bol 'tags) ; used in eval
+ cat (get-text-property (point) 'org-category))
+ (if (not (eval org-agenda-filter-form))
+ (org-agenda-filter-hide-line type))
+ (beginning-of-line 2))
+ (beginning-of-line 2))))
+ (if (get-char-property (point) 'invisible)
+ (ignore-errors (org-agenda-previous-line)))))
+
+(defun org-agenda-filter-top-category-apply (category &optional negative)
+ "Set FILTER as the new agenda filter and apply it."
+ (org-agenda-set-mode-name)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pos (org-get-at-bol 'org-hd-marker))
+ (topcat (and pos (org-find-top-category pos))))
+ (if (and topcat (funcall (if negative 'identity 'not)
+ (string= category topcat)))
+ (org-agenda-filter-hide-line 'category)))
+ (beginning-of-line 2)))
+ (if (get-char-property (point) 'invisible)
+ (org-agenda-previous-line))
+ (setq org-agenda-top-category-filter category
+ org-agenda-filtered-by-top-category t))
+
+(defun org-agenda-filter-hide-line (type)
+ (let (ov)
+ (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
+ (point-at-eol)))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'type type)
+ (if (eq type 'tag)
+ (push ov org-agenda-tag-filter-overlays)
+ (push ov org-agenda-cat-filter-overlays))))
+
+(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
+ (setq pos (or pos (point)))
+ (save-excursion
+ (dolist (ov (overlays-at pos))
+ (when (and (overlay-get ov 'invisible)
+ (eq (overlay-get ov 'type) 'tag))
+ (goto-char pos)
+ (if (< (overlay-start ov) (point-at-eol))
+ (move-overlay ov (point-at-eol)
+ (overlay-end ov)))))))
+
+(defun org-agenda-filter-show-all-tag nil
+ (mapc 'delete-overlay org-agenda-tag-filter-overlays)
+ (setq org-agenda-tag-filter-overlays nil
+ org-agenda-tag-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
+
+(defun org-agenda-filter-show-all-cat nil
+ (mapc 'delete-overlay org-agenda-cat-filter-overlays)
+ (setq org-agenda-cat-filter-overlays nil
+ org-agenda-filtered-by-category nil
+ org-agenda-category-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
+
+(defun org-agenda-manipulate-query-add ()
+ "Manipulate the query by adding a search term with positive selection.
+Positive selection means the term must be matched for selection of an entry."
+ (interactive)
+ (org-agenda-manipulate-query ?\[))
+(defun org-agenda-manipulate-query-subtract ()
+ "Manipulate the query by adding a search term with negative selection.
+Negative selection means term must not be matched for selection of an entry."
+ (interactive)
+ (org-agenda-manipulate-query ?\]))
+(defun org-agenda-manipulate-query-add-re ()
+ "Manipulate the query by adding a search regexp with positive selection.
+Positive selection means the regexp must match for selection of an entry."
+ (interactive)
+ (org-agenda-manipulate-query ?\{))
+(defun org-agenda-manipulate-query-subtract-re ()
+ "Manipulate the query by adding a search regexp with negative selection.
+Negative selection means regexp must not match for selection of an entry."
+ (interactive)
+ (org-agenda-manipulate-query ?\}))
+(defun org-agenda-manipulate-query (char)
+ (cond
+ ((memq org-agenda-type '(timeline agenda))
+ (let ((org-agenda-include-inactive-timestamps t))
+ (org-agenda-redo))
+ (message "Display now includes inactive timestamps as well"))
+ ((eq org-agenda-type 'search)
+ (org-add-to-string
+ 'org-agenda-query-string
+ (if org-agenda-last-search-view-search-was-boolean
+ (cdr (assoc char '((?\[ . " +") (?\] . " -")
+ (?\{ . " +{}") (?\} . " -{}"))))
+ " "))
+ (setq org-agenda-redo-command
+ (list 'org-search-view
+ (car (get-text-property (min (1- (point-max)) (point))
+ 'org-last-args))
+ org-agenda-query-string
+ (+ (length org-agenda-query-string)
+ (if (member char '(?\{ ?\})) 0 1))))
+ (set-register org-agenda-query-register org-agenda-query-string)
+ (let ((org-agenda-overriding-arguments
+ (cdr org-agenda-redo-command)))
+ (org-agenda-redo)))
+ (t (error "Cannot manipulate query for %s-type agenda buffers"
+ org-agenda-type))))
+
+(defun org-add-to-string (var string)
+ (set var (concat (symbol-value var) string)))
+
+(defun org-agenda-goto-date (span)
+ "Jump to DATE in agenda."
+ (interactive "P")
+ (let* ((org-read-date-prefer-future
+ (eval org-agenda-jump-prefer-future))
+ (date (org-read-date))
+ (org-agenda-sticky-orig org-agenda-sticky)
+ (org-agenda-buffer-tmp-name (buffer-name))
+ (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (0-arg (or current-prefix-arg (car args)))
+ (2-arg (nth 2 args))
+ (newcmd (list 'org-agenda-list 0-arg date
+ (org-agenda-span-to-ndays 2-arg)))
+ (newargs (cdr newcmd))
+ (inhibit-read-only t)
+ org-agenda-sticky)
+ (if (not (org-agenda-check-type t 'agenda))
+ (error "Not available in non-agenda blocks")
+ (add-text-properties (point-min) (point-max)
+ `(org-redo-cmd ,newcmd org-last-args ,newargs))
+ (org-agenda-redo)
+ (setq org-agenda-sticky org-agenda-sticky-orig
+ org-agenda-this-buffer-is-sticky org-agenda-sticky))))
+
+(defun org-agenda-goto-today ()
+ "Go to today."
+ (interactive)
+ (org-agenda-check-type t 'timeline 'agenda)
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (curspan (nth 2 args))
+ (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
+ (cond
+ (tdpos (goto-char tdpos))
+ ((eq org-agenda-type 'agenda)
+ (let* ((sd (org-agenda-compute-starting-span
+ (org-today) (or curspan org-agenda-ndays org-agenda-span)))
+ (org-agenda-overriding-arguments args))
+ (setf (nth 1 org-agenda-overriding-arguments) sd)
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda)))
+ (t (error "Cannot find today")))))
+
+(defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
+ (goto-char
+ (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
+ (text-property-any (point-min) (point-max) 'org-today t)
+ (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
+ (and (get-text-property (min (1- (point-max)) (point)) 'org-serie)
+ (org-agenda-goto-block-beginning))
+ (point-min))))
+
+(defun org-agenda-goto-block-beginning ()
+ "Go the agenda block beginning."
+ (interactive)
+ (if (not (derived-mode-p 'org-agenda-mode))
+ (error "Cannot execute this command outside of org-agenda-mode buffers")
+ (let (dest)
+ (save-excursion
+ (unless (looking-at "\\'")
+ (forward-char))
+ (let* ((prop 'org-agenda-structural-header)
+ (p (previous-single-property-change (point) prop))
+ (n (next-single-property-change (or (and (looking-at "\\`") 1)
+ (1- (point))) prop)))
+ (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
+ (if (not dest)
+ (error "Cannot find the beginning of the blog")
+ (goto-char dest)
+ (move-beginning-of-line 1)))))
+
+(defun org-agenda-later (arg)
+ "Go forward in time by thee current span.
+With prefix ARG, go forward that many times the current span."
+ (interactive "p")
+ (org-agenda-check-type t 'agenda)
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (span (or (nth 2 args) org-agenda-current-span))
+ (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
+ (greg (calendar-gregorian-from-absolute sd))
+ (cnt (org-get-at-bol 'org-day-cnt))
+ greg2)
+ (cond
+ ((numberp span)
+ (setq sd (+ span sd)))
+ ((eq span 'day)
+ (setq sd (+ arg sd)))
+ ((eq span 'week)
+ (setq sd (+ (* 7 arg) sd)))
+ ((eq span 'month)
+ (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
+ sd (calendar-absolute-from-gregorian greg2))
+ (setcar greg2 (1+ (car greg2))))
+ ((eq span 'year)
+ (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
+ sd (calendar-absolute-from-gregorian greg2))
+ (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
+ (t
+ (setq sd (+ (* span arg) sd))))
+ (let ((org-agenda-overriding-cmd
+ ;; `cmd' may have been set by `org-agenda-run-series' which
+ ;; uses `org-agenda-overriding-cmd' to decide whether
+ ;; overriding is allowed for `cmd'
+ (get-text-property (min (1- (point-max)) (point)) 'org-serie-cmd))
+ (org-agenda-overriding-arguments
+ (list (car args) sd span)))
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda cnt))))
+
+(defun org-agenda-earlier (arg)
+ "Go backward in time by the current span.
+With prefix ARG, go backward that many times the current span."
+ (interactive "p")
+ (org-agenda-later (- arg)))
+
+(defun org-agenda-view-mode-dispatch ()
+ "Call one of the view mode commands."
+ (interactive)
+ (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
+ time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
+ [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
+ (let ((a (read-char-exclusive)))
+ (case a
+ (?\ (call-interactively 'org-agenda-reset-view))
+ (?d (call-interactively 'org-agenda-day-view))
+ (?w (call-interactively 'org-agenda-week-view))
+ (?m (call-interactively 'org-agenda-month-view))
+ (?y (call-interactively 'org-agenda-year-view))
+ (?l (call-interactively 'org-agenda-log-mode))
+ (?L (org-agenda-log-mode '(4)))
+ (?c (org-agenda-log-mode 'clockcheck))
+ ((?F ?f) (call-interactively 'org-agenda-follow-mode))
+ (?a (call-interactively 'org-agenda-archives-mode))
+ (?A (org-agenda-archives-mode 'files))
+ ((?R ?r) (call-interactively 'org-agenda-clockreport-mode))
+ ((?E ?e) (call-interactively 'org-agenda-entry-text-mode))
+ (?G (call-interactively 'org-agenda-toggle-time-grid))
+ (?D (call-interactively 'org-agenda-toggle-diary))
+ (?\! (call-interactively 'org-agenda-toggle-deadlines))
+ (?\[ (let ((org-agenda-include-inactive-timestamps t))
+ (org-agenda-check-type t 'timeline 'agenda)
+ (org-agenda-redo))
+ (message "Display now includes inactive timestamps as well"))
+ (?q (message "Abort"))
+ (otherwise (error "Invalid key" )))))
+
+(defun org-agenda-reset-view ()
+ "Switch to default view for agenda."
+ (interactive)
+ (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span)))
+(defun org-agenda-day-view (&optional day-of-year)
+ "Switch to daily view for agenda.
+With argument DAY-OF-YEAR, switch to that day of the year."
+ (interactive "P")
+ (org-agenda-change-time-span 'day day-of-year))
+(defun org-agenda-week-view (&optional iso-week)
+ "Switch to daily view for agenda.
+With argument ISO-WEEK, switch to the corresponding ISO week.
+If ISO-WEEK has more then 2 digits, only the last two encode the
+week. Any digits before this encode a year. So 200712 means
+week 12 of year 2007. Years in the range 1938-2037 can also be
+written as 2-digit years."
+ (interactive "P")
+ (org-agenda-change-time-span 'week iso-week))
+(defun org-agenda-month-view (&optional month)
+ "Switch to monthly view for agenda.
+With argument MONTH, switch to that month."
+ (interactive "P")
+ (org-agenda-change-time-span 'month month))
+(defun org-agenda-year-view (&optional year)
+ "Switch to yearly view for agenda.
+With argument YEAR, switch to that year.
+If MONTH has more then 2 digits, only the last two encode the
+month. Any digits before this encode a year. So 200712 means
+December year 2007. Years in the range 1938-2037 can also be
+written as 2-digit years."
+ (interactive "P")
+ (when year
+ (setq year (org-small-year-to-year year)))
+ (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
+ (org-agenda-change-time-span 'year year)
+ (error "Abort")))
+
+(defun org-agenda-change-time-span (span &optional n)
+ "Change the agenda view to SPAN.
+SPAN may be `day', `week', `month', `year'."
+ (org-agenda-check-type t 'agenda)
+ (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
+ (curspan (nth 2 args)))
+ (if (and (not n) (equal curspan span))
+ (error "Viewing span is already \"%s\"" span))
+ (let* ((sd (or (org-get-at-bol 'day)
+ (nth 1 args)
+ org-starting-day))
+ (sd (org-agenda-compute-starting-span sd span n))
+ (org-agenda-overriding-cmd
+ (get-text-property (min (1- (point-max)) (point)) 'org-serie-cmd))
+ (org-agenda-overriding-arguments
+ (list (car args) sd span)))
+ (org-agenda-redo)
+ (org-agenda-find-same-or-today-or-agenda))
+ (org-agenda-set-mode-name)
+ (message "Switched to %s view" span)))
+
+(defun org-agenda-compute-starting-span (sd span &optional n)
+ "Compute starting date for agenda.
+SPAN may be `day', `week', `month', `year'. The return value
+is a cons cell with the starting date and the number of days,
+so that the date SD will be in that range."
+ (let* ((greg (calendar-gregorian-from-absolute sd))
+ (dg (nth 1 greg))
+ (mg (car greg))
+ (yg (nth 2 greg)))
+ (cond
+ ((eq span 'day)
+ (when n
+ (setq sd (+ (calendar-absolute-from-gregorian
+ (list mg 1 yg))
+ n -1))))
+ ((eq span 'week)
+ (let* ((nt (calendar-day-of-week
+ (calendar-gregorian-from-absolute sd)))
+ (d (if org-agenda-start-on-weekday
+ (- nt org-agenda-start-on-weekday)
+ 0))
+ y1)
+ (setq sd (- sd (+ (if (< d 0) 7 0) d)))
+ (when n
+ (require 'cal-iso)
+ (when (> n 99)
+ (setq y1 (org-small-year-to-year (/ n 100))
+ n (mod n 100)))
+ (setq sd
+ (calendar-absolute-from-iso
+ (list n 1
+ (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
+ ((eq span 'month)
+ (let (y1)
+ (when (and n (> n 99))
+ (setq y1 (org-small-year-to-year (/ n 100))
+ n (mod n 100)))
+ (setq sd (calendar-absolute-from-gregorian
+ (list (or n mg) 1 (or y1 yg))))))
+ ((eq span 'year)
+ (setq sd (calendar-absolute-from-gregorian
+ (list 1 1 (or n yg))))))
+ sd))
+
+(defun org-agenda-next-date-line (&optional arg)
+ "Jump to the next line indicating a date in agenda buffer."
+ (interactive "p")
+ (org-agenda-check-type t 'agenda 'timeline)
+ (beginning-of-line 1)
+ ;; This does not work if user makes date format that starts with a blank
+ (if (looking-at "^\\S-") (forward-char 1))
+ (if (not (re-search-forward "^\\S-" nil t arg))
+ (progn
+ (backward-char 1)
+ (error "No next date after this line in this buffer")))
+ (goto-char (match-beginning 0)))
+
+(defun org-agenda-previous-date-line (&optional arg)
+ "Jump to the previous line indicating a date in agenda buffer."
+ (interactive "p")
+ (org-agenda-check-type t 'agenda 'timeline)
+ (beginning-of-line 1)
+ (if (not (re-search-backward "^\\S-" nil t arg))
+ (error "No previous date before this line in this buffer")))
+
+;; Initialize the highlight
+(defvar org-hl (make-overlay 1 1))
+(overlay-put org-hl 'face 'highlight)
+
+(defun org-highlight (begin end &optional buffer)
+ "Highlight a region with overlay."
+ (move-overlay org-hl begin end (or buffer (current-buffer))))
+
+(defun org-unhighlight ()
+ "Detach overlay INDEX."
+ (org-detach-overlay org-hl))
+
+(defun org-unhighlight-once ()
+ "Remove the highlight from its position, and this function from the hook."
+ (remove-hook 'pre-command-hook 'org-unhighlight-once)
+ (org-unhighlight))
+
+(defvar org-agenda-pre-follow-window-conf nil)
+(defun org-agenda-follow-mode ()
+ "Toggle follow mode in an agenda buffer."
+ (interactive)
+ (unless org-agenda-follow-mode
+ (setq org-agenda-pre-follow-window-conf
+ (current-window-configuration)))
+ (setq org-agenda-follow-mode (not org-agenda-follow-mode))
+ (unless org-agenda-follow-mode
+ (set-window-configuration org-agenda-pre-follow-window-conf))
+ (org-agenda-set-mode-name)
+ (org-agenda-do-context-action)
+ (message "Follow mode is %s"
+ (if org-agenda-follow-mode "on" "off")))
+
+(defun org-agenda-entry-text-mode (&optional arg)
+ "Toggle entry text mode in an agenda buffer."
+ (interactive "P")
+ (setq org-agenda-entry-text-mode (or (integerp arg)
+ (not org-agenda-entry-text-mode)))
+ (org-agenda-entry-text-hide)
+ (and org-agenda-entry-text-mode
+ (let ((org-agenda-entry-text-maxlines
+ (if (integerp arg) arg org-agenda-entry-text-maxlines)))
+ (org-agenda-entry-text-show)))
+ (org-agenda-set-mode-name)
+ (message "Entry text mode is %s. Maximum number of lines is %d"
+ (if org-agenda-entry-text-mode "on" "off")
+ (if (integerp arg) arg org-agenda-entry-text-maxlines)))
+
+(defun org-agenda-clockreport-mode (&optional with-filter)
+ "Toggle clocktable mode in an agenda buffer.
+With prefix arg WITH-FILTER, make the clocktable respect the current
+agenda filter."
+ (interactive "P")
+ (org-agenda-check-type t 'agenda)
+ (if with-filter
+ (setq org-agenda-clockreport-mode 'with-filter)
+ (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)))
+ (org-agenda-set-mode-name)
+ (org-agenda-redo)
+ (message "Clocktable mode is %s"
+ (if org-agenda-clockreport-mode "on" "off")))
+
+(defun org-agenda-log-mode (&optional special)
+ "Toggle log mode in an agenda buffer.
+With argument SPECIAL, show all possible log items, not only the ones
+configured in `org-agenda-log-mode-items'.
+With a double `C-u' prefix arg, show *only* log items, nothing else."
+ (interactive "P")
+ (org-agenda-check-type t 'agenda 'timeline)
+ (setq org-agenda-show-log
+ (cond
+ ((equal special '(16)) 'only)
+ ((eq special 'clockcheck)
+ (if (eq org-agenda-show-log 'clockcheck)
+ nil 'clockcheck))
+ (special '(closed clock state))
+ (t (not org-agenda-show-log))))
+ (org-agenda-set-mode-name)
+ (org-agenda-redo)
+ (message "Log mode is %s"
+ (if org-agenda-show-log "on" "off")))
+
+(defun org-agenda-archives-mode (&optional with-files)
+ "Toggle inclusion of items in trees marked with :ARCHIVE:.
+When called with a prefix argument, include all archive files as well."
+ (interactive "P")
+ (setq org-agenda-archives-mode
+ (if with-files t (if org-agenda-archives-mode nil 'trees)))
+ (org-agenda-set-mode-name)
+ (org-agenda-redo)
+ (message
+ "%s"
+ (cond
+ ((eq org-agenda-archives-mode nil)
+ "No archives are included")
+ ((eq org-agenda-archives-mode 'trees)
+ (format "Trees with :%s: tag are included" org-archive-tag))
+ ((eq org-agenda-archives-mode t)
+ (format "Trees with :%s: tag and all active archive files are included"
+ org-archive-tag)))))
+
+(defun org-agenda-toggle-diary ()
+ "Toggle diary inclusion in an agenda buffer."
+ (interactive)
+ (org-agenda-check-type t 'agenda)
+ (setq org-agenda-include-diary (not org-agenda-include-diary))
+ (org-agenda-redo)
+ (org-agenda-set-mode-name)
+ (message "Diary inclusion turned %s"
+ (if org-agenda-include-diary "on" "off")))
+
+(defun org-agenda-toggle-deadlines ()
+ "Toggle inclusion of entries with a deadline in an agenda buffer."
+ (interactive)
+ (org-agenda-check-type t 'agenda)
+ (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
+ (org-agenda-redo)
+ (org-agenda-set-mode-name)
+ (message "Deadlines inclusion turned %s"
+ (if org-agenda-include-deadlines "on" "off")))
+
+(defun org-agenda-toggle-time-grid ()
+ "Toggle time grid in an agenda buffer."
+ (interactive)
+ (org-agenda-check-type t 'agenda)
+ (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
+ (org-agenda-redo)
+ (org-agenda-set-mode-name)
+ (message "Time-grid turned %s"
+ (if org-agenda-use-time-grid "on" "off")))
+
+(defun org-agenda-set-mode-name ()
+ "Set the mode name to indicate all the small mode settings."
+ (setq mode-name
+ (list "Org-Agenda"
+ (if (get 'org-agenda-files 'org-restrict) " []" "")
+ " "
+ '(:eval (org-agenda-span-name org-agenda-current-span))
+ (if org-agenda-follow-mode " Follow" "")
+ (if org-agenda-entry-text-mode " ETxt" "")
+ (if org-agenda-include-diary " Diary" "")
+ (if org-agenda-include-deadlines " Ddl" "")
+ (if org-agenda-use-time-grid " Grid" "")
+ (if (and (boundp 'org-habit-show-habits)
+ org-habit-show-habits) " Habit" "")
+ (cond
+ ((consp org-agenda-show-log) " LogAll")
+ ((eq org-agenda-show-log 'clockcheck) " ClkCk")
+ (org-agenda-show-log " Log")
+ (t ""))
+ (if (or org-agenda-category-filter (get 'org-agenda-category-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " <"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-category-filter :preset-filter)
+ org-agenda-category-filter)
+ "")
+ ">")
+ 'face 'org-agenda-filter-category
+ 'help-echo "Category used in filtering"))
+ "")
+ (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
+ :preset-filter))
+ '(:eval (org-propertize
+ (concat " {"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-tag-filter :preset-filter)
+ org-agenda-tag-filter)
+ "")
+ "}")
+ 'face 'org-agenda-filter-tags
+ 'help-echo "Tags used in filtering"))
+ "")
+ (if org-agenda-archives-mode
+ (if (eq org-agenda-archives-mode t)
+ " Archives"
+ (format " :%s:" org-archive-tag))
+ "")
+ (if org-agenda-clockreport-mode
+ (if (eq org-agenda-clockreport-mode 'with-filter)
+ " Clock{}" " Clock")
+ "")))
+ (force-mode-line-update))
+
+(define-obsolete-function-alias
+ 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3")
+
+(defun org-agenda-update-agenda-type ()
+ "Update the agenda type after each command."
+ (setq org-agenda-type
+ (or (get-text-property (point) 'org-agenda-type)
+ (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
+
+(defun org-agenda-next-line ()
+ "Move cursor to the next line, and show if follow mode is active."
+ (interactive)
+ (call-interactively 'next-line)
+ (org-agenda-do-context-action))
+
+(defun org-agenda-previous-line ()
+ "Move cursor to the previous line, and show if follow-mode is active."
+ (interactive)
+ (call-interactively 'previous-line)
+ (org-agenda-do-context-action))
+
+(defun org-agenda-next-item (n)
+ "Move cursor to next agenda item."
+ (interactive "p")
+ (let ((col (current-column)))
+ (dotimes (c n)
+ (when (next-single-property-change (point-at-eol) 'org-marker)
+ (move-end-of-line 1)
+ (goto-char (next-single-property-change (point) 'org-marker))))
+ (org-move-to-column col))
+ (org-agenda-do-context-action))
+
+(defun org-agenda-previous-item (n)
+ "Move cursor to next agenda item."
+ (interactive "p")
+ (dotimes (c n)
+ (let ((col (current-column))
+ (goto (save-excursion
+ (move-end-of-line 0)
+ (previous-single-property-change (point) 'org-marker))))
+ (if goto (goto-char goto))
+ (org-move-to-column col)))
+ (org-agenda-do-context-action))
+
+(defun org-agenda-do-context-action ()
+ "Show outline path and, maybe, follow mode window."
+ (let ((m (org-get-at-bol 'org-marker)))
+ (when (and (markerp m) (marker-buffer m))
+ (and org-agenda-follow-mode
+ (if org-agenda-follow-indirect
+ (org-agenda-tree-to-indirect-buffer nil)
+ (org-agenda-show)))
+ (and org-agenda-show-outline-path
+ (org-with-point-at m (org-display-outline-path t))))))
+
+(defun org-agenda-show-tags ()
+ "Show the tags applicable to the current item."
+ (interactive)
+ (let* ((tags (org-get-at-bol 'tags)))
+ (if tags
+ (message "Tags are :%s:"
+ (org-no-properties (mapconcat 'identity tags ":")))
+ (message "No tags associated with this line"))))
+
+(defun org-agenda-goto (&optional highlight)
+ "Go to the Org-mode file which contains the item at point."
+ (interactive)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (switch-to-buffer-other-window buffer)
+ (widen)
+ (push-mark)
+ (goto-char pos)
+ (when (derived-mode-p 'org-mode)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil)))) ; show the next heading
+ (when (outline-invisible-p)
+ (show-entry)) ; display invisible text
+ (recenter (/ (window-height) 2))
+ (run-hooks 'org-agenda-after-show-hook)
+ (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
+
+(defvar org-agenda-after-show-hook nil
+ "Normal hook run after an item has been shown from the agenda.
+Point is in the buffer where the item originated.")
+
+(defun org-agenda-kill ()
+ "Kill the entry or subtree belonging to the current agenda entry."
+ (interactive)
+ (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (type (org-get-at-bol 'type))
+ dbeg dend (n 0) conf)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char pos)
+ (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
+ (setq dbeg (progn (org-back-to-heading t) (point))
+ dend (org-end-of-subtree t t))
+ (setq dbeg (point-at-bol)
+ dend (min (point-max) (1+ (point-at-eol)))))
+ (goto-char dbeg)
+ (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
+ (setq conf (or (eq t org-agenda-confirm-kill)
+ (and (numberp org-agenda-confirm-kill)
+ (> n org-agenda-confirm-kill))))
+ (and conf
+ (not (y-or-n-p
+ (format "Delete entry with %d lines in buffer \"%s\"? "
+ n (buffer-name buffer))))
+ (error "Abort"))
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda buffer dbeg dend))
+ (with-current-buffer buffer (delete-region dbeg dend))
+ (message "Agenda item and source killed"))))
+
+(defvar org-archive-default-command) ; defined in org-archive.el
+(defun org-agenda-archive-default ()
+ "Archive the entry or subtree belonging to the current agenda entry."
+ (interactive)
+ (require 'org-archive)
+ (org-agenda-archive-with org-archive-default-command))
+
+(defun org-agenda-archive-default-with-confirmation ()
+ "Archive the entry or subtree belonging to the current agenda entry."
+ (interactive)
+ (require 'org-archive)
+ (org-agenda-archive-with org-archive-default-command 'confirm))
+
+(defun org-agenda-archive ()
+ "Archive the entry or subtree belonging to the current agenda entry."
+ (interactive)
+ (org-agenda-archive-with 'org-archive-subtree))
+
+(defun org-agenda-archive-to-archive-sibling ()
+ "Move the entry to the archive sibling."
+ (interactive)
+ (org-agenda-archive-with 'org-archive-to-archive-sibling))
+
+(defun org-agenda-archive-with (cmd &optional confirm)
+ "Move the entry to the archive sibling."
+ (interactive)
+ (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
+ (let* ((bufname-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (if (derived-mode-p 'org-mode)
+ (if (and confirm
+ (not (y-or-n-p "Archive this subtree or entry? ")))
+ (error "Abort")
+ (save-excursion
+ (goto-char pos)
+ (let ((org-agenda-buffer-name bufname-orig))
+ (org-remove-subtree-entries-from-agenda))
+ (org-back-to-heading t)
+ (funcall cmd)))
+ (error "Archiving works only in Org-mode files"))))))
+
+(defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
+ "Remove all lines in the agenda that correspond to a given subtree.
+The subtree is the one in buffer BUF, starting at BEG and ending at END.
+If this information is not given, the function uses the tree at point."
+ (let ((buf (or buf (current-buffer))) m p)
+ (save-excursion
+ (unless (and beg end)
+ (org-back-to-heading t)
+ (setq beg (point))
+ (org-end-of-subtree t)
+ (setq end (point)))
+ (set-buffer (get-buffer org-agenda-buffer-name))
+ (save-excursion
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (while (not (bobp))
+ (when (and (setq m (org-get-at-bol 'org-marker))
+ (equal buf (marker-buffer m))
+ (setq p (marker-position m))
+ (>= p beg)
+ (< p end))
+ (let ((inhibit-read-only t))
+ (delete-region (point-at-bol) (1+ (point-at-eol)))))
+ (beginning-of-line 0))))))
+
+(defun org-agenda-refile (&optional goto rfloc no-update)
+ "Refile the item at point."
+ (interactive "P")
+ (if (equal goto '(16))
+ (org-refile-goto-last-stored)
+ (let* ((buffer-orig (buffer-name))
+ (marker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (rfloc (or rfloc
+ (org-refile-get-location
+ (if goto "Goto" "Refile to") buffer
+ org-refile-allow-creating-parent-nodes))))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char marker)
+ (let ((org-agenda-buffer-name buffer-orig))
+ (org-remove-subtree-entries-from-agenda))
+ (org-refile goto buffer rfloc)))))
+ (unless no-update (org-agenda-redo))))
+
+(defun org-agenda-open-link (&optional arg)
+ "Follow the link in the current line, if any.
+This looks for a link in the displayed line in the agenda. It also looks
+at the text of the entry itself."
+ (interactive "P")
+ (let* ((marker (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker)))
+ (buffer (and marker (marker-buffer marker)))
+ (prefix (buffer-substring
+ (point-at-bol) (point-at-eol))))
+ (cond
+ (buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char marker)
+ (org-offer-links-in-entry arg prefix)))))
+ ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)"))
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)"))))
+ (org-open-link-from-string (match-string 1)))
+ (t (error "No link to open here")))))
+
+(defun org-agenda-copy-local-variable (var)
+ "Get a variable from a referenced buffer and install it here."
+ (let ((m (org-get-at-bol 'org-marker)))
+ (when (and m (buffer-live-p (marker-buffer m)))
+ (org-set-local var (with-current-buffer (marker-buffer m)
+ (symbol-value var))))))
+
+(defun org-agenda-switch-to (&optional delete-other-windows)
+ "Go to the Org-mode file which contains the item at point."
+ (interactive)
+ (if (and org-return-follows-link
+ (not (org-get-at-bol 'org-marker))
+ (org-in-regexp org-bracket-link-regexp))
+ (org-open-link-from-string (match-string 0))
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (org-pop-to-buffer-same-window buffer)
+ (and delete-other-windows (delete-other-windows))
+ (widen)
+ (goto-char pos)
+ (when (derived-mode-p 'org-mode)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (when (outline-invisible-p)
+ (show-entry)) ; display invisible text
+ (run-hooks 'org-agenda-after-show-hook)))))
+
+(defun org-agenda-goto-mouse (ev)
+ "Go to the Org-mode file which contains the item at the mouse click."
+ (interactive "e")
+ (mouse-set-point ev)
+ (org-agenda-goto))
+
+(defun org-agenda-show (&optional full-entry)
+ "Display the Org-mode file which contains the item at point.
+With prefix argument FULL-ENTRY, make the entire entry visible
+if it was hidden in the outline."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (if full-entry
+ (let ((org-show-entry-below t))
+ (org-agenda-goto t))
+ (org-agenda-goto t))
+ (select-window win)))
+
+(defvar org-agenda-show-window nil)
+(defun org-agenda-show-and-scroll-up (&optional arg)
+ "Display the Org-mode file which contains the item at point.
+When called repeatedly, scroll the window that is displaying the buffer.
+With a \\[universal-argument] prefix, use `org-show-entry' instead of
+`show-subtree' to display the item, so that drawers and logbooks stay
+folded."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (if (and (window-live-p org-agenda-show-window)
+ (eq this-command last-command))
+ (progn
+ (select-window org-agenda-show-window)
+ (ignore-errors (scroll-up)))
+ (org-agenda-goto t)
+ (if arg (org-show-entry) (show-subtree))
+ (setq org-agenda-show-window (selected-window)))
+ (select-window win)))
+
+(defun org-agenda-show-scroll-down ()
+ "Scroll down the window showing the agenda."
+ (interactive)
+ (let ((win (selected-window)))
+ (when (window-live-p org-agenda-show-window)
+ (select-window org-agenda-show-window)
+ (ignore-errors (scroll-down))
+ (select-window win))))
+
+(defun org-agenda-show-1 (&optional more)
+ "Display the Org-mode file which contains the item at point.
+The prefix arg selects the amount of information to display:
+
+0 hide the subtree
+1 just show the entry according to defaults.
+2 show the children view
+3 show the subtree view
+4 show the entire subtree and any LOGBOOK drawers
+5 show the entire subtree and any drawers
+With prefix argument FULL-ENTRY, make the entire entry visible
+if it was hidden in the outline."
+ (interactive "p")
+ (let ((win (selected-window)))
+ (org-agenda-goto t)
+ (org-recenter-heading 1)
+ (cond
+ ((= more 0)
+ (hide-subtree)
+ (save-excursion
+ (org-back-to-heading)
+ (run-hook-with-args 'org-cycle-hook 'folded))
+ (message "Remote: FOLDED"))
+ ((and (org-called-interactively-p 'any) (= more 1))
+ (message "Remote: show with default settings"))
+ ((= more 2)
+ (show-entry)
+ (show-children)
+ (save-excursion
+ (org-back-to-heading)
+ (run-hook-with-args 'org-cycle-hook 'children))
+ (message "Remote: CHILDREN"))
+ ((= more 3)
+ (show-subtree)
+ (save-excursion
+ (org-back-to-heading)
+ (run-hook-with-args 'org-cycle-hook 'subtree))
+ (message "Remote: SUBTREE"))
+ ((= more 4)
+ (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
+ (org-drawer-regexp
+ (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$")))
+ (show-subtree)
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle-hide-drawers 'subtree)))
+ (message "Remote: SUBTREE AND LOGBOOK"))
+ ((> more 4)
+ (show-subtree)
+ (message "Remote: SUBTREE AND ALL DRAWERS")))
+ (select-window win)))
+
+(defun org-recenter-heading (n)
+ (save-excursion
+ (org-back-to-heading)
+ (recenter n)))
+
+(defvar org-agenda-cycle-counter nil)
+(defun org-agenda-cycle-show (&optional n)
+ "Show the current entry in another window, with default settings.
+Default settings are taken from `org-show-hierarchy-above' and siblings.
+When use repeatedly in immediate succession, the remote entry will cycle
+through visibility
+
+children -> subtree -> folded
+
+When called with a numeric prefix arg, that arg will be passed through to
+`org-agenda-show-1'. For the interpretation of that argument, see the
+docstring of `org-agenda-show-1'."
+ (interactive "P")
+ (if (integerp n)
+ (setq org-agenda-cycle-counter n)
+ (if (not (eq last-command this-command))
+ (setq org-agenda-cycle-counter 1)
+ (if (equal org-agenda-cycle-counter 0)
+ (setq org-agenda-cycle-counter 2)
+ (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
+ (if (> org-agenda-cycle-counter 3)
+ (setq org-agenda-cycle-counter 0)))))
+ (org-agenda-show-1 org-agenda-cycle-counter))
+
+(defun org-agenda-recenter (arg)
+ "Display the Org-mode file which contains the item at point and recenter."
+ (interactive "P")
+ (let ((win (selected-window)))
+ (org-agenda-goto t)
+ (recenter arg)
+ (select-window win)))
+
+(defun org-agenda-show-mouse (ev)
+ "Display the Org-mode file which contains the item at the mouse click."
+ (interactive "e")
+ (mouse-set-point ev)
+ (org-agenda-show))
+
+(defun org-agenda-check-no-diary ()
+ "Check if the entry is a diary link and abort if yes."
+ (if (org-get-at-bol 'org-agenda-diary-link)
+ (org-agenda-error)))
+
+(defun org-agenda-error ()
+ (error "Command not allowed in this line"))
+
+(defun org-agenda-tree-to-indirect-buffer (arg)
+ "Show the subtree corresponding to the current entry in an indirect buffer.
+This calls the command `org-tree-to-indirect-buffer' from the original buffer.
+
+With a numerical prefix ARG, go up to this level and then take that tree.
+With a negative numeric ARG, go up by this number of levels.
+With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
+use the dedicated frame)."
+ (interactive "P")
+ (if current-prefix-arg
+ (org-agenda-do-tree-to-indirect-buffer arg)
+ (let ((agenda-buffer (buffer-name))
+ (agenda-window (selected-window))
+ (indirect-window
+ (and org-last-indirect-buffer
+ (get-buffer-window org-last-indirect-buffer))))
+ (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
+ (unless (or (eq org-indirect-buffer-display 'new-frame)
+ (eq org-indirect-buffer-display 'dedicated-frame))
+ (unwind-protect
+ (unless (and indirect-window (window-live-p indirect-window))
+ (setq indirect-window (split-window agenda-window)))
+ (and indirect-window (select-window indirect-window))
+ (switch-to-buffer org-last-indirect-buffer :norecord)
+ (fit-window-to-buffer indirect-window)))
+ (select-window (get-buffer-window agenda-buffer)))))
+
+(defun org-agenda-do-tree-to-indirect-buffer (arg)
+ "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char pos)
+ (funcall 'org-tree-to-indirect-buffer arg)))))
+
+(defvar org-last-heading-marker (make-marker)
+ "Marker pointing to the headline that last changed its TODO state
+by a remote command from the agenda.")
+
+(defun org-agenda-todo-nextset ()
+ "Switch TODO entry to next sequence."
+ (interactive)
+ (org-agenda-todo 'nextset))
+
+(defun org-agenda-todo-previousset ()
+ "Switch TODO entry to previous sequence."
+ (interactive)
+ (org-agenda-todo 'previousset))
+
+(defun org-agenda-todo (&optional arg)
+ "Cycle TODO state of line at point, also in Org-mode file.
+This changes the line at point, all other lines in the agenda referring to
+the same tree node, and the headline of the tree node in the Org-mode file."
+ (interactive "P")
+ (org-agenda-check-no-diary)
+ (let* ((col (current-column))
+ (marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (hdmarker (org-get-at-bol 'org-hd-marker))
+ (todayp (org-agenda-todayp (org-get-at-bol 'day)))
+ (inhibit-read-only t)
+ org-agenda-headline-snapshot-before-repeat newhead just-one)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (let ((current-prefix-arg arg))
+ (call-interactively 'org-todo))
+ (and (bolp) (forward-char 1))
+ (setq newhead (org-get-heading))
+ (when (and (org-bound-and-true-p
+ org-agenda-headline-snapshot-before-repeat)
+ (not (equal org-agenda-headline-snapshot-before-repeat
+ newhead))
+ todayp)
+ (setq newhead org-agenda-headline-snapshot-before-repeat
+ just-one t))
+ (save-excursion
+ (org-back-to-heading)
+ (move-marker org-last-heading-marker (point))))
+ (beginning-of-line 1)
+ (save-excursion
+ (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
+ (org-move-to-column col))))
+
+(defun org-agenda-add-note (&optional arg)
+ "Add a time-stamped note to the entry at point."
+ (interactive "P")
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (hdmarker (org-get-at-bol 'org-hd-marker))
+ (inhibit-read-only t))
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (org-add-note))))
+
+(defun org-agenda-change-all-lines (newhead hdmarker
+ &optional fixface just-this)
+ "Change all lines in the agenda buffer which match HDMARKER.
+The new content of the line will be NEWHEAD (as modified by
+`org-agenda-format-item'). HDMARKER is checked with
+`equal' against all `org-hd-marker' text properties in the file.
+If FIXFACE is non-nil, the face of each item is modified according to
+the new TODO state.
+If JUST-THIS is non-nil, change just the current line, not all.
+If FORCE-TAGS is non nil, the car of it returns the new tags."
+ (let* ((inhibit-read-only t)
+ (line (org-current-line))
+ (org-agenda-buffer (current-buffer))
+ (thetags (with-current-buffer (marker-buffer hdmarker)
+ (save-excursion (save-restriction (widen)
+ (goto-char hdmarker)
+ (org-get-tags-at)))))
+ props m pl undone-face done-face finish new dotime cat tags)
+ (save-excursion
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (while (not finish)
+ (setq finish (bobp))
+ (when (and (setq m (org-get-at-bol 'org-hd-marker))
+ (or (not just-this) (= (org-current-line) line))
+ (equal m hdmarker))
+ (setq props (text-properties-at (point))
+ dotime (org-get-at-bol 'dotime)
+ cat (org-get-at-bol 'org-category)
+ tags thetags
+ new
+ (let ((org-prefix-format-compiled
+ (or (get-text-property (min (1- (point-max)) (point)) 'format)
+ org-prefix-format-compiled))
+ (extra (org-get-at-bol 'extra)))
+ (with-current-buffer (marker-buffer hdmarker)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (org-agenda-format-item extra newhead cat tags dotime)))))
+ pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
+ undone-face (org-get-at-bol 'undone-face)
+ done-face (org-get-at-bol 'done-face))
+ (beginning-of-line 1)
+ (cond
+ ((equal new "")
+ (and (looking-at ".*\n?") (replace-match "")))
+ ((looking-at ".*")
+ (replace-match new t t)
+ (beginning-of-line 1)
+ (add-text-properties (point-at-bol) (point-at-eol) props)
+ (when fixface
+ (add-text-properties
+ (point-at-bol) (point-at-eol)
+ (list 'face
+ (if org-last-todo-state-is-todo
+ undone-face done-face))))
+ (org-agenda-highlight-todo 'line)
+ (beginning-of-line 1))
+ (t (error "Line update did not work")))
+ (save-restriction
+ (narrow-to-region (point-at-bol) (point-at-eol))
+ (org-agenda-finalize)))
+ (beginning-of-line 0)))))
+
+(defun org-agenda-align-tags (&optional line)
+ "Align all tags in agenda items to `org-agenda-tags-column'."
+ (let ((inhibit-read-only t) l c)
+ (save-excursion
+ (goto-char (if line (point-at-bol) (point-min)))
+ (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (if line (point-at-eol) nil) t)
+ (add-text-properties
+ (match-beginning 2) (match-end 2)
+ (list 'face (delq nil (let ((prop (get-text-property
+ (match-beginning 2) 'face)))
+ (or (listp prop) (setq prop (list prop)))
+ (if (memq 'org-tag prop)
+ prop
+ (cons 'org-tag prop))))))
+ (setq l (- (match-end 2) (match-beginning 2))
+ c (if (< org-agenda-tags-column 0)
+ (- (abs org-agenda-tags-column) l)
+ org-agenda-tags-column))
+ (delete-region (match-beginning 1) (match-end 1))
+ (goto-char (match-beginning 1))
+ (insert (org-add-props
+ (make-string (max 1 (- c (current-column))) ?\ )
+ (plist-put (copy-sequence (text-properties-at (point)))
+ 'face nil))))
+ (goto-char (point-min))
+ (org-font-lock-add-tag-faces (point-max)))))
+
+(defun org-agenda-priority-up ()
+ "Increase the priority of line at point, also in Org-mode file."
+ (interactive)
+ (org-agenda-priority 'up))
+
+(defun org-agenda-priority-down ()
+ "Decrease the priority of line at point, also in Org-mode file."
+ (interactive)
+ (org-agenda-priority 'down))
+
+(defun org-agenda-priority (&optional force-direction show)
+ "Set the priority of line at point, also in Org-mode file.
+This changes the line at point, all other lines in the agenda referring to
+the same tree node, and the headline of the tree node in the Org-mode file."
+ (interactive "P")
+ (if (equal force-direction '(4)) (setq show t))
+ (unless org-enable-priority-commands
+ (error "Priority commands are disabled"))
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (org-get-at-bol 'org-hd-marker))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (funcall 'org-priority force-direction show)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)
+ (beginning-of-line 1))))
+
+;; FIXME: should fix the tags property of the agenda line.
+(defun org-agenda-set-tags (&optional tag onoff)
+ "Set tags for the current headline."
+ (interactive)
+ (org-agenda-check-no-diary)
+ (if (and (org-region-active-p) (org-called-interactively-p 'any))
+ (call-interactively 'org-change-tag-in-region)
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (save-excursion
+ (org-show-context 'agenda))
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (goto-char pos)
+ (if tag
+ (org-toggle-tag tag onoff)
+ (call-interactively 'org-set-tags))
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)
+ (beginning-of-line 1)))))
+
+(defun org-agenda-set-property ()
+ "Set a property for the current headline."
+ (interactive)
+ (org-agenda-check-no-diary)
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (save-excursion
+ (org-show-context 'agenda))
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (goto-char pos)
+ (call-interactively 'org-set-property)))))
+
+(defun org-agenda-set-effort ()
+ "Set the effort property for the current headline."
+ (interactive)
+ (org-agenda-check-no-diary)
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (save-excursion
+ (org-show-context 'agenda))
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (goto-char pos)
+ (call-interactively 'org-set-effort)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker))))
+
+(defun org-agenda-toggle-archive-tag ()
+ "Toggle the archive tag for the current entry."
+ (interactive)
+ (org-agenda-check-no-diary)
+ (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer hdmarker))
+ (pos (marker-position hdmarker))
+ (inhibit-read-only t)
+ newhead)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (call-interactively 'org-toggle-archive-tag)
+ (end-of-line 1)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)
+ (beginning-of-line 1))))
+
+(defun org-agenda-do-date-later (arg)
+ (interactive "P")
+ (cond
+ ((or (equal arg '(16))
+ (memq last-command
+ '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
+ (setq this-command 'org-agenda-date-later-minutes)
+ (org-agenda-date-later-minutes 1))
+ ((or (equal arg '(4))
+ (memq last-command
+ '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
+ (setq this-command 'org-agenda-date-later-hours)
+ (org-agenda-date-later-hours 1))
+ (t
+ (org-agenda-date-later (prefix-numeric-value arg)))))
+
+(defun org-agenda-do-date-earlier (arg)
+ (interactive "P")
+ (cond
+ ((or (equal arg '(16))
+ (memq last-command
+ '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
+ (setq this-command 'org-agenda-date-earlier-minutes)
+ (org-agenda-date-earlier-minutes 1))
+ ((or (equal arg '(4))
+ (memq last-command
+ '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
+ (setq this-command 'org-agenda-date-earlier-hours)
+ (org-agenda-date-earlier-hours 1))
+ (t
+ (org-agenda-date-earlier (prefix-numeric-value arg)))))
+
+(defun org-agenda-date-later (arg &optional what)
+ "Change the date of this item to ARG day(s) later."
+ (interactive "p")
+ (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ cdate today)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (if (not (org-at-timestamp-p))
+ (error "Cannot find time stamp"))
+ (when (and org-agenda-move-date-from-past-immediately-to-today
+ (equal arg 1)
+ (or (not what) (eq what 'day))
+ (not (save-match-data (org-at-date-range-p))))
+ (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
+ cdate (calendar-absolute-from-gregorian
+ (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
+ today (org-today))
+ (if (> today cdate)
+ ;; immediately shift to today
+ (setq arg (- today cdate))))
+ (org-timestamp-change arg (or what 'day))
+ (when (and (org-at-date-range-p)
+ (re-search-backward org-tr-regexp-both (point-at-bol)))
+ (let ((end org-last-changed-timestamp))
+ (org-timestamp-change arg (or what 'day))
+ (setq org-last-changed-timestamp
+ (concat org-last-changed-timestamp "--" end)))))
+ (org-agenda-show-new-time marker org-last-changed-timestamp))
+ (message "Time stamp changed to %s" org-last-changed-timestamp)))
+
+(defun org-agenda-date-earlier (arg &optional what)
+ "Change the date of this item to ARG day(s) earlier."
+ (interactive "p")
+ (org-agenda-date-later (- arg) what))
+
+(defun org-agenda-date-later-minutes (arg)
+ "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
+ (interactive "p")
+ (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
+ (org-agenda-date-later arg 'minute))
+
+(defun org-agenda-date-earlier-minutes (arg)
+ "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
+ (interactive "p")
+ (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
+ (org-agenda-date-earlier arg 'minute))
+
+(defun org-agenda-date-later-hours (arg)
+ "Change the time of this item, in hour steps."
+ (interactive "p")
+ (org-agenda-date-later arg 'hour))
+
+(defun org-agenda-date-earlier-hours (arg)
+ "Change the time of this item, in hour steps."
+ (interactive "p")
+ (org-agenda-date-earlier arg 'hour))
+
+(defun org-agenda-show-new-time (marker stamp &optional prefix)
+ "Show new date stamp via text properties."
+ ;; We use text properties to make this undoable
+ (let ((inhibit-read-only t)
+ (buffer-invisibility-spec))
+ (setq stamp (concat " " prefix " => " stamp))
+ (save-excursion
+ (goto-char (point-max))
+ (while (not (bobp))
+ (when (equal marker (org-get-at-bol 'org-marker))
+ (org-move-to-column (- (window-width) (length stamp)) t)
+ (org-agenda-fix-tags-filter-overlays-at (point))
+ (if (featurep 'xemacs)
+ ;; Use `duplicable' property to trigger undo recording
+ (let ((ex (make-extent nil nil))
+ (gl (make-glyph stamp)))
+ (set-glyph-face gl 'secondary-selection)
+ (set-extent-properties
+ ex (list 'invisible t 'end-glyph gl 'duplicable t))
+ (insert-extent ex (1- (point)) (point-at-eol)))
+ (add-text-properties
+ (1- (point)) (point-at-eol)
+ (list 'display (org-add-props stamp nil
+ 'face 'secondary-selection))))
+ (beginning-of-line 1))
+ (beginning-of-line 0)))))
+
+(defun org-agenda-date-prompt (arg)
+ "Change the date of this item. Date is prompted for, with default today.
+The prefix ARG is passed to the `org-time-stamp' command and can therefore
+be used to request time specification in the time stamp."
+ (interactive "P")
+ (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (if (not (org-at-timestamp-p t))
+ (error "Cannot find time stamp"))
+ (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
+ (org-agenda-show-new-time marker org-last-changed-timestamp))
+ (message "Time stamp changed to %s" org-last-changed-timestamp)))
+
+(defun org-agenda-schedule (arg &optional time)
+ "Schedule the item at point.
+ARG is passed through to `org-schedule'."
+ (interactive "P")
+ (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (type (marker-insertion-type marker))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (org-insert-labeled-timestamps-at-point nil)
+ ts)
+ (set-marker-insertion-type marker t)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (setq ts (org-schedule arg time)))
+ (org-agenda-show-new-time marker ts "S"))
+ (message "Item scheduled for %s" ts)))
+
+(defun org-agenda-deadline (arg &optional time)
+ "Schedule the item at point.
+ARG is passed through to `org-deadline'."
+ (interactive "P")
+ (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (org-agenda-check-no-diary)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (org-insert-labeled-timestamps-at-point nil)
+ ts)
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (setq ts (org-deadline arg time)))
+ (org-agenda-show-new-time marker ts "D"))
+ (message "Deadline for this item set to %s" ts)))
+
+(defun org-agenda-clock-in (&optional arg)
+ "Start the clock on the currently selected item."
+ (interactive "P")
+ (org-agenda-check-no-diary)
+ (if (equal arg '(4))
+ (org-clock-in arg)
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (or (org-get-at-bol 'org-hd-marker)
+ marker))
+ (pos (marker-position marker))
+ newhead)
+ (org-with-remote-undo (marker-buffer marker)
+ (with-current-buffer (marker-buffer marker)
+ (widen)
+ (goto-char pos)
+ (org-show-context 'agenda)
+ (org-show-entry)
+ (org-cycle-hide-drawers 'children)
+ (org-clock-in arg)
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead hdmarker)))))
+
+(defun org-agenda-clock-out ()
+ "Stop the currently running clock."
+ (interactive)
+ (unless (marker-buffer org-clock-marker)
+ (error "No running clock"))
+ (let ((marker (make-marker)) newhead)
+ (org-with-remote-undo (marker-buffer org-clock-marker)
+ (with-current-buffer (marker-buffer org-clock-marker)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char org-clock-marker)
+ (org-back-to-heading t)
+ (move-marker marker (point))
+ (org-clock-out)
+ (setq newhead (org-get-heading))))))
+ (org-agenda-change-all-lines newhead marker)
+ (move-marker marker nil)))
+
+(defun org-agenda-clock-cancel (&optional arg)
+ "Cancel the currently running clock."
+ (interactive "P")
+ (unless (marker-buffer org-clock-marker)
+ (error "No running clock"))
+ (org-with-remote-undo (marker-buffer org-clock-marker)
+ (org-clock-cancel)))
+
+(defun org-agenda-clock-goto ()
+ "Jump to the currently clocked in task within the agenda.
+If the currently clocked in task is not listed in the agenda
+buffer, display it in another window."
+ (interactive)
+ (let (pos)
+ (mapc (lambda (o)
+ (if (eq (overlay-get o 'type) 'org-agenda-clocking)
+ (setq pos (overlay-start o))))
+ (overlays-in (point-min) (point-max)))
+ (cond (pos (goto-char pos))
+ ;; If the currently clocked entry is not in the agenda
+ ;; buffer, we visit it in another window:
+ (org-clock-current-task
+ (org-switch-to-buffer-other-window (org-clock-goto)))
+ (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
+
+(defun org-agenda-diary-entry-in-org-file ()
+ "Make a diary entry in the file `org-agenda-diary-file'."
+ (let (d1 d2 char (text "") dp1 dp2)
+ (if (equal (buffer-name) "*Calendar*")
+ (setq d1 (calendar-cursor-to-date t)
+ d2 (car calendar-mark-ring))
+ (setq dp1 (get-text-property (point-at-bol) 'day))
+ (unless dp1 (error "No date defined in current line"))
+ (setq d1 (calendar-gregorian-from-absolute dp1)
+ d2 (and (ignore-errors (mark))
+ (save-excursion
+ (goto-char (mark))
+ (setq dp2 (get-text-property (point-at-bol) 'day)))
+ (calendar-gregorian-from-absolute dp2))))
+ (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
+ (setq char (read-char-exclusive))
+ (cond
+ ((equal char ?d)
+ (setq text (read-string "Day entry: "))
+ (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
+ (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
+ ((equal char ?a)
+ (setq d1 (list (car d1) (nth 1 d1)
+ (read-number (format "Reference year [%d]: " (nth 2 d1))
+ (nth 2 d1))))
+ (setq text (read-string "Anniversary (use %d to show years): "))
+ (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
+ (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
+ ((equal char ?b)
+ (setq text (read-string "Block entry: "))
+ (unless (and d1 d2 (not (equal d1 d2)))
+ (error "No block of days selected"))
+ (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
+ (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
+ ((equal char ?j)
+ (org-switch-to-buffer-other-window
+ (find-file-noselect org-agenda-diary-file))
+ (require 'org-datetree)
+ (org-datetree-find-date-create d1)
+ (org-reveal t))
+ (t (error "Invalid selection character `%c'" char)))))
+
+(defcustom org-agenda-insert-diary-strategy 'date-tree
+ "Where in `org-agenda-diary-file' should new entries be added?
+Valid values:
+
+date-tree in the date tree, as child of the date
+top-level as top-level entries at the end of the file."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "in a date tree" date-tree)
+ (const :tag "as top level at end of file" top-level)))
+
+(defcustom org-agenda-insert-diary-extract-time nil
+ "Non-nil means extract any time specification from the diary entry."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-agenda-bulk-mark-char ">"
+ "A single-character string to be used as the bulk mark."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'string)
+
+(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
+ "Add a diary entry with TYPE to `org-agenda-diary-file'.
+If TEXT is not empty, it will become the headline of the new entry, and
+the resulting entry will not be shown. When TEXT is empty, switch to
+`org-agenda-diary-file' and let the user finish the entry there."
+ (let ((cw (current-window-configuration)))
+ (org-switch-to-buffer-other-window
+ (find-file-noselect org-agenda-diary-file))
+ (widen)
+ (goto-char (point-min))
+ (cond
+ ((eq type 'anniversary)
+ (or (re-search-forward "^*[ \t]+Anniversaries" nil t)
+ (progn
+ (or (org-at-heading-p t)
+ (progn
+ (outline-next-heading)
+ (insert "* Anniversaries\n\n")
+ (beginning-of-line -1)))))
+ (outline-next-heading)
+ (org-back-over-empty-lines)
+ (backward-char 1)
+ (insert "\n")
+ (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
+ (nth 2 d1) (car d1) (nth 1 d1) text)))
+ ((eq type 'day)
+ (let ((org-prefix-has-time t)
+ (org-agenda-time-leading-zero t)
+ fmt time time2)
+ (if org-agenda-insert-diary-extract-time
+ ;; Use org-agenda-format-item to parse text for a time-range and
+ ;; remove it. FIXME: This is a hack, we should refactor
+ ;; that function to make time extraction available separately
+ (setq fmt (org-agenda-format-item nil text nil nil t)
+ time (get-text-property 0 'time fmt)
+ time2 (if (> (length time) 0)
+ ;; split-string removes trailing ...... if
+ ;; no end time given. First space
+ ;; separates time from date.
+ (concat " " (car (split-string time "\\.")))
+ nil)
+ text (get-text-property 0 'txt fmt)))
+ (if (eq org-agenda-insert-diary-strategy 'top-level)
+ (org-agenda-insert-diary-as-top-level text)
+ (require 'org-datetree)
+ (org-datetree-find-date-create d1)
+ (org-agenda-insert-diary-make-new-entry text))
+ (org-insert-time-stamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d1))
+ nil nil nil nil time2))
+ (end-of-line 0))
+ ((eq type 'block)
+ (if (> (calendar-absolute-from-gregorian d1)
+ (calendar-absolute-from-gregorian d2))
+ (setq d1 (prog1 d2 (setq d2 d1))))
+ (if (eq org-agenda-insert-diary-strategy 'top-level)
+ (org-agenda-insert-diary-as-top-level text)
+ (require 'org-datetree)
+ (org-datetree-find-date-create d1)
+ (org-agenda-insert-diary-make-new-entry text))
+ (org-insert-time-stamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d1)))
+ (insert "--")
+ (org-insert-time-stamp (org-time-from-absolute
+ (calendar-absolute-from-gregorian d2)))
+ (end-of-line 0)))
+ (if (string-match "\\S-" text)
+ (progn
+ (set-window-configuration cw)
+ (message "%s entry added to %s"
+ (capitalize (symbol-name type))
+ (abbreviate-file-name org-agenda-diary-file)))
+ (org-reveal t)
+ (message "Please finish entry here"))))
+
+(defun org-agenda-insert-diary-as-top-level (text)
+ "Make new entry as a top-level entry at the end of the file.
+Add TEXT as headline, and position the cursor in the second line so that
+a timestamp can be added there."
+ (widen)
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ (insert "* " text "\n")
+ (if org-adapt-indentation (org-indent-to-column 2)))
+
+(defun org-agenda-insert-diary-make-new-entry (text)
+ "Make new entry as last child of current entry.
+Add TEXT as headline, and position the cursor in the second line so that
+a timestamp can be added there."
+ (let ((org-show-following-heading t)
+ (org-show-siblings t)
+ (org-show-hierarchy-above t)
+ (org-show-entry-below t)
+ col)
+ (outline-next-heading)
+ (org-back-over-empty-lines)
+ (or (looking-at "[ \t]*$")
+ (progn (insert "\n") (backward-char 1)))
+ (org-insert-heading nil t)
+ (org-do-demote)
+ (setq col (current-column))
+ (insert text "\n")
+ (if org-adapt-indentation (org-indent-to-column col))
+ (let ((org-show-following-heading t)
+ (org-show-siblings t)
+ (org-show-hierarchy-above t)
+ (org-show-entry-below t))
+ (org-show-context))))
+
+(defun org-agenda-diary-entry ()
+ "Make a diary entry, like the `i' command from the calendar.
+All the standard commands work: block, weekly etc.
+When `org-agenda-diary-file' points to a file,
+`org-agenda-diary-entry-in-org-file' is called instead to create
+entries in that Org-mode file."
+ (interactive)
+ (org-agenda-check-type t 'agenda 'timeline)
+ (if (not (eq org-agenda-diary-file 'diary-file))
+ (org-agenda-diary-entry-in-org-file)
+ (require 'diary-lib)
+ (let* ((char (progn
+ (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
+ (read-char-exclusive)))
+ (cmd (cdr (assoc char
+ '((?d . insert-diary-entry)
+ (?w . insert-weekly-diary-entry)
+ (?m . insert-monthly-diary-entry)
+ (?y . insert-yearly-diary-entry)
+ (?a . insert-anniversary-diary-entry)
+ (?b . insert-block-diary-entry)
+ (?c . insert-cyclic-diary-entry)))))
+ (oldf (symbol-function 'calendar-cursor-to-date))
+ ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
+ (point (point))
+ (mark (or (mark t) (point))))
+ (unless cmd
+ (error "No command associated with <%c>" char))
+ (unless (and (get-text-property point 'day)
+ (or (not (equal ?b char))
+ (get-text-property mark 'day)))
+ (error "Don't know which date to use for diary entry"))
+ ;; We implement this by hacking the `calendar-cursor-to-date' function
+ ;; and the `calendar-mark-ring' variable. Saves a lot of code.
+ (let ((calendar-mark-ring
+ (list (calendar-gregorian-from-absolute
+ (or (get-text-property mark 'day)
+ (get-text-property point 'day))))))
+ (unwind-protect
+ (progn
+ (fset 'calendar-cursor-to-date
+ (lambda (&optional error dummy)
+ (calendar-gregorian-from-absolute
+ (get-text-property point 'day))))
+ (call-interactively cmd))
+ (fset 'calendar-cursor-to-date oldf))))))
+
+(defun org-agenda-execute-calendar-command (cmd)
+ "Execute a calendar command from the agenda with date from cursor."
+ (org-agenda-check-type t 'agenda 'timeline)
+ (require 'diary-lib)
+ (unless (get-text-property (min (1- (point-max)) (point)) 'day)
+ (error "Don't know which date to use for the calendar command"))
+ (let* ((oldf (symbol-function 'calendar-cursor-to-date))
+ (point (point))
+ (date (calendar-gregorian-from-absolute
+ (get-text-property point 'day)))
+ ;; the following 2 vars are needed in the calendar
+ (displayed-month (car date))
+ (displayed-year (nth 2 date)))
+ (unwind-protect
+ (progn
+ (fset 'calendar-cursor-to-date
+ (lambda (&optional error dummy)
+ (calendar-gregorian-from-absolute
+ (get-text-property point 'day))))
+ (call-interactively cmd))
+ (fset 'calendar-cursor-to-date oldf))))
+
+(defun org-agenda-phases-of-moon ()
+ "Display the phases of the moon for the 3 months around the cursor date."
+ (interactive)
+ (org-agenda-execute-calendar-command 'calendar-phases-of-moon))
+
+(defun org-agenda-holidays ()
+ "Display the holidays for the 3 months around the cursor date."
+ (interactive)
+ (org-agenda-execute-calendar-command 'list-calendar-holidays))
+
+(defvar calendar-longitude) ; defined in calendar.el
+(defvar calendar-latitude) ; defined in calendar.el
+(defvar calendar-location-name) ; defined in calendar.el
+
+(defun org-agenda-sunrise-sunset (arg)
+ "Display sunrise and sunset for the cursor date.
+Latitude and longitude can be specified with the variables
+`calendar-latitude' and `calendar-longitude'. When called with prefix
+argument, latitude and longitude will be prompted for."
+ (interactive "P")
+ (require 'solar)
+ (let ((calendar-longitude (if arg nil calendar-longitude))
+ (calendar-latitude (if arg nil calendar-latitude))
+ (calendar-location-name
+ (if arg "the given coordinates" calendar-location-name)))
+ (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
+
+(defun org-agenda-goto-calendar ()
+ "Open the Emacs calendar with the date at the cursor."
+ (interactive)
+ (org-agenda-check-type t 'agenda 'timeline)
+ (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
+ (error "Don't know which date to open in calendar")))
+ (date (calendar-gregorian-from-absolute day))
+ (calendar-move-hook nil)
+ (calendar-view-holidays-initially-flag nil)
+ (calendar-view-diary-initially-flag nil))
+ (calendar)
+ (calendar-goto-date date)))
+
+;;;###autoload
+(defun org-calendar-goto-agenda ()
+ "Compute the Org-mode agenda for the calendar date displayed at the cursor.
+This is a command that has to be installed in `calendar-mode-map'."
+ (interactive)
+ (org-agenda-list nil (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date))
+ nil))
+
+(defun org-agenda-convert-date ()
+ (interactive)
+ (org-agenda-check-type t 'agenda 'timeline)
+ (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
+ date s)
+ (unless day
+ (error "Don't know which date to convert"))
+ (setq date (calendar-gregorian-from-absolute day))
+ (setq s (concat
+ "Gregorian: " (calendar-date-string date) "\n"
+ "ISO: " (calendar-iso-date-string date) "\n"
+ "Day of Yr: " (calendar-day-of-year-string date) "\n"
+ "Julian: " (calendar-julian-date-string date) "\n"
+ "Astron. JD: " (calendar-astro-date-string date)
+ " (Julian date number at noon UTC)\n"
+ "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
+ "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
+ "French: " (calendar-french-date-string date) "\n"
+ "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n"
+ "Mayan: " (calendar-mayan-date-string date) "\n"
+ "Coptic: " (calendar-coptic-date-string date) "\n"
+ "Ethiopic: " (calendar-ethiopic-date-string date) "\n"
+ "Persian: " (calendar-persian-date-string date) "\n"
+ "Chinese: " (calendar-chinese-date-string date) "\n"))
+ (with-output-to-temp-buffer "*Dates*"
+ (princ s))
+ (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
+
+;;; Bulk commands
+
+(defun org-agenda-bulk-marked-p ()
+ (eq (get-char-property (point-at-bol) 'type)
+ 'org-marked-entry-overlay))
+
+(defun org-agenda-bulk-mark (&optional arg)
+ "Mark the entry at point for future bulk action."
+ (interactive "p")
+ (dotimes (i (or arg 1))
+ (unless (org-get-at-bol 'org-agenda-diary-link)
+ (let* ((m (org-get-at-bol 'org-hd-marker))
+ ov)
+ (unless (org-agenda-bulk-marked-p)
+ (unless m (error "Nothing to mark at point"))
+ (push m org-agenda-bulk-marked-entries)
+ (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
+ (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
+ (org-get-todo-face "TODO")
+ 'evaporate)
+ (overlay-put ov 'type 'org-marked-entry-overlay))
+ (beginning-of-line 2)
+ (while (and (get-char-property (point) 'invisible) (not (eobp)))
+ (beginning-of-line 2))
+ (message "%d entries marked for bulk action"
+ (length org-agenda-bulk-marked-entries))))))
+
+(defun org-agenda-bulk-mark-all ()
+ "Mark all entries for future agenda bulk action."
+ (interactive)
+ (org-agenda-bulk-mark-regexp "."))
+
+(defun org-agenda-bulk-mark-regexp (regexp)
+ "Mark entries matching REGEXP for future agenda bulk action."
+ (interactive "sMark entries matching regexp: ")
+ (let ((entries-marked 0))
+ (save-excursion
+ (goto-char (point-min))
+ (goto-char (next-single-property-change (point) 'txt))
+ (while (re-search-forward regexp nil t)
+ (when (string-match regexp (get-text-property (point) 'txt))
+ (setq entries-marked (1+ entries-marked))
+ (call-interactively 'org-agenda-bulk-mark))))
+ (if (not entries-marked)
+ (message "No entry matching this regexp."))))
+
+(defun org-agenda-bulk-unmark (&optional arg)
+ "Unmark the entry at point for future bulk action."
+ (interactive "P")
+ (if arg
+ (org-agenda-bulk-unmark-all)
+ (cond ((org-agenda-bulk-marked-p)
+ (org-agenda-bulk-remove-overlays
+ (point-at-bol) (+ 2 (point-at-bol)))
+ (setq org-agenda-bulk-marked-entries
+ (delete (org-get-at-bol 'org-hd-marker)
+ org-agenda-bulk-marked-entries))
+ (beginning-of-line 2)
+ (while (and (get-char-property (point) 'invisible) (not (eobp)))
+ (beginning-of-line 2))
+ (message "%d entries left marked for bulk action"
+ (length org-agenda-bulk-marked-entries)))
+ (t (message "No entry to unmark here")))))
+
+(defun org-agenda-bulk-toggle ()
+ "Toggle marking the entry at point for bulk action."
+ (interactive)
+ (if (org-agenda-bulk-marked-p)
+ (org-agenda-bulk-unmark)
+ (org-agenda-bulk-mark)))
+
+(defun org-agenda-bulk-remove-overlays (&optional beg end)
+ "Remove the mark overlays between BEG and END in the agenda buffer.
+BEG and END default to the buffer limits.
+
+This only removes the overlays, it does not remove the markers
+from the list in `org-agenda-bulk-marked-entries'."
+ (interactive)
+ (mapc (lambda (ov)
+ (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
+ (delete-overlay ov)))
+ (overlays-in (or beg (point-min)) (or end (point-max)))))
+
+(defun org-agenda-bulk-unmark-all ()
+ "Remove all marks in the agenda buffer.
+This will remove the markers and the overlays."
+ (interactive)
+ (if (null org-agenda-bulk-marked-entries)
+ (message "No entry to unmark")
+ (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
+ (setq org-agenda-bulk-marked-entries nil)
+ (org-agenda-bulk-remove-overlays (point-min) (point-max))))
+
+(defcustom org-agenda-persistent-marks nil
+ "Non-nil means marked items will stay marked after a bulk action.
+You can toggle this interactively by typing `p' when prompted for a
+bulk action."
+ :group 'org-agenda
+ :version "24.1"
+ :type 'boolean)
+
+(defun org-agenda-bulk-action (&optional arg)
+ "Execute an remote-editing action on all marked entries.
+The prefix arg is passed through to the command if possible."
+ (interactive "P")
+ ;; Make sure we have markers, and only valid ones
+ (unless org-agenda-bulk-marked-entries (error "No entries are marked"))
+ (mapc
+ (lambda (m)
+ (unless (and (markerp m)
+ (marker-buffer m)
+ (buffer-live-p (marker-buffer m))
+ (marker-position m))
+ (error "Marker %s for bulk command is invalid" m)))
+ org-agenda-bulk-marked-entries)
+
+ ;; Prompt for the bulk command
+ (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
+ (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
+ "[S]catter [f]unction "
+ (when org-agenda-bulk-custom-functions
+ (concat " Custom: ["
+ (mapconcat (lambda(f) (char-to-string (car f)))
+ org-agenda-bulk-custom-functions "")
+ "]"))))
+ (catch 'exit
+ (let* ((action (read-char-exclusive))
+ (org-log-refile (if org-log-refile 'time nil))
+ (entries (reverse org-agenda-bulk-marked-entries))
+ (org-overriding-default-time
+ (if (get-text-property (point) 'org-agenda-date-header)
+ (org-get-cursor-date)))
+ redo-at-end
+ cmd rfloc state e tag pos (cnt 0) (cntskip 0))
+ (cond
+ ((equal action ?p)
+ (let ((org-agenda-persistent-marks
+ (not org-agenda-persistent-marks)))
+ (org-agenda-bulk-action)
+ (throw 'exit nil)))
+
+ ((equal action ?$)
+ (setq cmd '(org-agenda-archive)))
+
+ ((equal action ?A)
+ (setq cmd '(org-agenda-archive-to-archive-sibling)))
+
+ ((member action '(?r ?w))
+ (setq rfloc (org-refile-get-location
+ "Refile to"
+ (marker-buffer (car entries))
+ org-refile-allow-creating-parent-nodes))
+ (if (nth 3 rfloc)
+ (setcar (nthcdr 3 rfloc)
+ (move-marker (make-marker) (nth 3 rfloc)
+ (or (get-file-buffer (nth 1 rfloc))
+ (find-buffer-visiting (nth 1 rfloc))
+ (error "This should not happen")))))
+
+ (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
+ redo-at-end t))
+
+ ((equal action ?t)
+ (setq state (org-icompleting-read
+ "Todo state: "
+ (with-current-buffer (marker-buffer (car entries))
+ (mapcar 'list org-todo-keywords-1))))
+ (setq cmd `(let ((org-inhibit-blocking t)
+ (org-inhibit-logging 'note))
+ (org-agenda-todo ,state))))
+
+ ((memq action '(?- ?+))
+ (setq tag (org-icompleting-read
+ (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
+ (with-current-buffer (marker-buffer (car entries))
+ (delq nil
+ (mapcar (lambda (x)
+ (if (stringp (car x)) x)) org-tag-alist)))))
+ (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
+
+ ((memq action '(?s ?d))
+ (let* ((time
+ (unless arg
+ (org-read-date
+ nil nil nil
+ (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
+ org-overriding-default-time)))
+ (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
+ (setq cmd `(eval '(,c1 arg ,time)))))
+
+ ((equal action ?S)
+ (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
+ (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
+ (let ((days (read-number
+ (format "Scatter tasks across how many %sdays: "
+ (if arg "week" "")) 7)))
+ (setq cmd
+ `(let ((distance (1+ (random ,days))))
+ (if arg
+ (let ((dist distance)
+ (day-of-week
+ (calendar-day-of-week
+ (calendar-gregorian-from-absolute (org-today)))))
+ (dotimes (i (1+ dist))
+ (while (member day-of-week org-agenda-weekend-days)
+ (incf distance)
+ (incf day-of-week)
+ (if (= day-of-week 7)
+ (setq day-of-week 0)))
+ (incf day-of-week)
+ (if (= day-of-week 7)
+ (setq day-of-week 0)))))
+ ;; silently fail when try to replan a sexp entry
+ (condition-case nil
+ (let* ((date (calendar-gregorian-from-absolute
+ (+ (org-today) distance)))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))
+ (org-agenda-schedule nil time))
+ (error nil)))))))
+
+ ((assoc action org-agenda-bulk-custom-functions)
+ (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
+ redo-at-end t))
+
+ ((equal action ?f)
+ (setq cmd (list (intern
+ (org-icompleting-read "Function: "
+ obarray 'fboundp t nil nil)))))
+
+ (t (error "Invalid bulk action")))
+
+ ;; Sort the markers, to make sure that parents are handled before children
+ (setq entries (sort entries
+ (lambda (a b)
+ (cond
+ ((equal (marker-buffer a) (marker-buffer b))
+ (< (marker-position a) (marker-position b)))
+ (t
+ (string< (buffer-name (marker-buffer a))
+ (buffer-name (marker-buffer b))))))))
+
+ ;; Now loop over all markers and apply cmd
+ (while (setq e (pop entries))
+ (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
+ (if (not pos)
+ (progn (message "Skipping removed entry at %s" e)
+ (setq cntskip (1+ cntskip)))
+ (goto-char pos)
+ (let (org-loop-over-headlines-in-active-region)
+ (eval cmd))
+ (setq cnt (1+ cnt))))
+ (when redo-at-end (org-agenda-redo))
+ (unless org-agenda-persistent-marks
+ (org-agenda-bulk-unmark-all))
+ (message "Acted on %d entries%s%s"
+ cnt
+ (if (= cntskip 0)
+ ""
+ (format ", skipped %d (disappeared before their turn)"
+ cntskip))
+ (if (not org-agenda-persistent-marks)
+ "" " (kept marked)"))))))
+
+(defun org-agenda-capture ()
+ "Call `org-capture' with the date at point."
+ (interactive)
+ (if (not (eq major-mode 'org-agenda-mode))
+ (error "You cannot do this outside of agenda buffers")
+ (let ((org-overriding-default-time
+ (org-get-cursor-date)))
+ (call-interactively 'org-capture))))
+
+;;; Flagging notes
+
+(defun org-agenda-show-the-flagging-note ()
+ "Display the flagging note in the other window.
+When called a second time in direct sequence, offer to remove the FLAGGING
+tag and (if present) the flagging note."
+ (interactive)
+ (let ((hdmarker (org-get-at-bol 'org-hd-marker))
+ (win (selected-window))
+ note heading newhead)
+ (unless hdmarker
+ (error "No linked entry at point"))
+ (if (and (eq this-command last-command)
+ (y-or-n-p "Unflag and remove any flagging note? "))
+ (progn
+ (org-agenda-remove-flag hdmarker)
+ (let ((win (get-buffer-window "*Flagging Note*")))
+ (and win (delete-window win)))
+ (message "Entry unflagged"))
+ (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
+ (unless note
+ (error "No flagging note"))
+ (org-kill-new note)
+ (org-switch-to-buffer-other-window "*Flagging Note*")
+ (erase-buffer)
+ (insert note)
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\n" nil t)
+ (replace-match "\n" t t))
+ (goto-char (point-min))
+ (select-window win)
+ (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note"))))
+
+(defun org-agenda-remove-flag (marker)
+ "Remove the FLAGGED tag and any flagging note in the entry."
+ (let (newhead)
+ (org-with-point-at marker
+ (org-toggle-tag "FLAGGED" 'off)
+ (org-entry-delete nil "THEFLAGGINGNOTE")
+ (setq newhead (org-get-heading)))
+ (org-agenda-change-all-lines newhead marker)
+ (message "Entry unflagged")))
+
+(defun org-agenda-get-any-marker (&optional pos)
+ (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
+ (get-text-property (or pos (point-at-bol)) 'org-marker)))
+
+;;; Appointment reminders
+
+(defvar appt-time-msg-list) ; defined in appt.el
+
+;;;###autoload
+(defun org-agenda-to-appt (&optional refresh filter &rest args)
+ "Activate appointments found in `org-agenda-files'.
+With a \\[universal-argument] prefix, refresh the list of
+appointments.
+
+If FILTER is t, interactively prompt the user for a regular
+expression, and filter out entries that don't match it.
+
+If FILTER is a string, use this string as a regular expression
+for filtering entries out.
+
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
+FILTER can also be an alist with the car of each cell being
+either 'headline or 'category. For example:
+
+ '((headline \"IMPORTANT\")
+ (category \"Work\"))
+
+will only add headlines containing IMPORTANT or headlines
+belonging to the \"Work\" category.
+
+ARGS are symbols indicating what kind of entries to consider.
+By default `org-agenda-to-appt' will use :deadline, :scheduled
+and :timestamp entries. See the docstring of `org-diary' for
+details and examples.
+
+If an entry as a APPT_WARNTIME property, its value will be used
+to override `appt-message-warning-time'."
+ (interactive "P")
+ (if refresh (setq appt-time-msg-list nil))
+ (if (eq filter t)
+ (setq filter (read-from-minibuffer "Regexp filter: ")))
+ (let* ((cnt 0) ; count added events
+ (scope (or args '(:deadline :scheduled :timestamp)))
+ (org-agenda-new-buffers nil)
+ (org-deadline-warning-days 0)
+ ;; Do not use `org-today' here because appt only takes
+ ;; time and without date as argument, so it may pass wrong
+ ;; information otherwise
+ (today (org-date-to-gregorian
+ (time-to-days (current-time))))
+ (org-agenda-restrict nil)
+ (files (org-agenda-files 'unrestricted)) entries file
+ (org-agenda-buffer nil))
+ ;; Get all entries which may contain an appt
+ (org-agenda-prepare-buffers files)
+ (while (setq file (pop files))
+ (setq entries
+ (delq nil
+ (append entries
+ (apply 'org-agenda-get-day-entries
+ file today scope)))))
+ ;; Map thru entries and find if we should filter them out
+ (mapc
+ (lambda(x)
+ (let* ((evt (org-trim (or (get-text-property 1 'txt x) "")))
+ (cat (get-text-property 1 'org-category x))
+ (tod (get-text-property 1 'time-of-day x))
+ (ok (or (null filter)
+ (and (stringp filter) (string-match filter evt))
+ (and (functionp filter) (funcall filter x))
+ (and (listp filter)
+ (let ((cat-filter (cadr (assoc 'category filter)))
+ (evt-filter (cadr (assoc 'headline filter))))
+ (or (and (stringp cat-filter)
+ (string-match cat-filter cat))
+ (and (stringp evt-filter)
+ (string-match evt-filter evt)))))))
+ (wrn (get-text-property 1 'warntime x)))
+ ;; FIXME: Shall we remove text-properties for the appt text?
+ ;; (setq evt (set-text-properties 0 (length evt) nil evt))
+ (when (and ok tod)
+ (setq tod (concat "00" (number-to-string tod))
+ tod (when (string-match
+ "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
+ (concat (match-string 1 tod) ":"
+ (match-string 2 tod))))
+ (if (version< emacs-version "23.3")
+ (appt-add tod evt)
+ (appt-add tod evt wrn))
+ (setq cnt (1+ cnt))))) entries)
+ (org-release-buffers org-agenda-new-buffers)
+ (if (eq cnt 0)
+ (message "No event to add")
+ (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
+
+(defun org-agenda-todayp (date)
+ "Does DATE mean today, when considering `org-extend-today-until'?"
+ (let ((today (org-today))
+ (date (if (and date (listp date)) (calendar-absolute-from-gregorian date)
+ date)))
+ (eq date today)))
+
+(defun org-agenda-todo-yesterday (&optional arg)
+ "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
+ (interactive "P")
+ (let* ((hour (third (decode-time
+ (org-current-time))))
+ (org-extend-today-until (1+ hour)))
+ (org-agenda-todo arg)))
+
+(provide 'org-agenda)
+
+;;; org-agenda.el ends here
diff --git a/lisp/org-archive.el b/lisp/org-archive.el
new file mode 100644
index 0000000..29b8838
--- /dev/null
+++ b/lisp/org-archive.el
@@ -0,0 +1,540 @@
+;;; org-archive.el --- Archiving for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the face definitions for Org.
+
+;;; Code:
+
+(require 'org)
+
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
+
+(defcustom org-archive-default-command 'org-archive-subtree
+ "The default archiving command."
+ :group 'org-archive
+ :type '(choice
+ (const org-archive-subtree)
+ (const org-archive-to-archive-sibling)
+ (const org-archive-set-tag)))
+
+(defcustom org-archive-reversed-order nil
+ "Non-nil means make the tree first child under the archive heading, not last."
+ :group 'org-archive
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-archive-sibling-heading "Archive"
+ "Name of the local archive sibling that is used to archive entries locally.
+Locally means: in the tree, under a sibling.
+See `org-archive-to-archive-sibling' for more information."
+ :group 'org-archive
+ :type 'string)
+
+(defcustom org-archive-mark-done nil
+ "Non-nil means mark entries as DONE when they are moved to the archive file.
+This can be a string to set the keyword to use. When t, Org-mode will
+use the first keyword in its list that means done."
+ :group 'org-archive
+ :type '(choice
+ (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (string :tag "Use this keyword")))
+
+(defcustom org-archive-stamp-time t
+ "Non-nil means add a time stamp to entries moved to an archive file.
+This variable is obsolete and has no effect anymore, instead add or remove
+`time' from the variable `org-archive-save-context-info'."
+ :group 'org-archive
+ :type 'boolean)
+
+(defcustom org-archive-subtree-add-inherited-tags 'infile
+ "Non-nil means append inherited tags when archiving a subtree."
+ :group 'org-archive
+ :version "24.1"
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "When archiving a subtree to the same file" infile)
+ (const :tag "Always" t)))
+
+(defcustom org-archive-save-context-info '(time file olpath category todo itags)
+ "Parts of context info that should be stored as properties when archiving.
+When a subtree is moved to an archive file, it loses information given by
+context, like inherited tags, the category, and possibly also the TODO
+state (depending on the variable `org-archive-mark-done').
+This variable can be a list of any of the following symbols:
+
+time The time of archiving.
+file The file where the entry originates.
+ltags The local tags, in the headline of the subtree.
+itags The tags the subtree inherits from further up the hierarchy.
+todo The pre-archive TODO state.
+category The category, taken from file name or #+CATEGORY lines.
+olpath The outline path to the item. These are all headlines above
+ the current item, separated by /, like a file path.
+
+For each symbol present in the list, a property will be created in
+the archived entry, with a prefix \"ARCHIVE_\", to remember this
+information."
+ :group 'org-archive
+ :type '(set :greedy t
+ (const :tag "Time" time)
+ (const :tag "File" file)
+ (const :tag "Category" category)
+ (const :tag "TODO state" todo)
+ (const :tag "Priority" priority)
+ (const :tag "Inherited tags" itags)
+ (const :tag "Outline path" olpath)
+ (const :tag "Local tags" ltags)))
+
+(defun org-get-local-archive-location ()
+ "Get the archive location applicable at point."
+ (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ prop)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq prop (org-entry-get nil "ARCHIVE" 'inherit))
+ (cond
+ ((and prop (string-match "\\S-" prop))
+ prop)
+ ((or (re-search-backward re nil t)
+ (re-search-forward re nil t))
+ (match-string 1))
+ (t org-archive-location))))))
+
+(defun org-add-archive-files (files)
+ "Splice the archive files into the list of files.
+This implies visiting all these files and finding out what the
+archive file is."
+ (org-uniquify
+ (apply
+ 'append
+ (mapcar
+ (lambda (f)
+ (if (not (file-exists-p f))
+ nil
+ (with-current-buffer (org-get-agenda-file-buffer f)
+ (cons f (org-all-archive-files)))))
+ files))))
+
+(defun org-all-archive-files ()
+ "Get a list of all archive files used in the current buffer."
+ (let (file files)
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)"
+ nil t)
+ (setq file (org-extract-archive-file
+ (org-match-string-no-properties 2)))
+ (and file (> (length file) 0) (file-exists-p file)
+ (add-to-list 'files file)))))
+ (setq files (nreverse files))
+ (setq file (org-extract-archive-file))
+ (and file (> (length file) 0) (file-exists-p file)
+ (add-to-list 'files file))
+ files))
+
+(defun org-extract-archive-file (&optional location)
+ "Extract and expand the file name from archive LOCATION.
+if LOCATION is not given, the value of `org-archive-location' is used."
+ (setq location (or location org-archive-location))
+ (if (string-match "\\(.*\\)::\\(.*\\)" location)
+ (if (= (match-beginning 1) (match-end 1))
+ (buffer-file-name (buffer-base-buffer))
+ (expand-file-name
+ (format (match-string 1 location)
+ (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer))))))))
+
+(defun org-extract-archive-heading (&optional location)
+ "Extract the heading from archive LOCATION.
+if LOCATION is not given, the value of `org-archive-location' is used."
+ (setq location (or location org-archive-location))
+ (if (string-match "\\(.*\\)::\\(.*\\)" location)
+ (format (match-string 2 location)
+ (file-name-nondirectory
+ (buffer-file-name (buffer-base-buffer))))))
+
+(defun org-archive-subtree (&optional find-done)
+ "Move the current subtree to the archive.
+The archive can be a certain top-level heading in the current file, or in
+a different file. The tree will be moved to that location, the subtree
+heading be marked DONE, and the current time will be added.
+
+When called with prefix argument FIND-DONE, find whole trees without any
+open TODO items and archive them (after getting confirmation from the user).
+If the cursor is not at a headline when this command is called, try all level
+1 trees. If the cursor is on a headline, only try the direct children of
+this heading."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
+ (org-archive-subtree ,find-done))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done)
+ ;; Save all relevant TODO keyword-relatex variables
+ (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
+ (tr-org-todo-keywords-1 org-todo-keywords-1)
+ (tr-org-todo-kwd-alist org-todo-kwd-alist)
+ (tr-org-done-keywords org-done-keywords)
+ (tr-org-todo-regexp org-todo-regexp)
+ (tr-org-todo-line-regexp org-todo-line-regexp)
+ (tr-org-odd-levels-only org-odd-levels-only)
+ (this-buffer (current-buffer))
+ ;; start of variables that will be used for saving context
+ ;; The compiler complains about them - keep them anyway!
+ (file (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (error "No file associated to buffer"))))
+ (olpath (mapconcat 'identity (org-get-outline-path) "/"))
+ (time (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (current-time)))
+ category todo priority ltags itags atags
+ ;; end of variables that will be used for saving context
+ location afile heading buffer level newfile-p infile-p visiting
+ datetree-date datetree-subheading-p)
+
+ ;; Find the local archive location
+ (setq location (org-get-local-archive-location)
+ afile (org-extract-archive-file location)
+ heading (org-extract-archive-heading location)
+ infile-p (equal file (abbreviate-file-name (or afile ""))))
+ (unless afile
+ (error "Invalid `org-archive-location'"))
+
+ (if (> (length afile) 0)
+ (setq newfile-p (not (file-exists-p afile))
+ visiting (find-buffer-visiting afile)
+ buffer (or visiting (find-file-noselect afile)))
+ (setq buffer (current-buffer)))
+ (unless buffer
+ (error "Cannot access file \"%s\"" afile))
+ (when (string-match "\\`datetree/" heading)
+ ;; Replace with ***, to represent the 3 levels of headings the
+ ;; datetree has.
+ (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading))
+ (setq datetree-subheading-p (> (length heading) 3))
+ (setq datetree-date (org-date-to-gregorian
+ (or (org-entry-get nil "CLOSED" t) time))))
+ (if (and (> (length heading) 0)
+ (string-match "^\\*+" heading))
+ (setq level (match-end 0))
+ (setq heading nil level 0))
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Get context information that will be lost by moving the tree
+ (setq category (org-get-category nil 'force-refresh)
+ todo (and (looking-at org-todo-line-regexp)
+ (match-string 2))
+ priority (org-get-priority
+ (if (match-end 3) (match-string 3) ""))
+ ltags (org-get-tags)
+ itags (org-delete-all ltags (org-get-tags-at))
+ atags (org-get-tags-at))
+ (setq ltags (mapconcat 'identity ltags " ")
+ itags (mapconcat 'identity itags " "))
+ ;; We first only copy, in case something goes wrong
+ ;; we need to protect `this-command', to avoid kill-region sets it,
+ ;; which would lead to duplication of subtrees
+ (let (this-command) (org-copy-subtree 1 nil t))
+ (set-buffer buffer)
+ ;; Enforce org-mode for the archive buffer
+ (if (not (derived-mode-p 'org-mode))
+ ;; Force the mode for future visits.
+ (let ((org-insert-mode-line-in-empty-file t)
+ (org-inhibit-startup t))
+ (call-interactively 'org-mode)))
+ (when newfile-p
+ (goto-char (point-max))
+ (insert (format "\nArchived entries from file %s\n\n"
+ (buffer-file-name this-buffer))))
+ (when datetree-date
+ (require 'org-datetree)
+ (org-datetree-find-date-create datetree-date)
+ (org-narrow-to-subtree))
+ ;; Force the TODO keywords of the original buffer
+ (let ((org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-todo-keywords-1 tr-org-todo-keywords-1)
+ (org-todo-kwd-alist tr-org-todo-kwd-alist)
+ (org-done-keywords tr-org-done-keywords)
+ (org-todo-regexp tr-org-todo-regexp)
+ (org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-odd-levels-only
+ (if (local-variable-p 'org-odd-levels-only (current-buffer))
+ org-odd-levels-only
+ tr-org-odd-levels-only)))
+ (goto-char (point-min))
+ (show-all)
+ (if (and heading (not (and datetree-date (not datetree-subheading-p))))
+ (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote heading)
+ (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
+ nil t)
+ (goto-char (match-end 0))
+ ;; Heading not found, just insert it at the end
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ ;; datetrees don't need too much spacing
+ (insert (if datetree-date "" "\n") heading "\n")
+ (end-of-line 0))
+ ;; Make the subtree visible
+ (show-subtree)
+ (if org-archive-reversed-order
+ (progn
+ (org-back-to-heading t)
+ (outline-next-heading))
+ (org-end-of-subtree t))
+ (skip-chars-backward " \t\r\n")
+ (and (looking-at "[ \t\r\n]*")
+ ;; datetree archives don't need so much spacing.
+ (replace-match (if datetree-date "\n" "\n\n"))))
+ ;; No specific heading, just go to end of file.
+ (goto-char (point-max)) (unless datetree-date (insert "\n")))
+ ;; Paste
+ (org-paste-subtree (org-get-valid-level level (and heading 1)))
+ ;; Shall we append inherited tags?
+ (and itags
+ (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
+ infile-p)
+ (eq org-archive-subtree-add-inherited-tags t))
+ (org-set-tags-to atags))
+ ;; Mark the entry as done
+ (when (and org-archive-mark-done
+ (looking-at org-todo-line-regexp)
+ (or (not (match-end 2))
+ (not (member (match-string 2) org-done-keywords))))
+ (let (org-log-done org-todo-log-states)
+ (org-todo
+ (car (or (member org-archive-mark-done org-done-keywords)
+ org-done-keywords)))))
+
+ ;; Add the context info
+ (when org-archive-save-context-info
+ (let ((l org-archive-save-context-info) e n v)
+ (while (setq e (pop l))
+ (when (and (setq v (symbol-value e))
+ (stringp v) (string-match "\\S-" v))
+ (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
+ (org-entry-put (point) n v)))))
+
+ (widen)
+ ;; Save and kill the buffer, if it is not the same buffer.
+ (when (not (eq this-buffer buffer))
+ (save-buffer))))
+ ;; Here we are back in the original buffer. Everything seems to have
+ ;; worked. So now cut the tree and finish up.
+ (let (this-command) (org-cut-subtree))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "Subtree archived %s"
+ (if (eq this-buffer buffer)
+ (concat "under heading: " heading)
+ (concat "in file: " (abbreviate-file-name afile))))))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
+
+(defun org-archive-to-archive-sibling ()
+ "Archive the current heading by moving it under the archive sibling.
+The archive sibling is a sibling of the heading with the heading name
+`org-archive-sibling-heading' and an `org-archive-tag' tag. If this
+sibling does not exist, it will be created at the end of the subtree."
+ (interactive)
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ '(progn (setq org-map-continue-from
+ (progn (org-back-to-heading)
+ (if (looking-at (concat "^.*:" org-archive-tag ":.*$"))
+ (org-end-of-subtree t)
+ (point))))
+ (when (org-at-heading-p)
+ (org-archive-to-archive-sibling)))
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (save-restriction
+ (widen)
+ (let (b e pos leader level)
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (setq leader (match-string 0)
+ level (funcall outline-level))
+ (setq pos (point))
+ (condition-case nil
+ (outline-up-heading 1 t)
+ (error (setq e (point-max)) (goto-char (point-min))))
+ (setq b (point))
+ (unless e
+ (condition-case nil
+ (org-end-of-subtree t t)
+ (error (goto-char (point-max))))
+ (setq e (point)))
+ (goto-char b)
+ (unless (re-search-forward
+ (concat "^" (regexp-quote leader)
+ "[ \t]*"
+ org-archive-sibling-heading
+ "[ \t]*:"
+ org-archive-tag ":") e t)
+ (goto-char e)
+ (or (bolp) (newline))
+ (insert leader org-archive-sibling-heading "\n")
+ (beginning-of-line 0)
+ (org-toggle-tag org-archive-tag 'on))
+ (beginning-of-line 1)
+ (if org-archive-reversed-order
+ (outline-next-heading)
+ (org-end-of-subtree t t))
+ (save-excursion
+ (goto-char pos)
+ (let ((this-command this-command)) (org-cut-subtree)))
+ (org-paste-subtree (org-get-valid-level level 1))
+ (org-set-property
+ "ARCHIVE_TIME"
+ (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)
+ (current-time)))
+ (outline-up-heading 1 t)
+ (hide-subtree)
+ (org-cycle-show-empty-lines 'folded)
+ (goto-char pos)))
+ (org-reveal)
+ (if (looking-at "^[ \t]*$")
+ (outline-next-visible-heading 1))))
+
+(defun org-archive-all-done (&optional tag)
+ "Archive sublevels of the current tree without open TODO items.
+If the cursor is not on a headline, try all level 1 trees. If
+it is on a headline, try all direct children.
+When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
+ (let ((re org-not-done-heading-regexp) re1
+ (rea (concat ".*:" org-archive-tag ":"))
+ (begm (make-marker))
+ (endm (make-marker))
+ (question (if tag "Set ARCHIVE tag (no open TODO items)? "
+ "Move subtree to archive (no open TODO items)? "))
+ beg end (cntarch 0))
+ (if (org-at-heading-p)
+ (progn
+ (setq re1 (concat "^" (regexp-quote
+ (make-string
+ (+ (- (match-end 0) (match-beginning 0) 1)
+ (if org-odd-levels-only 2 1))
+ ?*))
+ " "))
+ (move-marker begm (point))
+ (move-marker endm (org-end-of-subtree t)))
+ (setq re1 "^* ")
+ (move-marker begm (point-min))
+ (move-marker endm (point-max)))
+ (save-excursion
+ (goto-char begm)
+ (while (re-search-forward re1 endm t)
+ (setq beg (match-beginning 0)
+ end (save-excursion (org-end-of-subtree t) (point)))
+ (goto-char beg)
+ (if (re-search-forward re end t)
+ (goto-char end)
+ (goto-char beg)
+ (if (and (or (not tag) (not (looking-at rea)))
+ (y-or-n-p question))
+ (progn
+ (if tag
+ (org-toggle-tag org-archive-tag 'on)
+ (org-archive-subtree))
+ (setq cntarch (1+ cntarch)))
+ (goto-char end)))))
+ (message "%d trees archived" cntarch)))
+
+(defun org-toggle-archive-tag (&optional find-done)
+ "Toggle the archive tag for the current headline.
+With prefix ARG, check all children of current headline and offer tagging
+the children that do not contain any open TODO items."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-toggle-archive-tag ,find-done)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if find-done
+ (org-archive-all-done 'tag)
+ (let (set)
+ (save-excursion
+ (org-back-to-heading t)
+ (setq set (org-toggle-tag org-archive-tag))
+ (when set (hide-subtree)))
+ (and set (beginning-of-line 1))
+ (message "Subtree %s" (if set "archived" "unarchived"))))))
+
+(defun org-archive-set-tag ()
+ "Set the ARCHIVE tag."
+ (interactive)
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ 'org-archive-set-tag
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (org-toggle-tag org-archive-tag 'on)))
+
+;;;###autoload
+(defun org-archive-subtree-default ()
+ "Archive the current subtree with the default command.
+This command is set with the variable `org-archive-default-command'."
+ (interactive)
+ (call-interactively org-archive-default-command))
+
+;;;###autoload
+(defun org-archive-subtree-default-with-confirmation ()
+ "Archive the current subtree with the default command.
+This command is set with the variable `org-archive-default-command'."
+ (interactive)
+ (if (y-or-n-p "Archive this subtree or entry? ")
+ (call-interactively org-archive-default-command)
+ (error "Abort")))
+
+(provide 'org-archive)
+
+;;; org-archive.el ends here
diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el
new file mode 100644
index 0000000..655b8db
--- /dev/null
+++ b/lisp/org-ascii.el
@@ -0,0 +1,729 @@
+;;; org-ascii.el --- ASCII export for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-exp)
+
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-export-ascii nil
+ "Options specific for ASCII export of Org-mode files."
+ :tag "Org Export ASCII"
+ :group 'org-export)
+
+(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
+ "Characters for underlining headings in ASCII export.
+In the given sequence, these characters will be used for level 1, 2, ..."
+ :group 'org-export-ascii
+ :type '(repeat character))
+
+(defcustom org-export-ascii-bullets '(?* ?+ ?-)
+ "Bullet characters for headlines converted to lists in ASCII export.
+The first character is used for the first lest level generated in this
+way, and so on. If there are more levels than characters given here,
+the list will be repeated.
+Note that plain lists will keep the same bullets as the have in the
+Org-mode file."
+ :group 'org-export-ascii
+ :type '(repeat character))
+
+(defcustom org-export-ascii-links-to-notes t
+ "Non-nil means convert links to notes before the next headline.
+When nil, the link will be exported in place. If the line becomes long
+in this way, it will be wrapped."
+ :group 'org-export-ascii
+ :type 'boolean)
+
+(defcustom org-export-ascii-table-keep-all-vertical-lines nil
+ "Non-nil means keep all vertical lines in ASCII tables.
+When nil, vertical lines will be removed except for those needed
+for column grouping."
+ :group 'org-export-ascii
+ :type 'boolean)
+
+(defcustom org-export-ascii-table-widen-columns t
+ "Non-nil means widen narrowed columns for export.
+When nil, narrowed columns will look in ASCII export just like in org-mode,
+i.e. with \"=>\" as ellipsis."
+ :group 'org-export-ascii
+ :type 'boolean)
+
+(defvar org-export-ascii-entities 'ascii
+ "The ascii representation to be used during ascii export.
+Possible values are:
+
+ascii Only use plain ASCII characters
+latin1 Include Latin-1 character
+utf8 Use all UTF-8 characters")
+
+;;; Hooks
+
+(defvar org-export-ascii-final-hook nil
+ "Hook run at the end of ASCII export, in the new buffer.")
+
+;;; ASCII export
+
+(defvar org-ascii-current-indentation nil) ; For communication
+
+;;;###autoload
+(defun org-export-as-latin1 (&rest args)
+ "Like `org-export-as-ascii', use latin1 encoding for special symbols."
+ (interactive)
+ (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any)
+ 'latin1 args))
+
+;;;###autoload
+(defun org-export-as-latin1-to-buffer (&rest args)
+ "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
+ (interactive)
+ (org-export-as-encoding 'org-export-as-ascii-to-buffer
+ (org-called-interactively-p 'any) 'latin1 args))
+
+;;;###autoload
+(defun org-export-as-utf8 (&rest args)
+ "Like `org-export-as-ascii', use encoding for special symbols."
+ (interactive)
+ (org-export-as-encoding 'org-export-as-ascii
+ (org-called-interactively-p 'any)
+ 'utf8 args))
+
+;;;###autoload
+(defun org-export-as-utf8-to-buffer (&rest args)
+ "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
+ (interactive)
+ (org-export-as-encoding 'org-export-as-ascii-to-buffer
+ (org-called-interactively-p 'any) 'utf8 args))
+
+(defun org-export-as-encoding (command interactivep encoding &rest args)
+ (let ((org-export-ascii-entities encoding))
+ (if interactivep
+ (call-interactively command)
+ (apply command args))))
+
+
+;;;###autoload
+(defun org-export-as-ascii-to-buffer (arg)
+ "Call `org-export-as-ascii` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-ascii'."
+ (interactive "P")
+ (org-export-as-ascii arg nil nil "*Org ASCII Export*")
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window "*Org ASCII Export*")))
+
+;;;###autoload
+(defun org-replace-region-by-ascii (beg end)
+ "Assume the current region has org-mode syntax, and convert it to plain ASCII.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in a Mail buffer and then use this
+command to convert it."
+ (interactive "r")
+ (let (reg ascii buf pop-up-frames)
+ (save-window-excursion
+ (if (derived-mode-p 'org-mode)
+ (setq ascii (org-export-region-as-ascii
+ beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq ascii (org-export-region-as-ascii
+ (point-min) (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert ascii)))
+
+;;;###autoload
+(defun org-export-region-as-ascii (beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to plain ASCII.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted ASCII. If BUFFER is the symbol `string', return the
+produced ASCII as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq ascii (org-export-region-as-ascii beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "r\nP")
+ (when (org-called-interactively-p 'any)
+ (setq buffer "*Org ASCII Export*"))
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-export-as-ascii
+ nil nil ext-plist
+ buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+;;;###autoload
+(defun org-export-as-ascii (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline as a pretty ASCII file.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+underlined headlines, default is 3. Lower levels will become bulleted
+lists. When HIDDEN is non-nil, don't display the ASCII buffer.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting ASCII as a string. When BODY-ONLY is set, don't produce
+the file header and footer. When PUB-DIR is set, use this as the
+publishing directory."
+ (interactive "P")
+ (run-hooks 'org-export-first-hook)
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist)))
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-export-directory :html opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (custom-times org-display-custom-times)
+ (org-ascii-current-indentation '(0 . 0))
+ (level 0) line txt
+ (umax nil)
+ (umax-toc nil)
+ (case-fold-search nil)
+ (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ (filename (if to-buffer
+ nil
+ (concat (file-name-as-directory
+ (or pub-dir
+ (org-export-directory :ascii opt-plist)))
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory bfname)))
+ ".txt")))
+ (filename (and filename
+ (if (equal (file-truename filename)
+ (file-truename bfname))
+ (concat filename ".txt")
+ filename)))
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string)
+ (get-buffer-create "*Org ASCII Export*"))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect filename)))
+ (org-levels-open (make-vector org-level-max nil))
+ (odd org-odd-levels-only)
+ (date (plist-get opt-plist :date))
+ (author (plist-get opt-plist :author))
+ (title (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and (buffer-file-name)
+ (file-name-sans-extension
+ (file-name-nondirectory bfname)))
+ "UNTITLED"))
+ (email (plist-get opt-plist :email))
+ (language (plist-get opt-plist :language))
+ (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)"))
+ (todo nil)
+ (lang-words nil)
+ (region
+ (buffer-substring
+ (if (org-region-active-p) (region-beginning) (point-min))
+ (if (org-region-active-p) (region-end) (point-max))))
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (lines (org-split-string
+ (org-export-preprocess-string
+ region
+ :for-backend 'ascii
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :verbatim-multiline t
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :add-text (plist-get opt-plist :text))
+ "\n"))
+ thetoc have-headings first-heading-pos
+ table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (setq org-min-level (org-get-min-level lines level-offset))
+ (setq org-last-level org-min-level)
+ (org-init-section-numbers)
+ (setq lang-words (or (assoc language org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+ (set-buffer buffer)
+ (erase-buffer)
+ (fundamental-mode)
+ (org-install-letbind)
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (org-set-local 'org-odd-levels-only odd)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc (if (integerp org-export-with-toc)
+ (min org-export-with-toc umax)
+ umax))
+
+ ;; File header
+ (unless body-only
+ (when (and title (not (string= "" title)))
+ (org-insert-centered title ?=)
+ (insert "\n"))
+
+ (if (and (or author email)
+ org-export-author-info)
+ (insert (concat (nth 1 lang-words) ": " (or author "")
+ (if (and org-export-email-info
+ email (string-match "\\S-" email))
+ (concat " <" email ">") "")
+ "\n")))
+
+ (cond
+ ((and date (string-match "%" date))
+ (setq date (format-time-string date)))
+ (date)
+ (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
+
+ (if (and date org-export-time-stamp-file)
+ (insert (concat (nth 2 lang-words) ": " date"\n")))
+
+ (unless (= (point) (point-min))
+ (insert "\n\n")))
+
+ (if (and org-export-with-toc (not body-only))
+ (progn
+ (push (concat (nth 3 lang-words) "\n") thetoc)
+ (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
+ "\n") thetoc)
+ (mapc #'(lambda (line)
+ (if (string-match org-todo-line-regexp
+ line)
+ ;; This is a headline
+ (progn
+ (setq have-headings t)
+ (setq level (- (match-end 1) (match-beginning 1)
+ level-offset)
+ level (org-tr-level level)
+ txt (match-string 3 line)
+ todo
+ (or (and org-export-mark-todo-in-toc
+ (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
+ ; TODO, not DONE
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
+ (org-search-todo-below
+ line lines level))))
+ (setq txt (org-html-expand-for-ascii txt))
+
+ (while (string-match org-bracket-link-regexp txt)
+ (setq txt
+ (replace-match
+ (match-string (if (match-end 2) 3 1) txt)
+ t t txt)))
+
+ (if (and (memq org-export-with-tags '(not-in-toc nil))
+ (string-match
+ (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
+ txt))
+ (setq txt (replace-match "" t t txt)))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt 1)))
+
+ (if org-export-with-section-numbers
+ (setq txt (concat (org-section-number level)
+ " " txt)))
+ (if (<= level umax-toc)
+ (progn
+ (push
+ (concat
+ (make-string
+ (* (max 0 (- level org-min-level)) 4) ?\ )
+ (format (if todo "%s (*)\n" "%s\n") txt))
+ thetoc)
+ (setq org-last-level level))
+ ))))
+ lines)
+ (setq thetoc (if have-headings (nreverse thetoc) nil))))
+
+ (org-init-section-numbers)
+ (while (setq line (pop lines))
+ (when (and link-buffer (string-match org-outline-regexp-bol line))
+ (org-export-ascii-push-links (nreverse link-buffer))
+ (setq link-buffer nil))
+ (setq wrap nil)
+ ;; Remove the quoted HTML tags.
+ (setq line (org-html-expand-for-ascii line))
+ ;; Replace links with the description when possible
+ (while (string-match org-bracket-link-analytic-regexp++ line)
+ (setq path (match-string 3 line)
+ link (concat (match-string 1 line) path)
+ type (match-string 2 line)
+ desc0 (match-string 5 line)
+ desc0 (replace-regexp-in-string "\\\\_" "_" desc0)
+ desc (or desc0 link)
+ desc (replace-regexp-in-string "\\\\_" "_" desc))
+ (if (and (> (length link) 8)
+ (equal (substring link 0 8) "coderef:"))
+ (setq line (replace-match
+ (format (org-export-get-coderef-format (substring link 8) desc)
+ (cdr (assoc
+ (substring link 8)
+ org-export-code-refs)))
+ t t line))
+ (setq rpl (concat "[" desc "]"))
+ (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ (setq rpl (or (save-match-data
+ (funcall fnc (org-link-unescape path)
+ desc0 'ascii))
+ rpl))
+ (when (and desc0 (not (equal desc0 link)))
+ (if org-export-ascii-links-to-notes
+ (push (cons desc0 link) link-buffer)
+ (setq rpl (concat rpl " (" link ")")
+ wrap (+ (length line) (- (length (match-string 0 line)))
+ (length desc))))))
+ (setq line (replace-match rpl t t line))))
+ (when custom-times
+ (setq line (org-translate-time line)))
+ (cond
+ ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
+ ;; a Headline
+ (setq first-heading-pos (or first-heading-pos (point)))
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (org-ascii-level-start level txt umax lines))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ (if (not table-open)
+ ;; New table starts
+ (setq table-open t table-buffer nil))
+ ;; Accumulate lines
+ (setq table-buffer (cons line table-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer))
+ (insert (mapconcat
+ (lambda (x)
+ (org-fix-indentation x org-ascii-current-indentation))
+ (org-format-table-ascii table-buffer)
+ "\n") "\n")))
+ (t
+ (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
+ line)
+ (setq line (replace-match "\\1\\3:" t nil line)))
+ (setq line (org-fix-indentation line org-ascii-current-indentation))
+ ;; Remove forced line breaks
+ (if (string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (replace-match "" t t line)))
+ (if (and org-export-with-fixed-width
+ (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
+ (setq line (replace-match "\\1" nil nil line))
+ (if wrap (setq line (org-export-ascii-wrap line wrap))))
+ (insert line "\n"))))
+
+ (org-export-ascii-push-links (nreverse link-buffer))
+
+ (normal-mode)
+
+ ;; insert the table of contents
+ (when thetoc
+ (goto-char (point-min))
+ (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (replace-match ""))
+ (goto-char first-heading-pos))
+ (mapc 'insert thetoc)
+ (or (looking-at "[ \t]*\n[ \t]*\n")
+ (insert "\n\n")))
+
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (make-string (- end beg) ?\ ))))
+
+ ;; remove display and invisible chars
+ (let (beg end)
+ (goto-char (point-min))
+ (while (setq beg (next-single-property-change (point) 'display))
+ (setq end (next-single-property-change beg 'display))
+ (delete-region beg end)
+ (goto-char beg)
+ (insert "=>"))
+ (goto-char (point-min))
+ (while (setq beg (next-single-property-change (point) 'org-cwidth))
+ (setq end (next-single-property-change beg 'org-cwidth))
+ (delete-region beg end)
+ (goto-char beg)))
+ (run-hooks 'org-export-ascii-final-hook)
+ (or to-buffer (save-buffer))
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring "ASCII")
+ (message "Exporting... done"))
+ ;; Return the buffer or a string, according to how this function was called
+ (if (eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer)))
+ (current-buffer))))
+
+(defun org-export-ascii-preprocess (parameters)
+ "Do extra work for ASCII export."
+ ;;
+ ;; Realign tables to get rid of narrowing
+ (when org-export-ascii-table-widen-columns
+ (let ((org-table-do-narrow nil))
+ (goto-char (point-min))
+ (org-ascii-replace-entities)
+ (goto-char (point-min))
+ (org-table-map-tables
+ (lambda () (org-if-unprotected (org-table-align)))
+ 'quietly)))
+ ;; Put quotes around verbatim text
+ (goto-char (point-min))
+ (while (re-search-forward org-verbatim-re nil t)
+ (org-if-unprotected-at (match-beginning 4)
+ (goto-char (match-end 2))
+ (backward-delete-char 1) (insert "'")
+ (goto-char (match-beginning 2))
+ (delete-char 1) (insert "`")
+ (goto-char (match-end 2))))
+ ;; Remove target markers
+ (goto-char (point-min))
+ (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (replace-match "\\1\\2")))
+ ;; Remove list start counters
+ (goto-char (point-min))
+ (while (org-list-search-forward
+ "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t)
+ (replace-match ""))
+ (remove-text-properties
+ (point-min) (point-max)
+ '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
+
+(defun org-html-expand-for-ascii (line)
+ "Handle quoted HTML for ASCII export."
+ (if org-export-html-expand
+ (while (string-match "@<[^<>\n]*>" line)
+ ;; We just remove the tags for now.
+ (setq line (replace-match "" nil nil line))))
+ line)
+
+(defun org-ascii-replace-entities ()
+ "Replace entities with the ASCII representation."
+ (let (e)
+ (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (setq e (org-entity-get-representation (match-string 1)
+ org-export-ascii-entities))
+ (and e (replace-match e t t))))))
+
+(defun org-export-ascii-wrap (line where)
+ "Wrap LINE at or before WHERE."
+ (let ((ind (org-get-indentation line))
+ pos)
+ (catch 'found
+ (loop for i from where downto (/ where 2) do
+ (and (equal (aref line i) ?\ )
+ (setq pos i)
+ (throw 'found t))))
+ (if pos
+ (concat (substring line 0 pos) "\n"
+ (make-string ind ?\ )
+ (substring line (1+ pos)))
+ line)))
+
+(defun org-export-ascii-push-links (link-buffer)
+ "Push out links in the buffer."
+ (when link-buffer
+ ;; We still have links to push out.
+ (insert "\n")
+ (let ((ind ""))
+ (save-match-data
+ (if (save-excursion
+ (re-search-backward
+ (concat "^\\(\\([ \t]*\\)\\|\\("
+ org-outline-regexp
+ "\\)\\)[^ \t\n]") nil t))
+ (setq ind (or (match-string 2)
+ (make-string (length (match-string 3)) ?\ )))))
+ (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
+ link-buffer))
+ (insert "\n")))
+
+(defun org-ascii-level-start (level title umax &optional lines)
+ "Insert a new level in ASCII export."
+ (let (char (n (- level umax 1)) (ind 0))
+ (if (> level umax)
+ (progn
+ (insert (make-string (* 2 n) ?\ )
+ (char-to-string (nth (% n (length org-export-ascii-bullets))
+ org-export-ascii-bullets))
+ " " title "\n")
+ ;; find the indentation of the next non-empty line
+ (catch 'stop
+ (while lines
+ (if (string-match "^\\* " (car lines)) (throw 'stop nil))
+ (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
+ (throw 'stop (setq ind (org-get-indentation (car lines)))))
+ (pop lines)))
+ (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
+ (if (or (not (equal (char-before) ?\n))
+ (not (equal (char-before (1- (point))) ?\n)))
+ (insert "\n"))
+ (setq char (or (nth (1- level) org-export-ascii-underline)
+ (car (last org-export-ascii-underline))))
+ (unless org-export-with-tags
+ (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq title (replace-match "" t t title))))
+ (if org-export-with-section-numbers
+ (setq title (concat (org-section-number level) " " title)))
+ (insert title "\n" (make-string (string-width title) char) "\n")
+ (setq org-ascii-current-indentation '(0 . 0)))))
+
+(defun org-insert-centered (s &optional underline)
+ "Insert the string S centered and underline it with character UNDERLINE."
+ (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
+ (insert (make-string ind ?\ ) s "\n")
+ (if underline
+ (insert (make-string ind ?\ )
+ (make-string (string-width s) underline)
+ "\n"))))
+
+(defvar org-table-colgroup-info nil)
+(defun org-format-table-ascii (lines)
+ "Format a table for ascii export."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (not (string-match "^[ \t]*|" (car lines)))
+ ;; Table made by table.el - test for spanning
+ lines
+
+ ;; A normal org table
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; column and the special lines
+ (setq lines (org-table-clean-before-export lines)))
+ ;; Get rid of the vertical lines except for grouping
+ (if org-export-ascii-table-keep-all-vertical-lines
+ lines
+ (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
+ rtn line vl1 start)
+ (while (setq line (pop lines))
+ (if (string-match org-table-hline-regexp line)
+ (and (string-match "|\\(.*\\)|" line)
+ (setq line (replace-match " \\1" t nil line)))
+ (setq start 0 vl1 vl)
+ (while (string-match "|" line start)
+ (setq start (match-end 0))
+ (or (pop vl1) (setq line (replace-match " " t t line)))))
+ (push line rtn))
+ (nreverse rtn)))))
+
+(defun org-colgroup-info-to-vline-list (info)
+ (let (vl new last)
+ (while info
+ (setq last new new (pop info))
+ (if (or (memq last '(:end :startend))
+ (memq new '(:start :startend)))
+ (push t vl)
+ (push nil vl)))
+ (setq vl (nreverse vl))
+ (and vl (setcar vl nil))
+ vl))
+
+(provide 'org-ascii)
+
+;;; org-ascii.el ends here
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
new file mode 100644
index 0000000..e02d7e0
--- /dev/null
+++ b/lisp/org-attach.el
@@ -0,0 +1,454 @@
+;;; org-attach.el --- Manage file attachments to org-mode tasks
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@newartisans.com>
+;; Keywords: org data task
+
+;; 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:
+
+;; See the Org-mode manual for information on how to use it.
+;;
+;; Attachments are managed in a special directory called "data", which
+;; lives in the same directory as the org file itself. If this data
+;; directory is initialized as a Git repository, then org-attach will
+;; automatically commit changes when it sees them.
+;;
+;; Attachment directories are identified using a UUID generated for the
+;; task which has the attachments. These are added as property to the
+;; task when necessary, and should not be deleted or changed by the
+;; user, ever. UUIDs are generated by a mechanism defined in the variable
+;; `org-id-method'.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org-id)
+(require 'org)
+
+(defgroup org-attach nil
+ "Options concerning entry attachments in Org-mode."
+ :tag "Org Attach"
+ :group 'org)
+
+(defcustom org-attach-directory "data/"
+ "The directory where attachments are stored.
+If this is a relative path, it will be interpreted relative to the directory
+where the Org file lives."
+ :group 'org-attach
+ :type 'directory)
+
+(defcustom org-attach-auto-tag "ATTACH"
+ "Tag that will be triggered automatically when an entry has an attachment."
+ :group 'org-attach
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Tag")))
+
+(defcustom org-attach-file-list-property "Attachments"
+ "The property used to keep a list of attachment belonging to this entry.
+This is not really needed, so you may set this to nil if you don't want it.
+Also, for entries where children inherit the directory, the list of
+attachments is not kept in this property."
+ :group 'org-attach
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "Tag")))
+
+(defcustom org-attach-method 'cp
+ "The preferred method to attach a file.
+Allowed values are:
+
+mv rename the file to move it into the attachment directory
+cp copy the file
+ln create a hard link. Note that this is not supported
+ on all systems, and then the result is not defined.
+lns create a symbol link. Note that this is not supported
+ on all systems, and then the result is not defined."
+ :group 'org-attach
+ :type '(choice
+ (const :tag "Copy" cp)
+ (const :tag "Move/Rename" mv)
+ (const :tag "Hard Link" ln)
+ (const :tag "Symbol Link" lns)))
+
+(defcustom org-attach-expert nil
+ "Non-nil means do not show the splash buffer with the attach dispatcher."
+ :group 'org-attach
+ :type 'boolean)
+
+(defcustom org-attach-allow-inheritance t
+ "Non-nil means allow attachment directories be inherited."
+ :group 'org-attach
+ :type 'boolean)
+
+(defvar org-attach-inherited nil
+ "Indicates if the last access to the attachment directory was inherited.")
+
+(defcustom org-attach-store-link-p nil
+ "Non-nil means store a link to a file when attaching it."
+ :group 'org-attach
+ :version "24.1"
+ :type '(choice
+ (const :tag "Don't store link" nil)
+ (const :tag "Link to origin location" t)
+ (const :tag "Link to the attach-dir location" attached)))
+
+;;;###autoload
+(defun org-attach ()
+ "The dispatcher for attachment commands.
+Shows a list of commands and prompts for another key to execute a command."
+ (interactive)
+ (let (c marker)
+ (when (eq major-mode 'org-agenda-mode)
+ (setq marker (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker)))
+ (unless marker
+ (error "No task in current line")))
+ (save-excursion
+ (when marker
+ (set-buffer (marker-buffer marker))
+ (goto-char marker))
+ (org-back-to-heading t)
+ (save-excursion
+ (save-window-excursion
+ (unless org-attach-expert
+ (with-output-to-temp-buffer "*Org Attach*"
+ (princ "Select an Attachment Command:
+
+a Select a file and attach it to the task, using `org-attach-method'.
+c/m/l/y Attach a file using copy/move/link/symbolic-link method.
+n Create a new attachment, as an Emacs buffer.
+z Synchronize the current task with its attachment
+ directory, in case you added attachments yourself.
+
+o Open current task's attachments.
+O Like \"o\", but force opening in Emacs.
+f Open current task's attachment directory.
+F Like \"f\", but force using dired in Emacs.
+
+d Delete one attachment, you will be prompted for a file name.
+D Delete all of a task's attachments. A safer way is
+ to open the directory in dired and delete from there.
+
+s Set a specific attachment directory for this entry.
+i Make children of the current entry inherit its attachment directory.")))
+ (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
+ (message "Select command: [acmlzoOfFdD]")
+ (setq c (read-char-exclusive))
+ (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
+ (cond
+ ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach))
+ ((memq c '(?c ?\C-c))
+ (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?m ?\C-m))
+ (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?l ?\C-l))
+ (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?y ?\C-y))
+ (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
+ ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
+ ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
+ ((eq c ?O) (call-interactively 'org-attach-open-in-emacs))
+ ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
+ ((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs))
+ ((memq c '(?d ?\C-d)) (call-interactively
+ 'org-attach-delete-one))
+ ((eq c ?D) (call-interactively 'org-attach-delete-all))
+ ((eq c ?q) (message "Abort"))
+ ((memq c '(?s ?\C-s)) (call-interactively
+ 'org-attach-set-directory))
+ ((memq c '(?i ?\C-i)) (call-interactively
+ 'org-attach-set-inherit))
+ (t (error "No such attachment command %c" c))))))
+
+(defun org-attach-dir (&optional create-if-not-exists-p)
+ "Return the directory associated with the current entry.
+This first checks for a local property ATTACH_DIR, and then for an inherited
+property ATTACH_DIR_INHERIT. If neither exists, the default mechanism
+using the entry ID will be invoked to access the unique directory for the
+current entry.
+If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
+the directory and (if necessary) the corresponding ID will be created."
+ (let (attach-dir uuid inherit)
+ (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))
+ (cond
+ ((setq attach-dir (org-entry-get nil "ATTACH_DIR"))
+ (org-attach-check-absolute-path attach-dir))
+ ((and org-attach-allow-inheritance
+ (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t)))
+ (setq attach-dir
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char org-entry-property-inherited-from)
+ (let (org-attach-allow-inheritance)
+ (org-attach-dir create-if-not-exists-p)))))
+ (org-attach-check-absolute-path attach-dir)
+ (setq org-attach-inherited t))
+ (t ; use the ID
+ (org-attach-check-absolute-path nil)
+ (setq uuid (org-id-get (point) create-if-not-exists-p))
+ (when (or uuid create-if-not-exists-p)
+ (unless uuid (error "ID retrieval/creation failed"))
+ (setq attach-dir (expand-file-name
+ (format "%s/%s"
+ (substring uuid 0 2)
+ (substring uuid 2))
+ (expand-file-name org-attach-directory))))))
+ (when attach-dir
+ (if (and create-if-not-exists-p
+ (not (file-directory-p attach-dir)))
+ (make-directory attach-dir t))
+ (and (file-exists-p attach-dir)
+ attach-dir))))
+
+(defun org-attach-check-absolute-path (dir)
+ "Check if we have enough information to root the attachment directory.
+When DIR is given, check also if it is already absolute. Otherwise,
+assume that it will be relative, and check if `org-attach-directory' is
+absolute, or if at least the current buffer has a file name.
+Throw an error if we cannot root the directory."
+ (or (and dir (file-name-absolute-p dir))
+ (file-name-absolute-p org-attach-directory)
+ (buffer-file-name (buffer-base-buffer))
+ (error "Need absolute `org-attach-directory' to attach in buffers without filename")))
+
+(defun org-attach-set-directory ()
+ "Set the ATTACH_DIR property of the current entry.
+The property defines the directory that is used for attachments
+of the entry."
+ (interactive)
+ (let ((dir (org-entry-get nil "ATTACH_DIR")))
+ (setq dir (read-directory-name "Attachment directory: " dir))
+ (org-entry-put nil "ATTACH_DIR" dir)))
+
+(defun org-attach-set-inherit ()
+ "Set the ATTACH_DIR_INHERIT property of the current entry.
+The property defines the directory that is used for attachments
+of the entry and any children that do not explicitly define (by setting
+the ATTACH_DIR property) their own attachment directory."
+ (interactive)
+ (org-entry-put nil "ATTACH_DIR_INHERIT" "t")
+ (message "Children will inherit attachment directory"))
+
+(defun org-attach-commit ()
+ "Commit changes to git if `org-attach-directory' is properly initialized.
+This checks for the existence of a \".git\" directory in that directory."
+ (let ((dir (expand-file-name org-attach-directory)))
+ (when (file-exists-p (expand-file-name ".git" dir))
+ (with-temp-buffer
+ (cd dir)
+ (shell-command "git add .")
+ (shell-command "git ls-files --deleted" t)
+ (mapc #'(lambda (file)
+ (unless (string= file "")
+ (shell-command
+ (concat "git rm \"" file "\""))))
+ (split-string (buffer-string) "\n"))
+ (shell-command "git commit -m 'Synchronized attachments'")))))
+
+(defun org-attach-tag (&optional off)
+ "Turn the autotag on or (if OFF is set) off."
+ (when org-attach-auto-tag
+ (save-excursion
+ (org-back-to-heading t)
+ (org-toggle-tag org-attach-auto-tag (if off 'off 'on)))))
+
+(defun org-attach-untag ()
+ "Turn the autotag off."
+ (org-attach-tag 'off))
+
+(defun org-attach-store-link (file)
+ "Add a link to `org-stored-link' when attaching a file.
+Only do this when `org-attach-store-link-p' is non-nil."
+ (setq org-stored-links
+ (cons (list (org-attach-expand-link file)
+ (file-name-nondirectory file))
+ org-stored-links)))
+
+(defun org-attach-attach (file &optional visit-dir method)
+ "Move/copy/link FILE into the attachment directory of the current task.
+If VISIT-DIR is non-nil, visit the directory with dired.
+METHOD may be `cp', `mv', `ln', or `lns' default taken from
+`org-attach-method'."
+ (interactive "fFile to keep as an attachment: \nP")
+ (setq method (or method org-attach-method))
+ (let ((basename (file-name-nondirectory file)))
+ (when (and org-attach-file-list-property (not org-attach-inherited))
+ (org-entry-add-to-multivalued-property
+ (point) org-attach-file-list-property basename))
+ (let* ((attach-dir (org-attach-dir t))
+ (fname (expand-file-name basename attach-dir)))
+ (cond
+ ((eq method 'mv) (rename-file file fname))
+ ((eq method 'cp) (copy-file file fname))
+ ((eq method 'ln) (add-name-to-file file fname))
+ ((eq method 'lns) (make-symbolic-link file fname)))
+ (org-attach-commit)
+ (org-attach-tag)
+ (cond ((eq org-attach-store-link-p 'attached)
+ (org-attach-store-link fname))
+ ((eq org-attach-store-link-p t)
+ (org-attach-store-link file)))
+ (if visit-dir
+ (dired attach-dir)
+ (message "File \"%s\" is now a task attachment." basename)))))
+
+(defun org-attach-attach-cp ()
+ "Attach a file by copying it."
+ (interactive)
+ (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
+(defun org-attach-attach-mv ()
+ "Attach a file by moving (renaming) it."
+ (interactive)
+ (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
+(defun org-attach-attach-ln ()
+ "Attach a file by creating a hard link to it.
+Beware that this does not work on systems that do not support hard links.
+On some systems, this apparently does copy the file instead."
+ (interactive)
+ (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
+(defun org-attach-attach-lns ()
+ "Attach a file by creating a symbolic link to it.
+
+Beware that this does not work on systems that do not support symbolic links.
+On some systems, this apparently does copy the file instead."
+ (interactive)
+ (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
+
+(defun org-attach-new (file)
+ "Create a new attachment FILE for the current task.
+The attachment is created as an Emacs buffer."
+ (interactive "sCreate attachment named: ")
+ (when (and org-attach-file-list-property (not org-attach-inherited))
+ (org-entry-add-to-multivalued-property
+ (point) org-attach-file-list-property file))
+ (let ((attach-dir (org-attach-dir t)))
+ (org-attach-tag)
+ (find-file (expand-file-name file attach-dir))
+ (message "New attachment %s" file)))
+
+(defun org-attach-delete-one (&optional file)
+ "Delete a single attachment."
+ (interactive)
+ (let* ((attach-dir (org-attach-dir t))
+ (files (org-attach-file-list attach-dir))
+ (file (or file
+ (org-icompleting-read
+ "Delete attachment: "
+ (mapcar (lambda (f)
+ (list (file-name-nondirectory f)))
+ files)))))
+ (setq file (expand-file-name file attach-dir))
+ (unless (file-exists-p file)
+ (error "No such attachment: %s" file))
+ (delete-file file)
+ (org-attach-commit)))
+
+(defun org-attach-delete-all (&optional force)
+ "Delete all attachments from the current task.
+This actually deletes the entire attachment directory.
+A safer way is to open the directory in dired and delete from there."
+ (interactive "P")
+ (when (and org-attach-file-list-property (not org-attach-inherited))
+ (org-entry-delete (point) org-attach-file-list-property))
+ (let ((attach-dir (org-attach-dir)))
+ (when
+ (and attach-dir
+ (or force
+ (y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
+ (shell-command (format "rm -fr %s" attach-dir))
+ (message "Attachment directory removed")
+ (org-attach-commit)
+ (org-attach-untag))))
+
+(defun org-attach-sync ()
+ "Synchronize the current tasks with its attachments.
+This can be used after files have been added externally."
+ (interactive)
+ (org-attach-commit)
+ (when (and org-attach-file-list-property (not org-attach-inherited))
+ (org-entry-delete (point) org-attach-file-list-property))
+ (let ((attach-dir (org-attach-dir)))
+ (when attach-dir
+ (let ((files (org-attach-file-list attach-dir)))
+ (and files (org-attach-tag))
+ (when org-attach-file-list-property
+ (dolist (file files)
+ (unless (string-match "^\\." file)
+ (org-entry-add-to-multivalued-property
+ (point) org-attach-file-list-property file))))))))
+
+(defun org-attach-file-list (dir)
+ "Return a list of files in the attachment directory.
+This ignores files starting with a \".\", and files ending in \"~\"."
+ (delq nil
+ (mapcar (lambda (x) (if (string-match "^\\." x) nil x))
+ (directory-files dir nil "[^~]\\'"))))
+
+(defun org-attach-reveal (&optional if-exists)
+ "Show the attachment directory of the current task in dired."
+ (interactive "P")
+ (let ((attach-dir (org-attach-dir (not if-exists))))
+ (and attach-dir (org-open-file attach-dir))))
+
+(defun org-attach-reveal-in-emacs ()
+ "Show the attachment directory of the current task.
+This will attempt to use an external program to show the directory."
+ (interactive)
+ (let ((attach-dir (org-attach-dir t)))
+ (dired attach-dir)))
+
+(defun org-attach-open (&optional in-emacs)
+ "Open an attachment of the current task.
+If there are more than one attachment, you will be prompted for the file name.
+This command will open the file using the settings in `org-file-apps'
+and in the system-specific variants of this variable.
+If IN-EMACS is non-nil, force opening in Emacs."
+ (interactive "P")
+ (let* ((attach-dir (org-attach-dir t))
+ (files (org-attach-file-list attach-dir))
+ (file (if (= (length files) 1)
+ (car files)
+ (org-icompleting-read "Open attachment: "
+ (mapcar 'list files) nil t))))
+ (org-open-file (expand-file-name file attach-dir) in-emacs)))
+
+(defun org-attach-open-in-emacs ()
+ "Open attachment, force opening in Emacs.
+See `org-attach-open'."
+ (interactive)
+ (org-attach-open 'in-emacs))
+
+(defun org-attach-expand (file)
+ "Return the full path to the current entry's attachment file FILE.
+Basically, this adds the path to the attachment directory."
+ (expand-file-name file (org-attach-dir)))
+
+(defun org-attach-expand-link (file)
+ "Return a file link pointing to the current entry's attachment file FILE.
+Basically, this adds the path to the attachment directory, and a \"file:\"
+prefix."
+ (concat "file:" (org-attach-expand file)))
+
+(provide 'org-attach)
+
+;;; org-attach.el ends here
diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el
new file mode 100644
index 0000000..be395ad
--- /dev/null
+++ b/lisp/org-bbdb.el
@@ -0,0 +1,436 @@
+;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Authors: Carsten Dominik <carsten at orgmode dot org>
+;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to BBDB database entries from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;; It also implements an interface (based on Ivar Rummelhoff's
+;; bbdb-anniv.el) for those org-mode users, who do not use the diary
+;; but who do want to include the anniversaries stored in the BBDB
+;; into the org-agenda. If you already include the `diary' into the
+;; agenda, you might want to prefer to include the anniversaries in
+;; the diary using bbdb-anniv.el.
+;;
+;; Put the following in /somewhere/at/home/diary.org and make sure
+;; that this file is in `org-agenda-files`
+;;
+;; %%(org-bbdb-anniversaries)
+;;
+;; For example my diary.org looks like:
+;; * Anniversaries
+;; #+CATEGORY: Anniv
+;; %%(org-bbdb-anniversaries)
+;;
+;;
+;; To add an anniversary to a BBDB record, press `C-o' in the record.
+;; You will be prompted for the field name, in this case it must be
+;; "anniversary". If this is the first time you are using this field,
+;; you need to confirm that it should be created.
+;;
+;; The format of an anniversary field stored in BBDB is the following
+;; (items in {} are optional):
+;;
+;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}
+;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}...
+;;
+;; CLASS-OR-FORMAT-STRING is one of two things:
+;;
+;; - an identifier for a class of anniversaries (eg. birthday or
+;; wedding) from `org-bbdb-anniversary-format-alist' which then
+;; defines the format string for this class
+;; - the (format) string displayed in the diary.
+;;
+;; You can enter multiple anniversaries for a single BBDB record by
+;; separating them with a newline character. At the BBDB prompt for
+;; the field value, type `C-q C-j' to enter a newline between two
+;; anniversaries.
+;;
+;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the
+;; value of `org-bbdb-default-anniversary-format' ("birthday" by
+;; default).
+;;
+;; The substitutions in the format string are (in order):
+;; - the name of the record containing this anniversary
+;; - the number of years
+;; - an ordinal suffix (st, nd, rd, th) for the year
+;;
+;; See the documentation of `org-bbdb-anniversary-format-alist' for
+;; further options.
+;;
+;; Example
+;;
+;; 1973-06-22
+;; 20??-??-?? wedding
+;; 1998-03-12 %s created bbdb-anniv.el %d years ago
+;;
+;; From Org's agenda, you can use `C-c C-o' to jump to the BBDB
+;; link from which the entry at point originates.
+;;
+;;; Code:
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+;; Declare external functions and variables
+
+(declare-function bbdb "ext:bbdb-com" (string elidep))
+(declare-function bbdb-company "ext:bbdb-com" (string elidep))
+(declare-function bbdb-current-record "ext:bbdb-com"
+ (&optional planning-on-modifying))
+(declare-function bbdb-name "ext:bbdb-com" (string elidep))
+(declare-function bbdb-completing-read-record "ext:bbdb-com"
+ (prompt &optional omit-records))
+(declare-function bbdb-record-getprop "ext:bbdb" (record property))
+(declare-function bbdb-record-name "ext:bbdb" (record))
+(declare-function bbdb-records "ext:bbdb"
+ (&optional dont-check-disk already-in-db-buffer))
+(declare-function bbdb-split "ext:bbdb" (string separators))
+(declare-function bbdb-string-trim "ext:bbdb" (string))
+(declare-function bbdb-record-get-field "ext:bbdb" (record field))
+(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout))
+(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout))
+
+;; `bbdb-record-note' is part of BBDB v3.x
+(declare-function bbdb-record-note "ext:bbdb" (record label))
+
+(declare-function calendar-leap-year-p "calendar" (year))
+(declare-function diary-ordinal-suffix "diary-lib" (n))
+
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+
+;; Customization
+
+(defgroup org-bbdb-anniversaries nil
+ "Customizations for including anniversaries from BBDB into Agenda."
+ :group 'org-bbdb)
+
+(defcustom org-bbdb-default-anniversary-format "birthday"
+ "Default anniversary class."
+ :type 'string
+ :group 'org-bbdb-anniversaries
+ :require 'bbdb)
+
+(defcustom org-bbdb-anniversary-format-alist
+ '(("birthday" .
+ (lambda (name years suffix)
+ (concat "Birthday: [[bbdb:" name "][" name " ("
+ (format "%s" years) ; handles numbers as well as strings
+ suffix ")]]")))
+ ("wedding" .
+ (lambda (name years suffix)
+ (concat "[[bbdb:" name "][" name "'s "
+ (format "%s" years)
+ suffix " wedding anniversary]]"))))
+ "How different types of anniversaries should be formatted.
+An alist of elements (STRING . FORMAT) where STRING is the name of an
+anniversary class and format is either:
+1) A format string with the following substitutions (in order):
+ - the name of the record containing this anniversary
+ - the number of years
+ - an ordinal suffix (st, nd, rd, th) for the year
+
+2) A function to be called with three arguments: NAME YEARS SUFFIX
+ (string int string) returning a string for the diary or nil.
+
+3) An Emacs Lisp form that should evaluate to a string (or nil) in the
+ scope of variables NAME, YEARS and SUFFIX (among others)."
+ :type '(alist :key-type (string :tag "Class")
+ :value-type (function :tag "Function"))
+ :group 'org-bbdb-anniversaries
+ :require 'bbdb)
+
+(defcustom org-bbdb-anniversary-field 'anniversary
+ "The BBDB field which contains anniversaries.
+The anniversaries are stored in the following format
+
+YYYY-MM-DD Class-or-Format-String
+
+where class is one of the customized classes for anniversaries;
+birthday and wedding are predefined. Format-String can take three
+substitutions 1) the name of the record containing this
+anniversary, 2) the number of years, and 3) an ordinal suffix for
+the year.
+
+Multiple anniversaries can be separated by \\n."
+ :type 'symbol
+ :group 'org-bbdb-anniversaries
+ :require 'bbdb)
+
+(defcustom org-bbdb-extract-date-fun 'org-bbdb-anniv-extract-date
+ "How to retrieve `month date year' from the anniversary field.
+
+Customize if you have already filled your BBDB with dates
+different from YYYY-MM-DD. The function must return a list (month
+date year)."
+ :type 'function
+ :group 'org-bbdb-anniversaries
+ :require 'bbdb)
+
+
+;; Install the link type
+(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export)
+(add-hook 'org-store-link-functions 'org-bbdb-store-link)
+
+;; Implementation
+(defun org-bbdb-store-link ()
+ "Store a link to a BBDB database entry."
+ (when (eq major-mode 'bbdb-mode)
+ ;; This is BBDB, we make this link!
+ (let* ((rec (bbdb-current-record))
+ (name (bbdb-record-name rec))
+ (company (if (fboundp 'bbdb-record-getprop)
+ (bbdb-record-getprop rec 'company)
+ (car (bbdb-record-get-field rec 'organization))))
+ (link (concat "bbdb:" name)))
+ (org-store-link-props :type "bbdb" :name name :company company
+ :link link :description name)
+ link)))
+
+(defun org-bbdb-export (path desc format)
+ "Create the export version of a BBDB link specified by PATH or DESC.
+If exporting to either HTML or LaTeX FORMAT the link will be
+italicized, in all other cases it is left unchanged."
+ (when (string= desc (format "bbdb:%s" path))
+ (setq desc path))
+ (cond
+ ((eq format 'html) (format "<i>%s</i>" desc))
+ ((eq format 'latex) (format "\\textit{%s}" desc))
+ ((eq format 'odt)
+ (format "<text:span text:style-name=\"Emphasis\">%s</text:span>" desc))
+ (t desc)))
+
+(defun org-bbdb-open (name)
+ "Follow a BBDB link to NAME."
+ (require 'bbdb-com)
+ (let ((inhibit-redisplay (not debug-on-error))
+ (bbdb-electric-p nil))
+ (if (fboundp 'bbdb-name)
+ (org-bbdb-open-old name)
+ (org-bbdb-open-new name))))
+
+(defun org-bbdb-open-old (name)
+ (catch 'exit
+ ;; Exact match on name
+ (bbdb-name (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Exact match on name
+ (bbdb-company (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on name
+ (bbdb-name name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on company
+ (bbdb-company name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; General match including network address and notes
+ (bbdb name nil)
+ (when (= 0 (buffer-size (get-buffer "*BBDB*")))
+ (delete-window (get-buffer-window "*BBDB*"))
+ (error "No matching BBDB record"))))
+
+(defun org-bbdb-open-new (name)
+ (catch 'exit
+ ;; Exact match on name
+ (bbdb-search-name (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Exact match on name
+ (bbdb-search-organization (concat "\\`" name "\\'") nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on name
+ (bbdb-search-name name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; Partial match on company
+ (bbdb-search-organization name nil)
+ (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
+ ;; General match including network address and notes
+ (bbdb name nil)
+ (when (= 0 (buffer-size (get-buffer "*BBDB*")))
+ (delete-window (get-buffer-window "*BBDB*"))
+ (error "No matching BBDB record"))))
+
+(defun org-bbdb-anniv-extract-date (time-str)
+ "Convert YYYY-MM-DD to (month date year).
+Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
+it will be considered unknown."
+ (multiple-value-bind (a b c) (values-list (org-split-string time-str "-"))
+ (if (eq c nil)
+ (list (string-to-number a)
+ (string-to-number b)
+ nil)
+ (list (string-to-number b)
+ (string-to-number c)
+ (string-to-number a)))))
+
+(defun org-bbdb-anniv-split (str)
+ "Split multiple entries in the BBDB anniversary field.
+Argument STR is the anniversary field in BBDB."
+ (let ((pos (string-match "[ \t]" str)))
+ (if pos (list (substring str 0 pos)
+ (bbdb-string-trim (substring str pos)))
+ (list str nil))))
+
+(defvar org-bbdb-anniv-hash nil
+ "A hash holding anniversaries extracted from BBDB.
+The hash table is created on first use.")
+
+(defvar org-bbdb-updated-p t
+ "This is non-nil if BBDB has been updated since we last built the hash.")
+
+(defun org-bbdb-make-anniv-hash ()
+ "Create a hash with anniversaries extracted from BBDB, for fast access.
+The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
+ (let ((old-bbdb (fboundp 'bbdb-record-getprop))
+ split tmp annivs)
+ (clrhash org-bbdb-anniv-hash)
+ (dolist (rec (bbdb-records))
+ (when (setq annivs (if old-bbdb
+ (bbdb-record-getprop
+ rec org-bbdb-anniversary-field)
+ (bbdb-record-note
+ rec org-bbdb-anniversary-field)))
+ (setq annivs (if old-bbdb
+ (bbdb-split annivs "\n")
+ ;; parameter order is reversed in new bbdb
+ (bbdb-split "\n" annivs)))
+ (while annivs
+ (setq split (org-bbdb-anniv-split (pop annivs)))
+ (multiple-value-bind (m d y)
+ (values-list (funcall org-bbdb-extract-date-fun (car split)))
+ (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
+ (puthash (list m d) (cons (list y
+ (bbdb-record-name rec)
+ (cadr split))
+ tmp)
+ org-bbdb-anniv-hash))))))
+ (setq org-bbdb-updated-p nil))
+
+(defun org-bbdb-updated (rec)
+ "Record the fact that BBDB has been updated.
+This is used by Org to re-create the anniversary hash table."
+ (setq org-bbdb-updated-p t))
+
+(add-hook 'bbdb-after-change-hook 'org-bbdb-updated)
+
+;;;###autoload
+(defun org-bbdb-anniversaries()
+ "Extract anniversaries from BBDB for display in the agenda."
+ (require 'bbdb)
+ (require 'diary-lib)
+ (unless (hash-table-p org-bbdb-anniv-hash)
+ (setq org-bbdb-anniv-hash
+ (make-hash-table :test 'equal :size 366)))
+
+ (when (or org-bbdb-updated-p
+ (= 0 (hash-table-count org-bbdb-anniv-hash)))
+ (org-bbdb-make-anniv-hash))
+
+ (let* ((m (car date)) ; month
+ (d (nth 1 date)) ; day
+ (y (nth 2 date)) ; year
+ (annivs (gethash (list m d) org-bbdb-anniv-hash))
+ (text ())
+ rec recs)
+
+ ;; we don't want to miss people born on Feb. 29th
+ (when (and (= m 3) (= d 1)
+ (not (null (gethash (list 2 29) org-bbdb-anniv-hash)))
+ (not (calendar-leap-year-p y)))
+ (setq recs (gethash (list 2 29) org-bbdb-anniv-hash))
+ (while (setq rec (pop recs))
+ (push rec annivs)))
+
+ (when annivs
+ (while (setq rec (pop annivs))
+ (when rec
+ (let* ((class (or (nth 2 rec)
+ org-bbdb-default-anniversary-format))
+ (form (or (cdr (assoc-string
+ class org-bbdb-anniversary-format-alist t))
+ class)) ; (as format string)
+ (name (nth 1 rec))
+ (years (if (eq (car rec) nil)
+ "unknown"
+ (- y (car rec))))
+ (suffix (if (eq (car rec) nil)
+ ""
+ (diary-ordinal-suffix years)))
+ (tmp (cond
+ ((functionp form)
+ (funcall form name years suffix))
+ ((listp form) (eval form))
+ (t (format form name years suffix)))))
+ (org-add-props tmp nil 'org-bbdb-name name)
+ (if text
+ (setq text (append text (list tmp)))
+ (setq text (list tmp)))))
+ ))
+ text))
+
+(defun org-bbdb-complete-link ()
+ "Read a bbdb link with name completion."
+ (require 'bbdb-com)
+ (concat "bbdb:"
+ (bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
+
+(defun org-bbdb-anniv-export-ical ()
+ "Extract anniversaries from BBDB and convert them to icalendar format."
+ (require 'bbdb)
+ (require 'diary-lib)
+ (unless (hash-table-p org-bbdb-anniv-hash)
+ (setq org-bbdb-anniv-hash
+ (make-hash-table :test 'equal :size 366)))
+ (when (or org-bbdb-updated-p
+ (= 0 (hash-table-count org-bbdb-anniv-hash)))
+ (org-bbdb-make-anniv-hash))
+ (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash))
+
+(defun org-bbdb-format-vevent (key recs)
+ (let (rec categ)
+ (while (setq rec (pop recs))
+ (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format))
+ (princ (format "BEGIN:VEVENT
+UID: ANNIV-%4i%02i%02i-%s
+DTSTART:%4i%02i%02i
+SUMMARY:%s
+DESCRIPTION:%s
+CATEGORIES:%s
+RRULE:FREQ=YEARLY
+END:VEVENT\n"
+ (nth 0 rec) (nth 0 key) (nth 1 key)
+ (mapconcat 'identity
+ (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+")
+ "-")
+ (nth 0 rec) (nth 0 key) (nth 1 key)
+ (nth 1 rec)
+ (concat (capitalize categ) " " (nth 1 rec))
+ categ)))))
+
+(provide 'org-bbdb)
+
+;;; org-bbdb.el ends here
diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el
new file mode 100644
index 0000000..b5f3013
--- /dev/null
+++ b/lisp/org-beamer.el
@@ -0,0 +1,656 @@
+;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
+;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
+;; Keywords: org, wp, tex
+
+;; 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 library implement the special treatment needed by using the
+;; beamer class during LaTeX export.
+
+;;; Code:
+
+(require 'org)
+(require 'org-exp)
+
+(defvar org-export-latex-header)
+(defvar org-export-latex-options-plist)
+(defvar org-export-opt-plist)
+
+(defgroup org-beamer nil
+ "Options specific for using the beamer class in LaTeX export."
+ :tag "Org Beamer"
+ :group 'org-export-latex)
+
+(defcustom org-beamer-use-parts nil
+ ""
+ :group 'org-beamer
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-beamer-frame-level 1
+ "The level that should be interpreted as a frame.
+The levels above this one will be translated into a sectioning structure.
+Setting this to 2 will allow sections, 3 will allow subsections as well.
+You can set this to 4 as well, if you at the same time set
+`org-beamer-use-parts' to make the top levels `\part'."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(choice
+ (const :tag "Frames need a BEAMER_env property" nil)
+ (integer :tag "Specific level makes a frame")))
+
+(defcustom org-beamer-frame-default-options ""
+ "Default options string to use for frames, should contains the [brackets].
+And example for this is \"[allowframebreaks]\"."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(string :tag "[options]"))
+
+(defcustom org-beamer-column-view-format
+ "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)"
+ "Default column view format that should be used to fill the template."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not insert Beamer column view format" nil)
+ (string :tag "Beamer column view format")))
+
+(defcustom org-beamer-themes
+ "\\usetheme{default}\\usecolortheme{default}"
+ "Default string to be used for extra heading stuff in beamer presentations.
+When a beamer template is filled, this will be the default for
+BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not insert Beamer themes" nil)
+ (string :tag "Beamer themes")))
+
+(defconst org-beamer-column-widths
+ "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
+ "The column widths that should be installed as allowed property values.")
+
+(defconst org-beamer-transitions
+ "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
+ "Transitions available for beamer.
+These are just a completion help.")
+
+(defconst org-beamer-environments-default
+ '(("frame" "f" "dummy- special handling hard coded" "dummy")
+ ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}")
+ ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}")
+ ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}")
+ ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}")
+ ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}")
+ ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}")
+ ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}")
+ ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}")
+ ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
+ ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
+ ("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
+ ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
+ ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
+ ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
+ ("normal" "h" "%h" "") ; Emit the heading as normal text
+ ("note" "n" "\\note%o%a{%h" "}")
+ ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading
+ ("ignoreheading" "i" "%%%% %h" ""))
+ "Environments triggered by properties in Beamer export.
+These are the defaults - for user definitions, see
+`org-beamer-environments-extra'.
+\"normal\" is a special fake environment, which emit the heading as
+normal text. It is needed when an environment should be surrounded
+by normal text. Since beamer export converts nodes into environments,
+you need to have a node to end the environment.
+For example
+
+ ** a frame
+ some text
+ *** Blocktitle :B_block:
+ inside the block
+ *** After the block :B_normal:
+ continuing here
+ ** next frame")
+
+(defcustom org-beamer-environments-extra nil
+ "Environments triggered by tags in Beamer export.
+Each entry has 4 elements:
+
+name Name of the environment
+key Selection key for `org-beamer-select-environment'
+open The opening template for the environment, with the following escapes
+ %a the action/overlay specification
+ %A the default action/overlay specification
+ %o the options argument of the template
+ %h the headline text
+ %H if there is headline text, that text in {} braces
+ %U if there is headline text, that text in [] brackets
+ %x the content of the BEAMER_extra property
+close The closing string of the environment."
+
+ :group 'org-beamer
+ :version "24.1"
+ :type '(repeat
+ (list
+ (string :tag "Environment")
+ (string :tag "Selection key")
+ (string :tag "Begin")
+ (string :tag "End"))))
+
+(defcustom org-beamer-inherited-properties nil
+ "Properties that should be inherited during beamer export."
+ :group 'org-beamer
+ :type '(repeat
+ (string :tag "Property")))
+
+(defvar org-beamer-frame-level-now nil)
+(defvar org-beamer-header-extra nil)
+(defvar org-beamer-export-is-beamer-p nil)
+(defvar org-beamer-inside-frame-at-level nil)
+(defvar org-beamer-columns-open nil)
+(defvar org-beamer-column-open nil)
+
+(defun org-beamer-cleanup-column-width (width)
+ "Make sure the width is not empty, and that it has a unit."
+ (setq width (org-trim (or width "")))
+ (unless (string-match "\\S-" width) (setq width "0.5"))
+ (if (string-match "\\`[.0-9]+\\'" width)
+ (setq width (concat width "\\textwidth")))
+ width)
+
+(defun org-beamer-open-column (&optional width opt)
+ (org-beamer-close-column-maybe)
+ (setq org-beamer-column-open t)
+ (setq width (org-beamer-cleanup-column-width width))
+ (insert (format "\\begin{column}%s{%s}\n" (or opt "") width)))
+(defun org-beamer-close-column-maybe ()
+ (when org-beamer-column-open
+ (setq org-beamer-column-open nil)
+ (insert "\\end{column}\n")))
+(defun org-beamer-open-columns-maybe (&optional opts)
+ (unless org-beamer-columns-open
+ (setq org-beamer-columns-open t)
+ (insert (format "\\begin{columns}%s\n" (or opts "")))))
+(defun org-beamer-close-columns-maybe ()
+ (org-beamer-close-column-maybe)
+ (when org-beamer-columns-open
+ (setq org-beamer-columns-open nil)
+ (insert "\\end{columns}\n")))
+
+(defun org-beamer-select-environment ()
+ "Select the environment to be used by beamer for this entry.
+While this uses (for convenience) a tag selection interface, the result
+of this command will be that the BEAMER_env *property* of the entry is set.
+
+In addition to this, the command will also set a tag as a visual aid, but
+the tag does not have any semantic meaning."
+ (interactive)
+ (let* ((envs (append org-beamer-environments-extra
+ org-beamer-environments-default))
+ (org-tag-alist
+ (append '((:startgroup))
+ (mapcar (lambda (e) (cons (concat "B_" (car e))
+ (string-to-char (nth 1 e))))
+ envs)
+ '((:endgroup))
+ '(("BMCOL" . ?|))))
+ (org-fast-tag-selection-single-key t))
+ (org-set-tags)
+ (let ((tags (or (ignore-errors (org-get-tags-string)) "")))
+ (cond
+ ((equal org-last-tag-selection-key ?|)
+ (if (string-match ":BMCOL:" tags)
+ (org-set-property "BEAMER_col" (read-string "Column width: "))
+ (org-delete-property "BEAMER_col")))
+ ((string-match (concat ":B_\\("
+ (mapconcat 'car envs "\\|")
+ "\\):")
+ tags)
+ (org-entry-put nil "BEAMER_env" (match-string 1 tags)))
+ (t (org-entry-delete nil "BEAMER_env"))))))
+
+
+(defun org-beamer-sectioning (level text)
+ "Return the sectioning entry for the current headline.
+LEVEL is the reduced level of the headline.
+TEXT is the text of the headline, everything except the leading stars.
+The return value is a cons cell. The car is the headline text, usually
+just TEXT, but possibly modified if options have been extracted from the
+text. The cdr is the sectioning entry, similar to what is given
+in org-export-latex-classes."
+ (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level))
+ (default
+ (if org-beamer-use-parts
+ '((1 . ("\\part{%s}" . "\\part*{%s}"))
+ (2 . ("\\section{%s}" . "\\section*{%s}"))
+ (3 . ("\\subsection{%s}" . "\\subsection*{%s}")))
+ '((1 . ("\\section{%s}" . "\\section*{%s}"))
+ (2 . ("\\subsection{%s}" . "\\subsection*{%s}")))))
+ (envs (append org-beamer-environments-extra
+ org-beamer-environments-default))
+ (props (org-get-text-property-any 0 'org-props text))
+ (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra
+ columns-option column-option
+ env have-text ass tmp)
+ (if (= frame-level 0) (setq frame-level nil))
+ (when (and org-beamer-inside-frame-at-level
+ (<= level org-beamer-inside-frame-at-level))
+ (setq org-beamer-inside-frame-at-level nil))
+ (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props))
+ (if (and (string-match "\\`[0-9.]+\\'" tmp)
+ (or (= (string-to-number tmp) 1.0)
+ (= (string-to-number tmp) 0.0)))
+ ;; column width 1 means close columns, go back to full width
+ (org-beamer-close-columns-maybe)
+ (when (setq ass (assoc "BEAMER_envargs" props))
+ (let (case-fold-search)
+ (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
+ (setq columns-option (match-string 1 (cdr ass)))
+ (setcdr ass (replace-match "" t t (cdr ass))))
+ (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
+ (setq column-option (match-string 1 (cdr ass)))
+ (setcdr ass (replace-match "" t t (cdr ass))))))
+ (org-beamer-open-columns-maybe columns-option)
+ (org-beamer-open-column tmp column-option)))
+ (cond
+ ((or (equal (cdr (assoc "BEAMER_env" props)) "frame")
+ (and frame-level (= level frame-level)))
+ ;; A frame
+ (org-beamer-get-special props)
+
+ (setq in (org-fill-template
+ "\\begin{frame}%a%A%o%T%S%x"
+ (list (cons "a" (or org-beamer-action ""))
+ (cons "A" (or org-beamer-defaction ""))
+ (cons "o" (or org-beamer-option org-beamer-frame-default-options ""))
+ (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
+ (cons "h" "%s")
+ (cons "T" (if (string-match "\\S-" text)
+ "\n\\frametitle{%s}" ""))
+ (cons "S" (if (string-match "\\\\\\\\" text)
+ "\n\\framesubtitle{%s}" ""))))
+ out (copy-sequence "\\end{frame}"))
+ (org-add-props out
+ '(org-insert-hook org-beamer-close-columns-maybe))
+ (setq org-beamer-inside-frame-at-level level)
+ (cons text (list in out in out)))
+ ((and (setq env (cdr (assoc "BEAMER_env" props)))
+ (setq ass (assoc env envs)))
+ ;; A beamer environment selected by the BEAMER_env property
+ (if (string-match "[ \t]+:[ \t]*$" text)
+ (setq text (replace-match "" t t text)))
+ (if (member env '("note" "noteNH"))
+ ;; There should be no labels in a note, so we remove the targets
+ ;; FIXME???
+ (remove-text-properties 0 (length text) '(target nil) text))
+ (org-beamer-get-special props)
+ (setq text (org-trim text))
+ (setq have-text (string-match "\\S-" text))
+ (setq in (org-fill-template
+ (nth 2 ass)
+ (list (cons "a" (or org-beamer-action ""))
+ (cons "A" (or org-beamer-defaction ""))
+ (cons "o" (or org-beamer-option ""))
+ (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
+ (cons "h" "%s")
+ (cons "H" (if have-text (concat "{" text "}") ""))
+ (cons "U" (if have-text (concat "[" text "]") ""))))
+ out (nth 3 ass))
+ (cond
+ ((equal out "\\end{columns}")
+ (setq org-beamer-columns-open t)
+ (setq out (org-add-props (copy-sequence out)
+ '(org-insert-hook
+ (lambda ()
+ (org-beamer-close-column-maybe)
+ (setq org-beamer-columns-open nil))))))
+ ((equal out "\\end{column}")
+ (org-beamer-open-columns-maybe)))
+ (cons text (list in out in out)))
+ ((and (not org-beamer-inside-frame-at-level)
+ (or (not frame-level)
+ (< level frame-level))
+ (assoc level default))
+ ;; Normal sectioning
+ (cons text (cdr (assoc level default))))
+ (t nil))))
+
+(defvar org-beamer-extra)
+(defvar org-beamer-option)
+(defvar org-beamer-action)
+(defvar org-beamer-defaction)
+(defvar org-beamer-environment)
+(defun org-beamer-get-special (props)
+ "Extract an option, action, and default action string from text.
+The variables org-beamer-option, org-beamer-action, org-beamer-defaction,
+org-beamer-extra are all scoped into this function dynamically."
+ (let (tmp)
+ (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props))
+ (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
+ (when org-beamer-extra
+ (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra)))
+ (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props))
+ (when tmp
+ (setq tmp (copy-sequence tmp))
+ (if (string-match "\\[<[^][<>]*>\\]" tmp)
+ (setq org-beamer-defaction (match-string 0 tmp)
+ tmp (replace-match "" t t tmp)))
+ (if (string-match "\\[[^][]*\\]" tmp)
+ (setq org-beamer-option (match-string 0 tmp)
+ tmp (replace-match "" t t tmp)))
+ (if (string-match "<[^<>]*>" tmp)
+ (setq org-beamer-action (match-string 0 tmp)
+ tmp (replace-match "" t t tmp))))))
+
+(defun org-beamer-assoc-not-empty (elt list)
+ (let ((tmp (cdr (assoc elt list))))
+ (and tmp (string-match "\\S-" tmp) tmp)))
+
+
+(defvar org-beamer-mode-map (make-sparse-keymap)
+ "The keymap for `org-beamer-mode'.")
+(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
+
+(define-minor-mode org-beamer-mode
+ "Special support for editing Org-mode files made to export to beamer."
+ nil " Bm" nil)
+(when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords
+ 'org-mode
+ '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend))
+ 'prepent))
+
+(defun org-beamer-place-default-actions-for-lists ()
+ "Find default overlay specifications in items, and move them.
+The need to be after the begin statement of the environment."
+ (when org-beamer-export-is-beamer-p
+ (let (dovl)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t)
+ (if (setq dovl (cdr (assoc "BEAMER_dovl"
+ (get-text-property (match-end 0)
+ 'org-props))))
+ (save-excursion
+ (goto-char (1+ (match-end 1)))
+ (insert dovl)))))))
+
+(defun org-beamer-amend-header ()
+ "Add `org-beamer-header-extra' to the LaTeX header.
+If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line
+by itself, it will be replaced with `org-beamer-header-extra'. If not,
+the value will be inserted right after the documentclass statement."
+ (when (and org-beamer-export-is-beamer-p
+ org-beamer-header-extra)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward
+ "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t)
+ (replace-match org-beamer-header-extra t t)
+ (or (bolp) (insert "\n")))
+ ((re-search-forward "^[ \t]*\\\\begin{document}" nil t)
+ (beginning-of-line 1)
+ (insert org-beamer-header-extra)
+ (or (bolp) (insert "\n"))))))
+
+(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
+ "If this regexp matches in a frame, the frame is marked as fragile."
+ :group 'org-beamer
+ :version "24.1"
+ :type 'regexp)
+
+(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
+ "The special face for beamer tags."
+ :group 'org-beamer)
+
+
+;; Functions to initialize and post-process
+;; These functions will be hooked into various places in the export process
+
+(defun org-beamer-initialize-open-trackers ()
+ "Reset variables that track if certain environments are open during export."
+ (setq org-beamer-columns-open nil)
+ (setq org-beamer-column-open nil)
+ (setq org-beamer-inside-frame-at-level nil)
+ (setq org-beamer-export-is-beamer-p nil))
+
+(defun org-beamer-after-initial-vars ()
+ "Find special settings for beamer and store them.
+The effect is that these values will be accessible during export."
+ ;; First verify that we are exporting using the beamer class
+ (setq org-beamer-export-is-beamer-p
+ (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}"
+ org-export-latex-header))
+ (when org-beamer-export-is-beamer-p
+ ;; Find the frame level
+ (setq org-beamer-frame-level-now
+ (or (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (and (looking-at org-complex-heading-regexp)
+ (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (and (re-search-forward
+ "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t)
+ (match-string 1))))
+ (plist-get org-export-latex-options-plist :beamer-frame-level)
+ org-beamer-frame-level))
+ ;; Normalize the value so that the functions can trust the value
+ (cond
+ ((not org-beamer-frame-level-now)
+ (setq org-beamer-frame-level-now nil))
+ ((stringp org-beamer-frame-level-now)
+ (setq org-beamer-frame-level-now
+ (string-to-number org-beamer-frame-level-now))))
+ ;; Find the header additions, most likely theme commands
+ (setq org-beamer-header-extra
+ (or (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (and (looking-at org-complex-heading-regexp)
+ (org-entry-get nil "BEAMER_HEADER_EXTRA"
+ 'selective))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((txt ""))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$"
+ nil t)
+ (setq txt (concat txt "\n" (match-string 1))))
+ (if (> (length txt) 0) (substring txt 1)))))
+ (plist-get org-export-latex-options-plist
+ :beamer-header-extra)))
+ (let ((inhibit-read-only t)
+ (case-fold-search nil)
+ props)
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max) '(org-props nil))
+ (org-map-entries
+ '(progn
+ (setq props (org-entry-properties nil 'standard))
+ (if (and (not (assoc "BEAMER_env" props))
+ (looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
+ (push (cons "BEAMER_env" (match-string 1)) props))
+ (when (org-bound-and-true-p org-beamer-inherited-properties)
+ (mapc (lambda (p)
+ (unless (assoc p props)
+ (let ((v (org-entry-get nil p 'inherit)))
+ (and v (push (cons p v) props)))))
+ org-beamer-inherited-properties))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
+ (setq org-export-latex-options-plist
+ (plist-put org-export-latex-options-plist :tags nil))))))
+
+(defun org-beamer-auto-fragile-frames ()
+ "Mark any frames containing verbatim environments as fragile.
+This function will run in the final LaTeX document."
+ (when org-beamer-export-is-beamer-p
+ (let (opts)
+ (goto-char (point-min))
+ ;; Find something that might be fragile
+ (while (re-search-forward org-beamer-fragile-re nil t)
+ (save-excursion
+ ;; Are we inside a frame here?
+ (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?"
+ nil t)
+ (equal (match-string 1) "begin"))
+ ;; yes, inside a frame, make sure "fragile" is one of the options
+ (goto-char (match-end 0))
+ (if (not (looking-at "\\[.*?\\]"))
+ (insert "[fragile]")
+ (setq opts (substring (match-string 0) 1 -1))
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq opts (org-split-string opts ","))
+ (add-to-list 'opts "fragile")
+ (insert "[" (mapconcat 'identity opts ",") "]"))))))))
+
+(defcustom org-beamer-outline-frame-title "Outline"
+ "Default title of a frame containing an outline."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(string :tag "Outline frame title")
+ )
+
+(defcustom org-beamer-outline-frame-options nil
+ "Outline frame options appended after \\begin{frame}.
+You might want to put e.g. [allowframebreaks=0.9] here. Remember to
+include square brackets."
+ :group 'org-beamer
+ :version "24.1"
+ :type '(string :tag "Outline frame options")
+ )
+
+(defun org-beamer-fix-toc ()
+ "Fix the table of contents by removing the vspace line."
+ (when org-beamer-export-is-beamer-p
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)"
+ nil t)
+ (replace-match
+ (concat "\\\\begin{frame}" org-beamer-outline-frame-options
+ "\n\\\\frametitle{"
+ org-beamer-outline-frame-title
+ "}\n\\1\\\\end{frame}")
+ t nil)))))
+
+(defun org-beamer-property-changed (property value)
+ "Track the BEAMER_env property with tags."
+ (cond
+ ((equal property "BEAMER_env")
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((tags (org-get-tags)))
+ (setq tags (delq nil (mapcar (lambda (x)
+ (if (string-match "^B_" x) nil x))
+ tags)))
+ (org-set-tags-to tags))
+ (when (and value (stringp value) (string-match "\\S-" value))
+ (org-toggle-tag (concat "B_" value) 'on))))
+ ((equal property "BEAMER_col")
+ (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value))
+ 'on 'off)))))
+
+(defun org-beamer-select-beamer-code ()
+ "Take code marked for BEAMER and turn it into marked for LaTeX."
+ (when org-beamer-export-is-beamer-p
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t)
+ (replace-match "\\1latex"))))
+
+;; OK, hook all these functions into appropriate places
+(add-hook 'org-export-first-hook
+ 'org-beamer-initialize-open-trackers)
+(add-hook 'org-property-changed-functions
+ 'org-beamer-property-changed)
+(add-hook 'org-export-latex-after-initial-vars-hook
+ 'org-beamer-after-initial-vars)
+(add-hook 'org-export-latex-final-hook
+ 'org-beamer-place-default-actions-for-lists)
+(add-hook 'org-export-latex-final-hook
+ 'org-beamer-auto-fragile-frames)
+(add-hook 'org-export-latex-final-hook
+ 'org-beamer-fix-toc)
+(add-hook 'org-export-latex-final-hook
+ 'org-beamer-amend-header)
+(add-hook 'org-export-preprocess-before-selecting-backend-code-hook
+ 'org-beamer-select-beamer-code)
+
+(defun org-insert-beamer-options-template (&optional kind)
+ "Insert a settings template, to make sure users do this right."
+ (interactive (progn
+ (message "Current [s]ubtree or [g]lobal?")
+ (if (equal (read-char-exclusive) ?g)
+ (list 'global)
+ (list 'subtree))))
+ (if (eq kind 'subtree)
+ (progn
+ (org-back-to-heading t)
+ (org-reveal)
+ (org-entry-put nil "LaTeX_CLASS" "beamer")
+ (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]")
+ (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
+ (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string
+ org-beamer-frame-level))
+ (when org-beamer-themes
+ (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes))
+ (when org-beamer-column-view-format
+ (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
+ (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC"))
+ (insert "#+LaTeX_CLASS: beamer\n")
+ (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
+ (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n")
+ (when org-beamer-themes
+ (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n"))
+ (when org-beamer-column-view-format
+ (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
+ (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n")))
+
+
+(defun org-beamer-allowed-property-values (property)
+ "Supply allowed values for BEAMER properties."
+ (cond
+ ((and (equal property "BEAMER_env")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_env have been defined,
+ ;; supply all defined environments
+ (mapcar 'car (append org-beamer-environments-extra
+ org-beamer-environments-default)))
+ ((and (equal property "BEAMER_col")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_col have been defined,
+ ;; supply some
+ '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC"))
+ (t nil)))
+
+(add-hook 'org-property-allowed-value-functions
+ 'org-beamer-allowed-property-values)
+
+(provide 'org-beamer)
+
+;;; org-beamer.el ends here
diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el
new file mode 100644
index 0000000..f8e07ad
--- /dev/null
+++ b/lisp/org-bibtex.el
@@ -0,0 +1,687 @@
+;;; org-bibtex.el --- Org links to BibTeX entries
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;
+;; Authors: Bastien Guerry <bzg at altern dot org>
+;; Carsten Dominik <carsten dot dominik at gmail dot com>
+;; Eric Schulte <schulte dot eric at gmail dot com>
+;; Keywords: org, wp, remember
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; This file implements links to database entries in BibTeX files.
+;; Instead of defining a special link prefix, it uses the normal file
+;; links combined with a custom search mechanism to find entries
+;; by reference key. And it constructs a nice description tag for
+;; the link that contains the author name, the year and a short title.
+;;
+;; It also stores detailed information about the entry so that
+;; remember templates can access and enter this information easily.
+;;
+;; The available properties for each entry are listed here:
+;;
+;; :author :publisher :volume :pages
+;; :editor :url :number :journal
+;; :title :year :series :address
+;; :booktitle :month :annote :abstract
+;; :key :btype
+;;
+;; Here is an example of a remember template that use some of this
+;; information (:author :year :title :journal :pages):
+;;
+;; (setq org-remember-templates
+;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \
+;; In %:journal, %:pages.")))
+;;
+;; Let's say you want to remember this BibTeX entry:
+;;
+;; @Article{dolev83,
+;; author = {Danny Dolev and Andrew C. Yao},
+;; title = {On the security of public-key protocols},
+;; journal = {IEEE Transaction on Information Theory},
+;; year = 1983,
+;; volume = 2,
+;; number = 29,
+;; pages = {198--208},
+;; month = {Mars}
+;; }
+;;
+;; M-x `org-remember' on this entry will produce this buffer:
+;;
+;; =====================================================================
+;; * READ <== [point here]
+;;
+;; [[file:file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]]
+;;
+;; Danny Dolev and Andrew C. Yao (1983): On the security of public-key protocols
+;; In IEEE Transaction on Information Theory, 198--208.
+;; =====================================================================
+;;
+;; Additionally, the following functions are now available for storing
+;; bibtex entries within Org-mode documents.
+;;
+;; - Run `org-bibtex' to export the current file to a .bib.
+;;
+;; - Run `org-bibtex-check' or `org-bibtex-check-all' to check and
+;; fill in missing field of either the current, or all headlines
+;;
+;; - Run `org-bibtex-create' to add a bibtex entry
+;;
+;; - Use `org-bibtex-read' to read a bibtex entry after `point' or in
+;; the active region, then call `org-bibtex-write' in a .org file to
+;; insert a heading for the read bibtex entry
+;;
+;; - All Bibtex information is taken from the document compiled by
+;; Andrew Roberts from the Bibtex manual, available at
+;; http://www.andy-roberts.net/misc/latex/sessions/bibtex/bibentries.pdf
+;;
+;;; History:
+;;
+;; The link creation part has been part of Org-mode for a long time.
+;;
+;; Creating better remember template information was inspired by a request
+;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
+;; and then implemented by Bastien Guerry.
+;;
+;; Eric Schulte eventually added the functions for translating between
+;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex
+;; fields of existing Org-mode headlines.
+;;
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+(require 'bibtex)
+(eval-when-compile
+ (require 'cl))
+(require 'org-compat)
+
+(defvar org-bibtex-description nil) ; dynamically scoped from org.el
+(defvar org-id-locations)
+
+(declare-function bibtex-beginning-of-entry "bibtex" ())
+(declare-function bibtex-generate-autokey "bibtex" ())
+(declare-function bibtex-parse-entry "bibtex" (&optional content))
+(declare-function bibtex-url "bibtex" (&optional pos no-browse))
+(declare-function longlines-mode "longlines" (&optional arg))
+(declare-function org-babel-trim "ob" (string &optional regexp))
+
+
+;;; Bibtex data
+(defvar org-bibtex-types
+ '((:article
+ (:description . "An article from a journal or magazine")
+ (:required :author :title :journal :year)
+ (:optional :volume :number :pages :month :note))
+ (:book
+ (:description . "A book with an explicit publisher")
+ (:required (:editor :author) :title :publisher :year)
+ (:optional (:volume :number) :series :address :edition :month :note))
+ (:booklet
+ (:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.")
+ (:required :title)
+ (:optional :author :howpublished :address :month :year :note))
+ (:conference
+ (:description . "")
+ (:required :author :title :booktitle :year)
+ (:optional :editor :pages :organization :publisher :address :month :note))
+ (:inbook
+ (:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.")
+ (:required (:author :editor) :title (:chapter :pages) :publisher :year)
+ (:optional :crossref (:volume :number) :series :type :address :edition :month :note))
+ (:incollection
+ (:description . "A part of a book having its own title.")
+ (:required :author :title :booktitle :publisher :year)
+ (:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note))
+ (:inproceedings
+ (:description . "An article in a conference proceedings")
+ (:required :author :title :booktitle :year)
+ (:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note))
+ (:manual
+ (:description . "Technical documentation.")
+ (:required :title)
+ (:optional :author :organization :address :edition :month :year :note))
+ (:mastersthesis
+ (:description . "A Master’s thesis.")
+ (:required :author :title :school :year)
+ (:optional :type :address :month :note))
+ (:misc
+ (:description . "Use this type when nothing else fits.")
+ (:required)
+ (:optional :author :title :howpublished :month :year :note))
+ (:phdthesis
+ (:description . "A PhD thesis.")
+ (:required :author :title :school :year)
+ (:optional :type :address :month :note))
+ (:proceedings
+ (:description . "The proceedings of a conference.")
+ (:required :title :year)
+ (:optional :editor (:volume :number) :series :address :month :organization :publisher :note))
+ (:techreport
+ (:description . "A report published by a school or other institution.")
+ (:required :author :title :institution :year)
+ (:optional :type :address :month :note))
+ (:unpublished
+ (:description . "A document having an author and title, but not formally published.")
+ (:required :author :title :note)
+ (:optional :month :year)))
+ "Bibtex entry types with required and optional parameters.")
+
+(defvar org-bibtex-fields
+ '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.")
+ (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.")
+ (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.")
+ (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.")
+ (:chapter . "A chapter (or section or whatever) number.")
+ (:crossref . "The database key of the entry being cross referenced.")
+ (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.")
+ (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.")
+ (:howpublished . "How something strange has been published. The first word should be capitalized.")
+ (:institution . "The sponsoring institution of a technical report.")
+ (:journal . "A journal name.")
+ (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
+ (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
+ (:note . "Any additional information that can help the reader. The first word should be capitalized.")
+ (:number . "Any additional information that can help the reader. The first word should be capitalized.")
+ (:organization . "The organization that sponsors a conference or that publishes a manual.")
+ (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
+ (:publisher . "The publisher’s name.")
+ (:school . "The name of the school where a thesis was written.")
+ (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
+ (:title . "The work’s title, typed as explained in the LaTeX book.")
+ (:type . "The type of a technical report for example, 'Research Note'.")
+ (:volume . "The volume of a journal or multi-volume book.")
+ (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'"))
+ "Bibtex fields with descriptions.")
+
+(defvar org-bibtex-entries nil
+ "List to hold parsed bibtex entries.")
+
+(defcustom org-bibtex-autogen-keys nil
+ "Set to a truth value to use `bibtex-generate-autokey' to generate keys."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-bibtex-prefix nil
+ "Optional prefix for all bibtex property names.
+For example setting to 'BIB_' would allow interoperability with fireforg."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-bibtex-treat-headline-as-title t
+ "Treat headline text as title if title property is absent.
+If an entry is missing a title property, use the headline text as
+the property. If this value is t, `org-bibtex-check' will ignore
+a missing title field."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-bibtex-export-arbitrary-fields nil
+ "When converting to bibtex allow fields not defined in `org-bibtex-fields'.
+This only has effect if `org-bibtex-prefix' is defined, so as to
+ensure that other org-properties, such as CATEGORY or LOGGING are
+not placed in the exported bibtex entry."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-bibtex-key-property "CUSTOM_ID"
+ "Property that holds the bibtex key.
+By default, this is CUSTOM_ID, which enables easy linking to
+bibtex headlines from within an org file. This can be set to ID
+to enable global links, but only with great caution, as global
+IDs must be unique."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-bibtex-tags nil
+ "List of tag(s) that should be added to new bib entries."
+ :group 'org-bibtex
+ :version "24.1"
+ :type '(repeat :tag "Tag" (string)))
+
+(defcustom org-bibtex-tags-are-keywords nil
+ "Convert the value of the keywords field to tags and vice versa.
+If set to t, comma-separated entries in a bibtex entry's keywords
+field will be converted to org tags. Note: spaces will be escaped
+with underscores, and characters that are not permitted in org
+tags will be removed.
+
+If t, local tags in an org entry will be exported as a
+comma-separated string of keywords when exported to bibtex. Tags
+defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
+not be exported."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-bibtex-no-export-tags nil
+ "List of tag(s) that should not be converted to keywords.
+This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
+ :group 'org-bibtex
+ :version "24.1"
+ :type '(repeat :tag "Tag" (string)))
+
+(defcustom org-bibtex-type-property-name "btype"
+ "Property in which to store bibtex entry type (e.g., article)."
+ :group 'org-bibtex
+ :version "24.1"
+ :type 'string)
+
+
+;;; Utility functions
+(defun org-bibtex-get (property)
+ ((lambda (it) (when it (org-babel-trim it)))
+ (let ((org-special-properties
+ (delete "FILE" (copy-sequence org-special-properties))))
+ (or
+ (org-entry-get (point) (upcase property))
+ (org-entry-get (point) (concat org-bibtex-prefix (upcase property)))))))
+
+(defun org-bibtex-put (property value)
+ (let ((prop (upcase (if (keywordp property)
+ (substring (symbol-name property) 1)
+ property))))
+ (org-set-property
+ (concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix)
+ prop)
+ value)))
+
+(defun org-bibtex-headline ()
+ "Return a bibtex entry of the given headline as a string."
+ (let* ((val (lambda (key lst) (cdr (assoc key lst))))
+ (to (lambda (string) (intern (concat ":" string))))
+ (from (lambda (key) (substring (symbol-name key) 1)))
+ flatten ; silent compiler warning
+ (flatten (lambda (&rest lsts)
+ (apply #'append (mapcar
+ (lambda (e)
+ (if (listp e) (apply flatten e) (list e)))
+ lsts))))
+ (notes (buffer-string))
+ (id (org-bibtex-get org-bibtex-key-property))
+ (type (org-bibtex-get org-bibtex-type-property-name))
+ (tags (when org-bibtex-tags-are-keywords
+ (delq nil
+ (mapcar
+ (lambda (tag)
+ (unless (member tag
+ (append org-bibtex-tags
+ org-bibtex-no-export-tags))
+ tag))
+ (org-get-local-tags-at))))))
+ (when type
+ (let ((entry (format
+ "@%s{%s,\n%s\n}\n" type id
+ (mapconcat
+ (lambda (pair)
+ (format " %s={%s}" (car pair) (cdr pair)))
+ (remove nil
+ (if (and org-bibtex-export-arbitrary-fields
+ org-bibtex-prefix)
+ (mapcar
+ (lambda (kv)
+ (let ((key (car kv)) (val0 (cdr kv)))
+ (when (and
+ (string-match org-bibtex-prefix key)
+ (not (string=
+ (downcase (concat org-bibtex-prefix
+ org-bibtex-type-property-name))
+ (downcase key))))
+ (cons (downcase (replace-regexp-in-string
+ org-bibtex-prefix "" key))
+ val0))))
+ (org-entry-properties nil 'standard))
+ (mapcar
+ (lambda (field)
+ (let ((value (or (org-bibtex-get (funcall from field))
+ (and (equal :title field)
+ (nth 4 (org-heading-components))))))
+ (when value (cons (funcall from field) value))))
+ (funcall flatten
+ (funcall val :required (funcall val (funcall to type) org-bibtex-types))
+ (funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))
+ ",\n"))))
+ (with-temp-buffer
+ (insert entry)
+ (when tags
+ (bibtex-beginning-of-entry)
+ (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
+ (progn (goto-char (match-end 1)) (insert ", "))
+ (bibtex-make-field "keywords" t t))
+ (insert (mapconcat #'identity tags ", ")))
+ (buffer-string))))))
+
+(defun org-bibtex-ask (field)
+ (unless (assoc field org-bibtex-fields)
+ (error "Field:%s is not known" field))
+ (save-window-excursion
+ (let* ((name (substring (symbol-name field) 1))
+ (buf-name (format "*Bibtex Help %s*" name)))
+ (with-output-to-temp-buffer buf-name
+ (princ (cdr (assoc field org-bibtex-fields))))
+ (with-current-buffer buf-name (longlines-mode t))
+ (org-fit-window-to-buffer (get-buffer-window buf-name))
+ ((lambda (result) (when (> (length result) 0) result))
+ (read-from-minibuffer (format "%s: " name))))))
+
+(defun org-bibtex-autokey ()
+ "Generate an autokey for the current headline."
+ (org-bibtex-put org-bibtex-key-property
+ (if org-bibtex-autogen-keys
+ (let* ((entry (org-bibtex-headline))
+ (key
+ (with-temp-buffer
+ (insert entry)
+ (bibtex-generate-autokey))))
+ ;; test for duplicate IDs if using global ID
+ (when (and
+ (equal org-bibtex-key-property "ID")
+ (featurep 'org-id)
+ (hash-table-p org-id-locations)
+ (gethash key org-id-locations))
+ (warn "Another entry has the same ID"))
+ key)
+ (read-from-minibuffer "id: "))))
+
+(defun org-bibtex-fleshout (type &optional optional)
+ "Fleshout current heading, ensuring all required fields are present.
+With optional argument OPTIONAL, also prompt for optional fields."
+ (let ((val (lambda (key lst) (cdr (assoc key lst))))
+ (keyword (lambda (name) (intern (concat ":" (downcase name)))))
+ (name (lambda (keyword) (substring (symbol-name keyword) 1))))
+ (dolist (field (append
+ (if org-bibtex-treat-headline-as-title
+ (remove :title (funcall val :required (funcall val type org-bibtex-types)))
+ (funcall val :required (funcall val type org-bibtex-types)))
+ (when optional (funcall val :optional (funcall val type org-bibtex-types)))))
+ (when (consp field) ; or'd pair of fields e.g., (:editor :author)
+ (let ((present (first (remove
+ nil
+ (mapcar
+ (lambda (f) (when (org-bibtex-get (funcall name f)) f))
+ field)))))
+ (setf field (or present (funcall keyword
+ (org-icompleting-read
+ "Field: " (mapcar name field)))))))
+ (let ((name (funcall name field)))
+ (unless (org-bibtex-get name)
+ (let ((prop (org-bibtex-ask field)))
+ (when prop (org-bibtex-put name prop)))))))
+ (when (and type (assoc type org-bibtex-types)
+ (not (org-bibtex-get org-bibtex-key-property)))
+ (org-bibtex-autokey)))
+
+
+;;; Bibtex link functions
+(org-add-link-type "bibtex" 'org-bibtex-open)
+(add-hook 'org-store-link-functions 'org-bibtex-store-link)
+
+(defun org-bibtex-open (path)
+ "Visit the bibliography entry on PATH."
+ (let* ((search (when (string-match "::\\(.+\\)\\'" path)
+ (match-string 1 path)))
+ (path (substring path 0 (match-beginning 0))))
+ (org-open-file path t nil search)))
+
+(defun org-bibtex-store-link ()
+ "Store a link to a BibTeX entry."
+ (when (eq major-mode 'bibtex-mode)
+ (let* ((search (org-create-file-search-in-bibtex))
+ (link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (entry (mapcar ; repair strings enclosed in "..." or {...}
+ (lambda(c)
+ (if (string-match
+ "^\\(?:{\\|\"\\)\\(.*\\)\\(?:}\\|\"\\)$" (cdr c))
+ (cons (car c) (match-string 1 (cdr c))) c))
+ (save-excursion
+ (bibtex-beginning-of-entry)
+ (bibtex-parse-entry)))))
+ (org-store-link-props
+ :key (cdr (assoc "=key=" entry))
+ :author (or (cdr (assoc "author" entry)) "[no author]")
+ :editor (or (cdr (assoc "editor" entry)) "[no editor]")
+ :title (or (cdr (assoc "title" entry)) "[no title]")
+ :booktitle (or (cdr (assoc "booktitle" entry)) "[no booktitle]")
+ :journal (or (cdr (assoc "journal" entry)) "[no journal]")
+ :publisher (or (cdr (assoc "publisher" entry)) "[no publisher]")
+ :pages (or (cdr (assoc "pages" entry)) "[no pages]")
+ :url (or (cdr (assoc "url" entry)) "[no url]")
+ :year (or (cdr (assoc "year" entry)) "[no year]")
+ :month (or (cdr (assoc "month" entry)) "[no month]")
+ :address (or (cdr (assoc "address" entry)) "[no address]")
+ :volume (or (cdr (assoc "volume" entry)) "[no volume]")
+ :number (or (cdr (assoc "number" entry)) "[no number]")
+ :annote (or (cdr (assoc "annote" entry)) "[no annotation]")
+ :series (or (cdr (assoc "series" entry)) "[no series]")
+ :abstract (or (cdr (assoc "abstract" entry)) "[no abstract]")
+ :btype (or (cdr (assoc "=type=" entry)) "[no type]")
+ :type "bibtex"
+ :link link
+ :description org-bibtex-description))))
+
+(defun org-create-file-search-in-bibtex ()
+ "Create the search string and description for a BibTeX database entry."
+ ;; Make a good description for this entry, using names, year and the title
+ ;; Put it into the `description' variable which is dynamically scoped.
+ (let ((bibtex-autokey-names 1)
+ (bibtex-autokey-names-stretch 1)
+ (bibtex-autokey-name-case-convert-function 'identity)
+ (bibtex-autokey-name-separator " & ")
+ (bibtex-autokey-additional-names " et al.")
+ (bibtex-autokey-year-length 4)
+ (bibtex-autokey-name-year-separator " ")
+ (bibtex-autokey-titlewords 3)
+ (bibtex-autokey-titleword-separator " ")
+ (bibtex-autokey-titleword-case-convert-function 'identity)
+ (bibtex-autokey-titleword-length 'infty)
+ (bibtex-autokey-year-title-separator ": "))
+ (setq org-bibtex-description (bibtex-generate-autokey)))
+ ;; Now parse the entry, get the key and return it.
+ (save-excursion
+ (bibtex-beginning-of-entry)
+ (cdr (assoc "=key=" (bibtex-parse-entry)))))
+
+(defun org-execute-file-search-in-bibtex (s)
+ "Find the link search string S as a key for a database entry."
+ (when (eq major-mode 'bibtex-mode)
+ ;; Yes, we want to do the search in this file.
+ ;; We construct a regexp that searches for "@entrytype{" followed by the key
+ (goto-char (point-min))
+ (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*"
+ (regexp-quote s) "[ \t\n]*,") nil t)
+ (goto-char (match-beginning 0)))
+ (if (and (match-beginning 0) (equal current-prefix-arg '(16)))
+ ;; Use double prefix to indicate that any web link should be browsed
+ (let ((b (current-buffer)) (p (point)))
+ ;; Restore the window configuration because we just use the web link
+ (set-window-configuration org-window-config-before-follow-link)
+ (with-current-buffer b
+ (goto-char p)
+ (bibtex-url)))
+ (recenter 0)) ; Move entry start to beginning of window
+ ;; return t to indicate that the search is done.
+ t))
+
+;; Finally add the link search function to the right hook.
+(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
+
+
+;;; Bibtex <-> Org-mode headline translation functions
+(defun org-bibtex (&optional filename)
+ "Export each headline in the current file to a bibtex entry.
+Headlines are exported using `org-bibtex-export-headline'."
+ (interactive
+ (list (read-file-name
+ "Bibtex file: " nil nil nil
+ (file-name-nondirectory
+ (concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
+ ((lambda (error-point)
+ (when error-point
+ (goto-char error-point)
+ (message "Bibtex error at %S" (nth 4 (org-heading-components)))))
+ (catch 'bib
+ (let ((bibtex-entries (remove nil (org-map-entries
+ (lambda ()
+ (condition-case foo
+ (org-bibtex-headline)
+ (error (throw 'bib (point)))))))))
+ (with-temp-file filename
+ (insert (mapconcat #'identity bibtex-entries "\n")))
+ (message "Successfully exported %d BibTeX entries to %s"
+ (length bibtex-entries) filename) nil))))
+
+(defun org-bibtex-check (&optional optional)
+ "Check the current headline for required fields.
+With prefix argument OPTIONAL also prompt for optional fields."
+ (interactive "P")
+ (save-restriction
+ (org-narrow-to-subtree)
+ (let ((type ((lambda (name) (when name (intern (concat ":" name))))
+ (org-bibtex-get org-bibtex-type-property-name))))
+ (when type (org-bibtex-fleshout type optional)))))
+
+(defun org-bibtex-check-all (&optional optional)
+ "Check all headlines in the current file.
+With prefix argument OPTIONAL also prompt for optional fields."
+ (interactive) (org-map-entries (lambda () (org-bibtex-check optional))))
+
+(defun org-bibtex-create (&optional arg nonew)
+ "Create a new entry at the given level.
+With a prefix arg, query for optional fields as well.
+If nonew is t, add data to the headline of the entry at point."
+ (interactive "P")
+ (let* ((type (org-icompleting-read
+ "Type: " (mapcar (lambda (type)
+ (substring (symbol-name (car type)) 1))
+ org-bibtex-types)
+ nil nil (when nonew
+ (org-bibtex-get org-bibtex-type-property-name))))
+ (type (if (keywordp type) type (intern (concat ":" type))))
+ (org-bibtex-treat-headline-as-title (if nonew nil t)))
+ (unless (assoc type org-bibtex-types)
+ (error "Type:%s is not known" type))
+ (if nonew
+ (org-back-to-heading)
+ (org-insert-heading)
+ (let ((title (org-bibtex-ask :title)))
+ (insert title)
+ (org-bibtex-put "TITLE" title)))
+ (org-bibtex-put org-bibtex-type-property-name
+ (substring (symbol-name type) 1))
+ (org-bibtex-fleshout type arg)
+ (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
+
+(defun org-bibtex-create-in-current-entry (&optional arg)
+ "Add bibliographical data to the current entry.
+With a prefix arg, query for optional fields."
+ (interactive "P")
+ (org-bibtex-create arg t))
+
+(defun org-bibtex-read ()
+ "Read a bibtex entry and save to `org-bibtex-entries'.
+This uses `bibtex-parse-entry'."
+ (interactive)
+ (let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
+ (clean-space (lambda (str) (replace-regexp-in-string
+ "[[:space:]\n\r]+" " " str)))
+ (strip-delim
+ (lambda (str) ; strip enclosing "..." and {...}
+ (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
+ (when (and (= (aref str 0) (car pair))
+ (= (aref str (1- (length str))) (cdr pair)))
+ (setf str (substring str 1 (1- (length str)))))) str)))
+ (push (mapcar
+ (lambda (pair)
+ (cons (let ((field (funcall keyword (car pair))))
+ (case field
+ (:=type= :type)
+ (:=key= :key)
+ (otherwise field)))
+ (funcall clean-space (funcall strip-delim (cdr pair)))))
+ (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
+ org-bibtex-entries)))
+
+(defun org-bibtex-write ()
+ "Insert a heading built from the first element of `org-bibtex-entries'."
+ (interactive)
+ (when (= (length org-bibtex-entries) 0)
+ (error "No entries in `org-bibtex-entries'"))
+ (let* ((entry (pop org-bibtex-entries))
+ (org-special-properties nil) ; avoids errors with `org-entry-put'
+ (val (lambda (field) (cdr (assoc field entry))))
+ (togtag (lambda (tag) (org-toggle-tag tag 'on))))
+ (org-insert-heading)
+ (insert (funcall val :title))
+ (org-bibtex-put "TITLE" (funcall val :title))
+ (org-bibtex-put org-bibtex-type-property-name
+ (downcase (funcall val :type)))
+ (dolist (pair entry)
+ (case (car pair)
+ (:title nil)
+ (:type nil)
+ (:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
+ (:keywords (if org-bibtex-tags-are-keywords
+ (mapc
+ (lambda (kw)
+ (funcall
+ togtag
+ (replace-regexp-in-string
+ "[^[:alnum:]_@#%]" ""
+ (replace-regexp-in-string "[ \t]+" "_" kw))))
+ (split-string (cdr pair) ", *"))
+ (org-bibtex-put (car pair) (cdr pair))))
+ (otherwise (org-bibtex-put (car pair) (cdr pair)))))
+ (mapc togtag org-bibtex-tags)))
+
+(defun org-bibtex-yank ()
+ "If kill ring holds a bibtex entry yank it as an Org-mode headline."
+ (interactive)
+ (let (entry)
+ (with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
+ (if entry
+ (org-bibtex-write)
+ (error "Yanked text does not appear to contain a BibTeX entry"))))
+
+(defun org-bibtex-export-to-kill-ring ()
+ "Export current headline to kill ring as bibtex entry."
+ (interactive)
+ (let ((result (org-bibtex-headline)))
+ (kill-new result) result))
+
+(defun org-bibtex-search (string)
+ "Search for bibliographical entries in agenda files.
+This function relies `org-search-view' to locate results."
+ (interactive "sSearch string: ")
+ (let ((org-agenda-overriding-header "Bib search results:")
+ (org-agenda-search-view-always-boolean t))
+ (org-search-view nil
+ (format "%s +{:%s%s:}"
+ string org-bibtex-prefix
+ org-bibtex-type-property-name))))
+
+(provide 'org-bibtex)
+
+;;; org-bibtex.el ends here
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
new file mode 100644
index 0000000..9d20814
--- /dev/null
+++ b/lisp/org-capture.el
@@ -0,0 +1,1683 @@
+;;; org-capture.el --- Fast note taking in Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains an alternative implementation of the same functionality
+;; that is also provided by org-remember.el. The implementation is more
+;; streamlined, can produce more target types (e.g. plain list items or
+;; table lines). Also, it does not use a temporary buffer for editing
+;; the captured entry - instead it uses an indirect buffer that visits
+;; the new entry already in the target buffer (this was an idea by Samuel
+;; Wales). John Wiegley's excellent `remember.el' is not needed for this
+;; implementation, even though we borrow heavily from its ideas.
+
+;; This implementation heavily draws on ideas by James TD Smith and
+;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration.
+
+;;; TODO
+
+;; - find a clever way to not always insert an annotation maybe a
+;; predicate function that can check for conditions for %a to be
+;; used. This could be one of the properties.
+
+;; - Should there be plist members that arrange for properties to be
+;; asked for, like James proposed in his RFC?
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org)
+(require 'org-mks)
+
+(declare-function org-datetree-find-date-create "org-datetree"
+ (date &optional keep-restriction))
+(declare-function org-table-get-specials "org-table" ())
+(declare-function org-table-goto-line "org-table" (N))
+(declare-function org-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
+(declare-function org-at-encrypted-entry-p "org-crypt" ())
+(declare-function org-encrypt-entry "org-crypt" ())
+(declare-function org-decrypt-entry "org-crypt" ())
+
+(defvar org-remember-default-headline)
+(defvar org-remember-templates)
+(defvar org-table-hlines)
+(defvar dired-buffers)
+
+(defvar org-capture-clock-was-started nil
+ "Internal flag, noting if the clock was started.")
+
+(defvar org-capture-last-stored-marker (make-marker)
+ "Marker pointing to the entry most recently stored with `org-capture'.")
+
+;; The following variable is scoped dynamically by org-protocol
+;; to indicate that the link properties have already been stored
+(defvar org-capture-link-is-already-stored nil)
+
+(defgroup org-capture nil
+ "Options concerning capturing new entries."
+ :tag "Org Capture"
+ :group 'org)
+
+(defcustom org-capture-templates nil
+ "Templates for the creation of new entries.
+
+Each entry is a list with the following items:
+
+keys The keys that will select the template, as a string, characters
+ only, for example \"a\" for a template to be selected with a
+ single key, or \"bt\" for selection with two keys. When using
+ several keys, keys using the same prefix key must be together
+ in the list and preceded by a 2-element entry explaining the
+ prefix key, for example
+
+ (\"b\" \"Templates for marking stuff to buy\")
+
+ The \"C\" key is used by default for quick access to the
+ customization of the template variable. But if you want to use
+ that key for a template, you can.
+
+description A short string describing the template, will be shown during
+ selection.
+
+type The type of entry. Valid types are:
+ entry an Org-mode node, with a headline. Will be
+ filed as the child of the target entry or as
+ a top-level entry.
+ item a plain list item, will be placed in the
+ first plain list at the target
+ location.
+ checkitem a checkbox item. This differs from the
+ plain list item only is so far as it uses a
+ different default template.
+ table-line a new line in the first table at target location.
+ plain text to be inserted as it is.
+
+target Specification of where the captured item should be placed.
+ In Org-mode files, targets usually define a node. Entries will
+ become children of this node, other types will be added to the
+ table or list in the body of this node.
+
+ Most target specifications contain a file name. If that file
+ name is the empty string, it defaults to `org-default-notes-file'.
+ A file can also be given as a variable, function, or Emacs Lisp
+ form.
+
+ Valid values are:
+
+ (file \"path/to/file\")
+ Text will be placed at the beginning or end of that file
+
+ (id \"id of existing org entry\")
+ File as child of this entry, or in the body of the entry
+
+ (file+headline \"path/to/file\" \"node headline\")
+ Fast configuration if the target heading is unique in the file
+
+ (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
+ For non-unique headings, the full path is safer
+
+ (file+regexp \"path/to/file\" \"regexp to find location\")
+ File to the entry matching regexp
+
+ (file+datetree \"path/to/file\")
+ Will create a heading in a date tree for today's date
+
+ (file+datetree+prompt \"path/to/file\")
+ Will create a heading in a date tree, prompts for date
+
+ (file+function \"path/to/file\" function-finding-location)
+ A function to find the right location in the file
+
+ (clock)
+ File to the entry that is currently being clocked
+
+ (function function-finding-location)
+ Most general way, write your own function to find both
+ file and location
+
+template The template for creating the capture item. If you leave this
+ empty, an appropriate default template will be used. See below
+ for more details. Instead of a string, this may also be one of
+
+ (file \"/path/to/template-file\")
+ (function function-returning-the-template)
+
+ in order to get a template from a file, or dynamically
+ from a function.
+
+The rest of the entry is a property list of additional options. Recognized
+properties are:
+
+ :prepend Normally newly captured information will be appended at
+ the target location (last child, last table line,
+ last list item...). Setting this property will
+ change that.
+
+ :immediate-finish When set, do not offer to edit the information, just
+ file it away immediately. This makes sense if the
+ template only needs information that can be added
+ automatically.
+
+ :empty-lines Set this to the number of lines the should be inserted
+ before and after the new item. Default 0, only common
+ other value is 1.
+
+ :empty-lines-before Set this to the number of lines the should be inserted
+ before the new item. Overrides :empty-lines for the
+ number lines inserted before.
+
+ :empty-lines-after Set this to the number of lines the should be inserted
+ after the new item. Overrides :empty-lines for the
+ number of lines inserted after.
+
+ :clock-in Start the clock in this item.
+
+ :clock-keep Keep the clock running when filing the captured entry.
+
+ :clock-resume Start the interrupted clock when finishing the capture.
+ Note that :clock-keep has precedence over :clock-resume.
+ When setting both to `t', the current clock will run and
+ the previous one will not be resumed.
+
+ :unnarrowed Do not narrow the target buffer, simply show the
+ full buffer. Default is to narrow it so that you
+ only see the new stuff.
+
+ :table-line-pos Specification of the location in the table where the
+ new line should be inserted. It should be a string like
+ \"II-3\", meaning that the new line should become the
+ third line before the second horizontal separator line.
+
+ :kill-buffer If the target file was not yet visited by a buffer when
+ capture was invoked, kill the buffer again after capture
+ is finalized.
+
+The template defines the text to be inserted. Often this is an
+org-mode entry (so the first line should start with a star) that
+will be filed as a child of the target headline. It can also be
+freely formatted text. Furthermore, the following %-escapes will
+be replaced with content and expanded in this order:
+
+ %[pathname] Insert the contents of the file given by `pathname'.
+ %(sexp) Evaluate elisp `(sexp)' and replace with the result.
+ %<...> The result of format-time-string on the ... format specification.
+ %t Time stamp, date only.
+ %T Time stamp with date and time.
+ %u, %U Like the above, but inactive time stamps.
+ %i Initial content, copied from the active region. If %i is
+ indented, the entire inserted text will be indented as well.
+ %a Annotation, normally the link created with `org-store-link'.
+ %A Like %a, but prompt for the description part.
+ %l Like %a, but only insert the literal link.
+ %c Current kill ring head.
+ %x Content of the X clipboard.
+ %k Title of currently clocked task.
+ %K Link to currently clocked task.
+ %n User name (taken from `user-full-name').
+ %f File visited by current buffer when org-capture was called.
+ %F Full path of the file or directory visited by current buffer.
+ %:keyword Specific information for certain link types, see below.
+ %^g Prompt for tags, with completion on tags in target file.
+ %^G Prompt for tags, with completion on all tags in all agenda files.
+ %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
+ You may define a prompt like: %^{Please specify birthday}t
+ %^C Interactive selection of which kill or clip to use.
+ %^L Like %^C, but insert as link.
+ %^{prop}p Prompt the user for a value for property `prop'.
+ %^{prompt} Prompt the user for a string and replace this sequence with it.
+ A default value and a completion table ca be specified like this:
+ %^{prompt|default|completion2|completion3|...}.
+ %? After completing the template, position cursor here.
+ %\\n Insert the text entered at the nth %^{prompt}, where `n' is
+ a number, starting from 1.
+
+Apart from these general escapes, you can access information specific to
+the link type that is created. For example, calling `org-capture' in emails
+or in Gnus will record the author and the subject of the message, which you
+can access with \"%:from\" and \"%:subject\", respectively. Here is a
+complete list of what is recorded for each link type.
+
+Link type | Available information
+------------------------+------------------------------------------------------
+bbdb | %:type %:name %:company
+vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
+gnus | %:from %:fromname %:fromaddress
+ | %:to %:toname %:toaddress
+ | %:fromto (either \"to NAME\" or \"from NAME\")
+ | %:date %:date-timestamp (as active timestamp)
+ | %:date-timestamp-inactive (as inactive timestamp)
+gnus | %:group, for messages also all email fields
+w3, w3m | %:type %:url
+info | %:type %:file %:node
+calendar | %:type %:date"
+ :group 'org-capture
+ :version "24.1"
+ :type
+ '(repeat
+ (choice :value ("" "" entry (file "~/org/notes.org") "")
+ (list :tag "Multikey description"
+ (string :tag "Keys ")
+ (string :tag "Description"))
+ (list :tag "Template entry"
+ (string :tag "Keys ")
+ (string :tag "Description ")
+ (choice :tag "Capture Type " :value entry
+ (const :tag "Org entry" entry)
+ (const :tag "Plain list item" item)
+ (const :tag "Checkbox item" checkitem)
+ (const :tag "Plain text" plain)
+ (const :tag "Table line" table-line))
+ (choice :tag "Target location"
+ (list :tag "File"
+ (const :format "" file)
+ (file :tag " File"))
+ (list :tag "ID"
+ (const :format "" id)
+ (string :tag " ID"))
+ (list :tag "File & Headline"
+ (const :format "" file+headline)
+ (file :tag " File ")
+ (string :tag " Headline"))
+ (list :tag "File & Outline path"
+ (const :format "" file+olp)
+ (file :tag " File ")
+ (repeat :tag "Outline path" :inline t
+ (string :tag "Headline")))
+ (list :tag "File & Regexp"
+ (const :format "" file+regexp)
+ (file :tag " File ")
+ (regexp :tag " Regexp"))
+ (list :tag "File & Date tree"
+ (const :format "" file+datetree)
+ (file :tag " File"))
+ (list :tag "File & Date tree, prompt for date"
+ (const :format "" file+datetree+prompt)
+ (file :tag " File"))
+ (list :tag "File & function"
+ (const :format "" file+function)
+ (file :tag " File ")
+ (sexp :tag " Function"))
+ (list :tag "Current clocking task"
+ (const :format "" clock))
+ (list :tag "Function"
+ (const :format "" function)
+ (sexp :tag " Function")))
+ (choice :tag "Template"
+ (string)
+ (list :tag "File"
+ (const :format "" file)
+ (file :tag "Template file"))
+ (list :tag "Function"
+ (const :format "" function)
+ (function :tag "Template function")))
+ (plist :inline t
+ ;; Give the most common options as checkboxes
+ :options (((const :format "%v " :prepend) (const t))
+ ((const :format "%v " :immediate-finish) (const t))
+ ((const :format "%v " :empty-lines) (const 1))
+ ((const :format "%v " :clock-in) (const t))
+ ((const :format "%v " :clock-keep) (const t))
+ ((const :format "%v " :clock-resume) (const t))
+ ((const :format "%v " :unnarrowed) (const t))
+ ((const :format "%v " :kill-buffer) (const t))))))))
+
+(defcustom org-capture-before-finalize-hook nil
+ "Hook that is run right before a capture process is finalized.
+The capture buffer is still current when this hook runs and it is
+widened to the entire buffer."
+ :group 'org-capture
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-capture-after-finalize-hook nil
+ "Hook that is run right after a capture process is finalized.
+Suitable for window cleanup."
+ :group 'org-capture
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-capture-prepare-finalize-hook nil
+ "Hook that is run before the finalization starts.
+The capture buffer is current and still narrowed."
+ :group 'org-capture
+ :version "24.1"
+ :type 'hook)
+
+(defcustom org-capture-bookmark t
+ "When non-nil, add a bookmark pointing at the last stored
+position when capturing."
+ :group 'org-capture
+ :version "24.3"
+ :type 'boolean)
+
+;;; The property list for keeping information about the capture process
+
+(defvar org-capture-plist nil
+ "Plist for the current capture process, global, to avoid having to pass it.")
+
+(defvar org-capture-current-plist nil
+ "Local variable holding the plist in a capture buffer.
+This is used to store the plist for use when finishing a capture process
+because another such process might have changed the global variable by then.
+
+Each time a new capture buffer has been set up, the global `org-capture-plist'
+is copied to this variable, which is local in the indirect buffer.")
+
+(defvar org-capture-clock-keep nil
+ "Local variable to store the value of the :clock-keep parameter.
+This is needed in case org-capture-finalize is called interactively.")
+
+(defun org-capture-put (&rest stuff)
+ "Add properties to the capture property list `org-capture-plist'."
+ (while stuff
+ (setq org-capture-plist (plist-put org-capture-plist
+ (pop stuff) (pop stuff)))))
+(defun org-capture-get (prop &optional local)
+ "Get properties from the capture property list `org-capture-plist'.
+When LOCAL is set, use the local variable `org-capture-current-plist',
+this is necessary after initialization of the capture process,
+to avoid conflicts with other active capture processes."
+ (plist-get (if local org-capture-current-plist org-capture-plist) prop))
+
+(defun org-capture-member (prop &optional local)
+ "Is PROP a property in `org-capture-plist'.
+When LOCAL is set, use the local variable `org-capture-current-plist',
+this is necessary after initialization of the capture process,
+to avoid conflicts with other active capture processes."
+ (plist-get (if local org-capture-current-plist org-capture-plist) prop))
+
+;;; The minor mode
+
+(defvar org-capture-mode-map (make-sparse-keymap)
+ "Keymap for `org-capture-mode', a minor mode.
+Use this map to set additional keybindings for when Org-mode is used
+for a capture buffer.")
+
+(defvar org-capture-mode-hook nil
+ "Hook for the minor `org-capture-mode'.")
+
+(define-minor-mode org-capture-mode
+ "Minor mode for special key bindings in a capture buffer.
+
+Turning on this mode runs the normal hook `org-capture-mode-hook'."
+ nil " Rem" org-capture-mode-map
+ (org-set-local
+ 'header-line-format
+ "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))
+(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
+(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
+(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
+
+;;; The main commands
+
+;;;###autoload
+(defvar org-capture-initial nil)
+(defvar org-capture-entry nil)
+(defun org-capture-string (string &optional keys)
+ (interactive "sInitial text: \n")
+ (let ((org-capture-initial string)
+ (org-capture-entry (org-capture-select-template keys)))
+ (org-capture)))
+
+(defcustom org-capture-templates-contexts nil
+ "Alist of capture templates and valid contexts.
+
+For example, if you have a capture template \"c\" and you want
+this template to be accessible only from `message-mode' buffers,
+use this:
+
+ '((\"c\" (in-mode . \"message-mode\")))
+
+Here are the available contexts definitions:
+
+ in-file: command displayed only in matching files
+ in-mode: command displayed only in matching modes
+ not-in-file: command not displayed in matching files
+ not-in-mode: command not displayed in matching modes
+ [function]: a custom function taking no argument
+
+If you define several checks, the agenda command will be
+accessible if there is at least one valid check.
+
+You can also bind a key to another agenda custom command
+depending on contextual rules.
+
+ '((\"c\" \"d\" (in-mode . \"message-mode\")))
+
+Here it means: in `message-mode buffers', use \"d\" as the
+key for the capture template otherwise associated with \"d\".
+\(The template originally associated with \"q\" is not displayed
+to avoid duplicates.)"
+ :version "24.3"
+ :group 'org-capture
+ :type '(repeat (list :tag "Rule"
+ (string :tag " Capture key")
+ (string :tag "Replace by template")
+ (repeat :tag "Available when"
+ (choice
+ (cons :tag "Condition"
+ (choice
+ (const :tag "In file" in-file)
+ (const :tag "Not in file" not-in-file)
+ (const :tag "In mode" in-mode)
+ (const :tag "Not in mode" not-in-mode))
+ (regexp))
+ (function :tag "Custom function"))))))
+
+(defcustom org-capture-use-agenda-date nil
+ "Non-nil means use the date at point when capturing from agendas.
+When nil, you can still capturing using the date at point with \\[org-agenda-capture]]."
+ :group 'org-capture
+ :version "24.3"
+ :type 'boolean)
+
+;;;###autoload
+(defun org-capture (&optional goto keys)
+ "Capture something.
+\\<org-capture-mode-map>
+This will let you select a template from `org-capture-templates', and then
+file the newly captured information. The text is immediately inserted
+at the target location, and an indirect buffer is shown where you can
+edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
+of Emacs, so that you can continue your work.
+
+When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
+anything, just go to the file/headline where the selected template
+stores its notes. With a double prefix argument \
+\\[universal-argument] \\[universal-argument], go to the last note
+stored.
+
+When called with a `C-0' (zero) prefix, insert a template at point.
+
+Lisp programs can set KEYS to a string associated with a template
+in `org-capture-templates'. In this case, interactive selection
+will be bypassed.
+
+If `org-capture-use-agenda-date' is non-nil, capturing from the
+agenda will use the date at point as the default date."
+ (interactive "P")
+ (when (and org-capture-use-agenda-date
+ (eq major-mode 'org-agenda-mode))
+ (setq org-overriding-default-time
+ (org-get-cursor-date)))
+ (cond
+ ((equal goto '(4)) (org-capture-goto-target))
+ ((equal goto '(16)) (org-capture-goto-last-stored))
+ (t
+ ;; FIXME: Are these needed?
+ (let* ((orig-buf (current-buffer))
+ (annotation (if (and (boundp 'org-capture-link-is-already-stored)
+ org-capture-link-is-already-stored)
+ (plist-get org-store-link-plist :annotation)
+ (ignore-errors (org-store-link nil))))
+ (entry (or org-capture-entry (org-capture-select-template keys)))
+ initial)
+ (setq initial (or org-capture-initial
+ (and (org-region-active-p)
+ (buffer-substring (point) (mark)))))
+ (when (stringp initial)
+ (remove-text-properties 0 (length initial) '(read-only t) initial))
+ (when (stringp annotation)
+ (remove-text-properties 0 (length annotation)
+ '(read-only t) annotation))
+ (cond
+ ((equal entry "C")
+ (customize-variable 'org-capture-templates))
+ ((equal entry "q")
+ (error "Abort"))
+ (t
+ (org-capture-set-plist entry)
+ (org-capture-get-template)
+ (org-capture-put :original-buffer orig-buf
+ :original-file (or (buffer-file-name orig-buf)
+ (and (featurep 'dired)
+ (car (rassq orig-buf
+ dired-buffers))))
+ :original-file-nondirectory
+ (and (buffer-file-name orig-buf)
+ (file-name-nondirectory
+ (buffer-file-name orig-buf)))
+ :annotation annotation
+ :initial initial)
+ (org-capture-put :default-time
+ (or org-overriding-default-time
+ (org-current-time)))
+ (org-capture-set-target-location)
+ (condition-case error
+ (org-capture-put :template (org-capture-fill-template))
+ ((error quit)
+ (if (get-buffer "*Capture*") (kill-buffer "*Capture*"))
+ (error "Capture abort: %s" error)))
+
+ (setq org-capture-clock-keep (org-capture-get :clock-keep))
+ (if (equal goto 0)
+ ;;insert at point
+ (org-capture-insert-template-here)
+ (condition-case error
+ (org-capture-place-template)
+ ((error quit)
+ (if (and (buffer-base-buffer (current-buffer))
+ (string-match "\\`CAPTURE-" (buffer-name)))
+ (kill-buffer (current-buffer)))
+ (set-window-configuration (org-capture-get :return-to-wconf))
+ (error "Capture template `%s': %s"
+ (org-capture-get :key)
+ (nth 1 error))))
+ (if (and (derived-mode-p 'org-mode)
+ (org-capture-get :clock-in))
+ (condition-case nil
+ (progn
+ (if (org-clock-is-active)
+ (org-capture-put :interrupted-clock
+ (copy-marker org-clock-marker)))
+ (org-clock-in)
+ (org-set-local 'org-capture-clock-was-started t))
+ (error
+ "Could not start the clock in this capture buffer")))
+ (if (org-capture-get :immediate-finish)
+ (org-capture-finalize nil)))))))))
+
+(defun org-capture-get-template ()
+ "Get the template from a file or a function if necessary."
+ (let ((txt (org-capture-get :template)) file)
+ (cond
+ ((and (listp txt) (eq (car txt) 'file))
+ (if (file-exists-p
+ (setq file (expand-file-name (nth 1 txt) org-directory)))
+ (setq txt (org-file-contents file))
+ (setq txt (format "* Template file %s not found" (nth 1 txt)))))
+ ((and (listp txt) (eq (car txt) 'function))
+ (if (fboundp (nth 1 txt))
+ (setq txt (funcall (nth 1 txt)))
+ (setq txt (format "* Template function %s not found" (nth 1 txt)))))
+ ((not txt) (setq txt ""))
+ ((stringp txt))
+ (t (setq txt "* Invalid capture template")))
+ (org-capture-put :template txt)))
+
+(defun org-capture-finalize (&optional stay-with-capture)
+ "Finalize the capture process.
+With prefix argument STAY-WITH-CAPTURE, jump to the location of the
+captured item after finalizing."
+ (interactive "P")
+ (unless (and org-capture-mode
+ (buffer-base-buffer (current-buffer)))
+ (error "This does not seem to be a capture buffer for Org-mode"))
+
+ (run-hooks 'org-capture-prepare-finalize-hook)
+
+ ;; Did we start the clock in this capture buffer?
+ (when (and org-capture-clock-was-started
+ org-clock-marker (marker-buffer org-clock-marker)
+ (equal (marker-buffer org-clock-marker) (buffer-base-buffer))
+ (> org-clock-marker (point-min))
+ (< org-clock-marker (point-max)))
+ ;; Looks like the clock we started is still running. Clock out.
+ (when (not org-capture-clock-keep) (let (org-log-note-clock-out) (org-clock-out)))
+ (when (and (not org-capture-clock-keep)
+ (org-capture-get :clock-resume 'local)
+ (markerp (org-capture-get :interrupted-clock 'local))
+ (buffer-live-p (marker-buffer
+ (org-capture-get :interrupted-clock 'local))))
+ (let ((clock-in-task (org-capture-get :interrupted-clock 'local)))
+ (org-with-point-at clock-in-task
+ (org-clock-in)))
+ (message "Interrupted clock has been resumed")))
+
+ (let ((beg (point-min))
+ (end (point-max))
+ (abort-note nil))
+ ;; Store the size of the capture buffer
+ (org-capture-put :captured-entry-size (- (point-max) (point-min)))
+ (widen)
+ ;; Store the insertion point in the target buffer
+ (org-capture-put :insertion-point (point))
+
+ (if org-note-abort
+ (let ((m1 (org-capture-get :begin-marker 'local))
+ (m2 (org-capture-get :end-marker 'local)))
+ (if (and m1 m2 (= m1 beg) (= m2 end))
+ (progn
+ (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry))
+ m2 (1+ m2))
+ m2 (if (< (point-max) m2) (point-max) m2))
+ (setq abort-note 'clean)
+ (kill-region m1 m2))
+ (setq abort-note 'dirty)))
+
+ ;; Make sure that the empty lines after are correct
+ (when (and (> (point-max) end) ; indeed, the buffer was still narrowed
+ (member (org-capture-get :type 'local)
+ '(entry item checkitem plain)))
+ (save-excursion
+ (goto-char end)
+ (or (bolp) (newline))
+ (org-capture-empty-lines-after
+ (or (org-capture-get :empty-lines-after 'local)
+ (org-capture-get :empty-lines 'local) 0))))
+ ;; Postprocessing: Update Statistics cookies, do the sorting
+ (when (derived-mode-p 'org-mode)
+ (save-excursion
+ (when (ignore-errors (org-back-to-heading))
+ (org-update-parent-todo-statistics)
+ (org-update-checkbox-count)))
+ ;; FIXME Here we should do the sorting
+ ;; If we have added a table line, maybe recompute?
+ (when (and (eq (org-capture-get :type 'local) 'table-line)
+ (org-at-table-p))
+ (if (org-table-get-stored-formulas)
+ (org-table-recalculate 'all) ;; FIXME: Should we iterate???
+ (org-table-align))))
+ ;; Store this place as the last one where we stored something
+ ;; Do the marking in the base buffer, so that it makes sense after
+ ;; the indirect buffer has been killed.
+ (when org-capture-bookmark
+ (org-capture-bookmark-last-stored-position))
+
+ ;; Run the hook
+ (run-hooks 'org-capture-before-finalize-hook))
+
+ (when (org-capture-get :decrypted)
+ (save-excursion
+ (goto-char (org-capture-get :decrypted))
+ (org-encrypt-entry)))
+
+ ;; Kill the indirect buffer
+ (save-buffer)
+ (let ((return-wconf (org-capture-get :return-to-wconf 'local))
+ (new-buffer (org-capture-get :new-buffer 'local))
+ (kill-buffer (org-capture-get :kill-buffer 'local))
+ (base-buffer (buffer-base-buffer (current-buffer))))
+
+ ;; Kill the indirect buffer
+ (kill-buffer (current-buffer))
+
+ ;; Narrow back the target buffer to its previous state
+ (with-current-buffer (org-capture-get :buffer)
+ (let ((reg (org-capture-get :initial-target-region))
+ (pos (org-capture-get :initial-target-position))
+ (ipt (org-capture-get :insertion-point))
+ (size (org-capture-get :captured-entry-size)))
+ (when reg
+ (cond ((< ipt (car reg))
+ ;; insertion point is before the narrowed region
+ (narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
+ ((> ipt (cdr reg))
+ ;; insertion point is after the narrowed region
+ (narrow-to-region (car reg) (cdr reg)))
+ (t
+ ;; insertion point is within the narrowed region
+ (narrow-to-region (car reg) (+ size (cdr reg)))))
+ ;; now place back the point at its original position
+ (if (< ipt (car reg))
+ (goto-char (+ size pos))
+ (goto-char (if (< ipt pos) (+ size pos) pos))))))
+
+ ;; Kill the target buffer if that is desired
+ (when (and base-buffer new-buffer kill-buffer)
+ (with-current-buffer base-buffer (save-buffer))
+ (kill-buffer base-buffer))
+
+ ;; Restore the window configuration before capture
+ (set-window-configuration return-wconf))
+
+ (run-hooks 'org-capture-after-finalize-hook)
+ ;; Special cases
+ (cond
+ (abort-note
+ (cond
+ ((equal abort-note 'clean)
+ (message "Capture process aborted and target buffer cleaned up"))
+ ((equal abort-note 'dirty)
+ (error "Capture process aborted, but target buffer could not be cleaned up correctly"))))
+ (stay-with-capture
+ (org-capture-goto-last-stored)))
+ ;; Return if we did store something
+ (not abort-note)))
+
+(defun org-capture-refile ()
+ "Finalize the current capture and then refile the entry.
+Refiling is done from the base buffer, because the indirect buffer is then
+already gone. Any prefix argument will be passed to the refile command."
+ (interactive)
+ (unless (eq (org-capture-get :type 'local) 'entry)
+ (error
+ "Refiling from a capture buffer makes only sense for `entry'-type templates"))
+ (let ((pos (point))
+ (base (buffer-base-buffer (current-buffer)))
+ (org-refile-for-capture t))
+ (org-capture-finalize)
+ (save-window-excursion
+ (with-current-buffer (or base (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (call-interactively 'org-refile)))))))
+
+(defun org-capture-kill ()
+ "Abort the current capture process."
+ (interactive)
+ ;; FIXME: This does not do the right thing, we need to remove the
+ ;; new stuff by hand it is easy: undo, then kill the buffer
+ (let ((org-note-abort t)
+ (org-capture-before-finalize-hook nil))
+ (org-capture-finalize)))
+
+(defun org-capture-goto-last-stored ()
+ "Go to the location where the last capture note was stored."
+ (interactive)
+ (org-goto-marker-or-bmk org-capture-last-stored-marker
+ "org-capture-last-stored")
+ (message "This is the last note stored by a capture process"))
+
+;;; Supporting functions for handling the process
+
+(defun org-capture-put-target-region-and-position ()
+ "Store the initial region with `org-capture-put'."
+ (org-capture-put
+ :initial-target-region
+ ;; Check if the buffer is currently narrowed
+ (when (/= (buffer-size) (- (point-max) (point-min)))
+ (cons (point-min) (point-max))))
+ ;; store the current point
+ (org-capture-put :initial-target-position (point)))
+
+(defvar org-time-was-given) ; dynamically scoped parameter
+(defun org-capture-set-target-location (&optional target)
+ "Find TARGET buffer and position.
+Store them in the capture property list."
+ (let ((target-entry-p t) decrypted-hl-pos)
+ (setq target (or target (org-capture-get :target)))
+ (save-excursion
+ (cond
+ ((eq (car target) 'file)
+ (set-buffer (org-capture-target-buffer (nth 1 target)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (setq target-entry-p nil))
+
+ ((eq (car target) 'id)
+ (let ((loc (org-id-find (nth 1 target))))
+ (if (not loc)
+ (error "Cannot find target ID \"%s\"" (nth 1 target))
+ (set-buffer (org-capture-target-buffer (car loc)))
+ (widen)
+ (org-capture-put-target-region-and-position)
+ (goto-char (cdr loc)))))
+
+ ((eq (car target) 'file+headline)
+ (set-buffer (org-capture-target-buffer (nth 1 target)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (let ((hd (nth 2 target)))
+ (goto-char (point-min))
+ (unless (derived-mode-p 'org-mode)
+ (error
+ "Target buffer \"%s\" for file+headline should be in Org mode"
+ (current-buffer)))
+ (if (re-search-forward
+ (format org-complex-heading-regexp-format (regexp-quote hd))
+ nil t)
+ (goto-char (point-at-bol))
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ (insert "* " hd "\n")
+ (beginning-of-line 0))))
+
+ ((eq (car target) 'file+olp)
+ (let ((m (org-find-olp
+ (cons (org-capture-expand-file (nth 1 target))
+ (cddr target)))))
+ (set-buffer (marker-buffer m))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char m)))
+
+ ((eq (car target) 'file+regexp)
+ (set-buffer (org-capture-target-buffer (nth 1 target)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward (nth 2 target) nil t)
+ (progn
+ (goto-char (if (org-capture-get :prepend)
+ (match-beginning 0) (match-end 0)))
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
+ (error "No match for target regexp in file %s" (nth 1 target))))
+
+ ((memq (car target) '(file+datetree file+datetree+prompt))
+ (require 'org-datetree)
+ (set-buffer (org-capture-target-buffer (nth 1 target)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ ;; Make a date tree entry, with the current date (or yesterday,
+ ;; if we are extending dates for a couple of hours)
+ (org-datetree-find-date-create
+ (calendar-gregorian-from-absolute
+ (cond
+ (org-overriding-default-time
+ ;; use the overriding default time
+ (time-to-days org-overriding-default-time))
+
+ ((eq (car target) 'file+datetree+prompt)
+ ;; prompt for date
+ (let ((prompt-time (org-read-date
+ nil t nil "Date for tree entry:"
+ (current-time))))
+ (org-capture-put
+ :default-time
+ (cond ((and (not org-time-was-given)
+ (not (= (time-to-days prompt-time) (org-today))))
+ ;; Use 00:00 when no time is given for another date than today?
+ (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
+ ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer)
+ ;; Replace any time range by its start
+ (apply 'encode-time
+ (org-read-date-analyze
+ (replace-match "\\1 \\2" nil nil org-read-date-final-answer)
+ prompt-time (decode-time prompt-time))))
+ (t prompt-time)))
+ (time-to-days prompt-time)))
+ (t
+ ;; current date, possibly corrected for late night workers
+ (org-today))))))
+
+ ((eq (car target) 'file+function)
+ (set-buffer (org-capture-target-buffer (nth 1 target)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (funcall (nth 2 target))
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
+
+ ((eq (car target) 'function)
+ (funcall (nth 1 target))
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
+
+ ((eq (car target) 'clock)
+ (if (and (markerp org-clock-hd-marker)
+ (marker-buffer org-clock-hd-marker))
+ (progn (set-buffer (marker-buffer org-clock-hd-marker))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char org-clock-hd-marker))
+ (error "No running clock that could be used as capture target")))
+
+ (t (error "Invalid capture target specification")))
+
+ (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p))
+ (org-decrypt-entry)
+ (setq decrypted-hl-pos
+ (save-excursion (and (org-back-to-heading t) (point)))))
+
+ (org-capture-put :buffer (current-buffer) :pos (point)
+ :target-entry-p target-entry-p
+ :decrypted decrypted-hl-pos))))
+
+(defun org-capture-expand-file (file)
+ "Expand functions and symbols for FILE.
+When FILE is a function, call it. When it is a form, evaluate
+it. When it is a variable, retrieve the value. Return whatever we get."
+ (cond
+ ((org-string-nw-p file) file)
+ ((functionp file) (funcall file))
+ ((and (symbolp file) (boundp file)) (symbol-value file))
+ ((and file (consp file)) (eval file))
+ (t file)))
+
+(defun org-capture-target-buffer (file)
+ "Get a buffer for FILE."
+ (setq file (org-capture-expand-file file))
+ (setq file (or (org-string-nw-p file)
+ org-default-notes-file
+ (error "No notes file specified, and no default available")))
+ (or (org-find-base-buffer-visiting file)
+ (progn (org-capture-put :new-buffer t)
+ (find-file-noselect (expand-file-name file org-directory)))))
+
+(defun org-capture-steal-local-variables (buffer)
+ "Install Org-mode local variables."
+ (mapc (lambda (v)
+ (ignore-errors (org-set-local (car v) (cdr v))))
+ (buffer-local-variables buffer)))
+
+(defun org-capture-place-template ()
+ "Insert the template at the target location, and display the buffer."
+ (org-capture-put :return-to-wconf (current-window-configuration))
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window
+ (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
+ (widen)
+ (show-all)
+ (goto-char (org-capture-get :pos))
+ (org-set-local 'org-capture-target-marker
+ (move-marker (make-marker) (point)))
+ (org-set-local 'outline-level 'org-outline-level)
+ (let* ((template (org-capture-get :template))
+ (type (org-capture-get :type)))
+ (case type
+ ((nil entry) (org-capture-place-entry))
+ (table-line (org-capture-place-table-line))
+ (plain (org-capture-place-plain-text))
+ (item (org-capture-place-item))
+ (checkitem (org-capture-place-item))))
+ (org-capture-mode 1)
+ (org-set-local 'org-capture-current-plist org-capture-plist))
+
+(defun org-capture-place-entry ()
+ "Place the template as a new Org entry."
+ (let* ((txt (org-capture-get :template))
+ (reversed (org-capture-get :prepend))
+ (target-entry-p (org-capture-get :target-entry-p))
+ level beg end file)
+
+ (cond
+ ((org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position)))
+ ((not target-entry-p)
+ ;; Insert as top-level entry, either at beginning or at end of file
+ (setq level 1)
+ (if reversed
+ (progn (goto-char (point-min))
+ (or (org-at-heading-p)
+ (outline-next-heading)))
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))))
+ (t
+ ;; Insert as a child of the current entry
+ (and (looking-at "\\*+")
+ (setq level (- (match-end 0) (match-beginning 0))))
+ (setq level (org-get-valid-level (or level 1) 1))
+ (if reversed
+ (progn
+ (outline-next-heading)
+ (or (bolp) (insert "\n")))
+ (org-end-of-subtree t nil)
+ (or (bolp) (insert "\n")))))
+ (org-capture-empty-lines-before)
+ (setq beg (point))
+ (org-capture-verify-tree txt)
+ (org-paste-subtree level txt 'for-yank)
+ (org-capture-empty-lines-after 1)
+ (org-capture-position-for-last-stored beg)
+ (outline-next-heading)
+ (setq end (point))
+ (org-capture-mark-kill-region beg (1- end))
+ (org-capture-narrow beg (1- end))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
+
+(defun org-capture-place-item ()
+ "Place the template as a new plain list item."
+ (let* ((txt (org-capture-get :template))
+ (target-entry-p (org-capture-get :target-entry-p))
+ (ind 0)
+ beg end)
+ (if (org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position))
+ (cond
+ ((not target-entry-p)
+ ;; Insert as top-level entry, either at beginning or at end of file
+ (setq beg (point-min) end (point-max)))
+ (t
+ (setq beg (1+ (point-at-eol))
+ end (save-excursion (outline-next-heading) (point)))))
+ (if (org-capture-get :prepend)
+ (progn
+ (goto-char beg)
+ (if (org-list-search-forward (org-item-beginning-re) end t)
+ (progn
+ (goto-char (match-beginning 0))
+ (setq ind (org-get-indentation)))
+ (goto-char end)
+ (setq ind 0)))
+ (goto-char end)
+ (if (org-list-search-backward (org-item-beginning-re) beg t)
+ (progn
+ (setq ind (org-get-indentation))
+ (org-end-of-item))
+ (setq ind 0))))
+ ;; Remove common indentation
+ (setq txt (org-remove-indentation txt))
+ ;; Make sure this is indeed an item
+ (unless (string-match (concat "\\`" (org-item-re)) txt)
+ (setq txt (concat "- "
+ (mapconcat 'identity (split-string txt "\n")
+ "\n "))))
+ ;; Set the correct indentation, depending on context
+ (setq ind (make-string ind ?\ ))
+ (setq txt (concat ind
+ (mapconcat 'identity (split-string txt "\n")
+ (concat "\n" ind))
+ "\n"))
+ ;; Insert, with surrounding empty lines
+ (org-capture-empty-lines-before)
+ (setq beg (point))
+ (insert txt)
+ (or (bolp) (insert "\n"))
+ (org-capture-empty-lines-after 1)
+ (org-capture-position-for-last-stored beg)
+ (forward-char 1)
+ (setq end (point))
+ (org-capture-mark-kill-region beg (1- end))
+ (org-capture-narrow beg (1- end))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
+
+(defun org-capture-place-table-line ()
+ "Place the template as a table line."
+ (require 'org-table)
+ (let* ((txt (org-capture-get :template))
+ (target-entry-p (org-capture-get :target-entry-p))
+ (table-line-pos (org-capture-get :table-line-pos))
+ ind beg end)
+ (cond
+ ((org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position)))
+ ((not target-entry-p)
+ ;; Table is not necessarily under a heading
+ (setq beg (point-min) end (point-max)))
+ (t
+ ;; WE are at a heading, limit search to the body
+ (setq beg (1+ (point-at-eol))
+ end (save-excursion (outline-next-heading) (point)))))
+ (if (re-search-forward org-table-dataline-regexp end t)
+ (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t))
+ (goto-char e)
+ (if (looking-at "[ \t]*#\\+tblfm:")
+ (forward-line 1))
+ (narrow-to-region b (point)))
+ (goto-char end)
+ (insert "\n| |\n|----|\n| |\n")
+ (narrow-to-region (1+ end) (point)))
+ ;; We are narrowed to the table, or to an empty line if there was no table
+
+ ;; Check if the template is good
+ (if (not (string-match org-table-dataline-regexp txt))
+ (setq txt "| %?Bad template |\n"))
+ (cond
+ ((and table-line-pos
+ (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
+ ;; we have a complex line specification
+ (goto-char (point-min))
+ (let ((nh (- (match-end 1) (match-beginning 1)))
+ (delta (string-to-number (match-string 2 table-line-pos)))
+ ll)
+ ;; The user wants a special position in the table
+ (org-table-get-specials)
+ (setq ll (ignore-errors (aref org-table-hlines nh)))
+ (unless ll (error "Invalid table line specification \"%s\""
+ table-line-pos))
+ (setq ll (+ ll delta (if (< delta 0) 0 -1)))
+ (org-goto-line ll)
+ (org-table-insert-row 'below)
+ (beginning-of-line 1)
+ (delete-region (point) (1+ (point-at-eol)))
+ (setq beg (point))
+ (insert txt)
+ (setq end (point))))
+ ((org-capture-get :prepend)
+ (goto-char (point-min))
+ (re-search-forward org-table-hline-regexp nil t)
+ (beginning-of-line 1)
+ (re-search-forward org-table-dataline-regexp nil t)
+ (beginning-of-line 1)
+ (setq beg (point))
+ (org-table-insert-row)
+ (beginning-of-line 1)
+ (delete-region (point) (1+ (point-at-eol)))
+ (insert txt)
+ (setq end (point)))
+ (t
+ (goto-char (point-max))
+ (re-search-backward org-table-dataline-regexp nil t)
+ (beginning-of-line 1)
+ (org-table-insert-row 'below)
+ (beginning-of-line 1)
+ (delete-region (point) (1+ (point-at-eol)))
+ (setq beg (point))
+ (insert txt)
+ (setq end (point))))
+ (goto-char beg)
+ (org-capture-position-for-last-stored 'table-line)
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))
+ (org-table-align)))
+
+(defun org-capture-place-plain-text ()
+ "Place the template plainly.
+If the target locator points at an Org node, place the template into
+the text of the entry, before the first child. If not, place the
+template at the beginning or end of the file.
+Of course, if exact position has been required, just put it there."
+ (let* ((txt (org-capture-get :template))
+ beg end)
+ (cond
+ ((org-capture-get :exact-position)
+ (goto-char (org-capture-get :exact-position)))
+ ((and (org-capture-get :target-entry-p)
+ (bolp)
+ (looking-at org-outline-regexp))
+ ;; we should place the text into this entry
+ (if (org-capture-get :prepend)
+ ;; Skip meta data and drawers
+ (org-end-of-meta-data-and-drawers)
+ ;; go to ent of the entry text, before the next headline
+ (outline-next-heading)))
+ (t
+ ;; beginning or end of file
+ (goto-char (if (org-capture-get :prepend) (point-min) (point-max)))))
+ (or (bolp) (newline))
+ (org-capture-empty-lines-before)
+ (setq beg (point))
+ (insert txt)
+ (org-capture-empty-lines-after 1)
+ (org-capture-position-for-last-stored beg)
+ (setq end (point))
+ (org-capture-mark-kill-region beg (1- end))
+ (org-capture-narrow beg (1- end))
+ (if (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))
+
+(defun org-capture-mark-kill-region (beg end)
+ "Mark the region that will have to be killed when aborting capture."
+ (let ((m1 (move-marker (make-marker) beg))
+ (m2 (move-marker (make-marker) end)))
+ (org-capture-put :begin-marker m1)
+ (org-capture-put :end-marker m2)))
+
+(defun org-capture-position-for-last-stored (where)
+ "Memorize the position that should later become the position of last capture."
+ (cond
+ ((integerp where)
+ (org-capture-put :position-for-last-stored
+ (move-marker (make-marker) where
+ (or (buffer-base-buffer (current-buffer))
+ (current-buffer)))))
+ ((eq where 'table-line)
+ (org-capture-put :position-for-last-stored
+ (list 'table-line
+ (org-table-current-dline))))
+ (t (error "This should not happen"))))
+
+(defun org-capture-bookmark-last-stored-position ()
+ "Bookmark the last-captured position."
+ (let* ((where (org-capture-get :position-for-last-stored 'local))
+ (pos (cond
+ ((markerp where)
+ (prog1 (marker-position where)
+ (move-marker where nil)))
+ ((and (listp where) (eq (car where) 'table-line))
+ (if (org-at-table-p)
+ (save-excursion
+ (org-table-goto-line (nth 1 where))
+ (point-at-bol))
+ (point))))))
+ (with-current-buffer (buffer-base-buffer (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (bookmark-set "org-capture-last-stored")
+ (move-marker org-capture-last-stored-marker (point)))))))
+
+(defun org-capture-narrow (beg end)
+ "Narrow, unless configuration says not to narrow."
+ (unless (org-capture-get :unnarrowed)
+ (narrow-to-region beg end)
+ (goto-char beg)))
+
+(defun org-capture-empty-lines-before (&optional n)
+ "Arrange for the correct number of empty lines before the insertion point.
+Point will be after the empty lines, so insertion can directly be done."
+ (setq n (or n (org-capture-get :empty-lines-before)
+ (org-capture-get :empty-lines) 0))
+ (let ((pos (point)))
+ (org-back-over-empty-lines)
+ (delete-region (point) pos)
+ (if (> n 0) (newline n))))
+
+(defun org-capture-empty-lines-after (&optional n)
+ "Arrange for the correct number of empty lines after the inserted string.
+Point will remain at the first line after the inserted text."
+ (setq n (or n (org-capture-get :empty-lines-after)
+ (org-capture-get :empty-lines) 0))
+ (org-back-over-empty-lines)
+ (while (looking-at "[ \t]*\n") (replace-match ""))
+ (let ((pos (point)))
+ (if (> n 0) (newline n))
+ (goto-char pos)))
+
+(defvar org-clock-marker) ; Defined in org.el
+;;;###autoload
+(defun org-capture-insert-template-here ()
+ (let* ((template (org-capture-get :template))
+ (type (org-capture-get :type))
+ beg end pp)
+ (or (bolp) (newline))
+ (setq beg (point))
+ (cond
+ ((and (eq type 'entry) (derived-mode-p 'org-mode))
+ (org-capture-verify-tree (org-capture-get :template))
+ (org-paste-subtree nil template t))
+ ((and (memq type '(item checkitem))
+ (derived-mode-p 'org-mode)
+ (save-excursion (skip-chars-backward " \t\n")
+ (setq pp (point))
+ (org-in-item-p)))
+ (goto-char pp)
+ (org-insert-item)
+ (skip-chars-backward " ")
+ (skip-chars-backward "-+*0123456789).")
+ (delete-region (point) (point-at-eol))
+ (setq beg (point))
+ (org-remove-indentation template)
+ (insert template)
+ (org-capture-empty-lines-after)
+ (goto-char beg)
+ (org-list-repair)
+ (org-end-of-item)
+ (setq end (point)))
+ (t (insert template)))
+ (setq end (point))
+ (goto-char beg)
+ (if (re-search-forward "%\\?" end t)
+ (replace-match ""))))
+
+(defun org-capture-set-plist (entry)
+ "Initialize the property list from the template definition."
+ (setq org-capture-plist (copy-sequence (nthcdr 5 entry)))
+ (org-capture-put :key (car entry) :description (nth 1 entry)
+ :target (nth 3 entry))
+ (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry)))
+ (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt))))
+ ;; The template may be empty or omitted for special types.
+ ;; Here we insert the default templates for such cases.
+ (cond
+ ((eq type 'item) (setq txt "- %?"))
+ ((eq type 'checkitem) (setq txt "- [ ] %?"))
+ ((eq type 'table-line) (setq txt "| %? |"))
+ ((member type '(nil entry)) (setq txt "* %?\n %a"))))
+ (org-capture-put :template txt :type type)))
+
+(defun org-capture-goto-target (&optional template-key)
+ "Go to the target location of a capture template.
+The user is queried for the template."
+ (interactive)
+ (let* (org-select-template-temp-major-mode
+ (entry (org-capture-select-template template-key)))
+ (unless entry
+ (error "No capture template selected"))
+ (org-capture-set-plist entry)
+ (org-capture-set-target-location)
+ (org-pop-to-buffer-same-window (org-capture-get :buffer))
+ (goto-char (org-capture-get :pos))))
+
+(defun org-capture-get-indirect-buffer (&optional buffer prefix)
+ "Make an indirect buffer for a capture process.
+Use PREFIX as a prefix for the name of the indirect buffer."
+ (setq buffer (or buffer (current-buffer)))
+ (let ((n 1) (base (buffer-name buffer)) bname)
+ (setq bname (concat prefix "-" base))
+ (while (buffer-live-p (get-buffer bname))
+ (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
+ (condition-case nil
+ (make-indirect-buffer buffer bname 'clone)
+ (error
+ (let ((buf (make-indirect-buffer buffer bname)))
+ (with-current-buffer buf (org-mode))
+ buf)))))
+
+(defun org-capture-verify-tree (tree)
+ "Throw error if TREE is not a valid tree."
+ (unless (org-kill-is-subtree-p tree)
+ (error "Template is not a valid Org entry or tree")))
+
+;;; The template code
+
+(defun org-capture-select-template (&optional keys)
+ "Select a capture template.
+Lisp programs can force the template by setting KEYS to a string."
+ (let ((org-capture-templates
+ (or (org-contextualize-keys
+ org-capture-templates org-capture-templates-contexts)
+ '(("t" "Task" entry (file+headline "" "Tasks")
+ "* TODO %?\n %u\n %a")))))
+ (if keys
+ (or (assoc keys org-capture-templates)
+ (error "No capture template referred to by \"%s\" keys" keys))
+ (org-mks org-capture-templates
+ "Select a capture template\n========================="
+ "Template key: "
+ '(("C" "Customize org-capture-templates")
+ ("q" "Abort"))))))
+
+(defun org-capture-fill-template (&optional template initial annotation)
+ "Fill a template and return the filled template as a string.
+The template may still contain \"%?\" for cursor positioning."
+ (setq template (or template (org-capture-get :template)))
+ (when (stringp initial)
+ (setq initial (org-no-properties initial)))
+ (let* ((buffer (org-capture-get :buffer))
+ (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
+ (ct (org-capture-get :default-time))
+ (dct (decode-time ct))
+ (ct1
+ (if (< (nth 2 dct) org-extend-today-until)
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+ ct))
+ (plist-p (if org-store-link-plist t nil))
+ (v-c (and (> (length kill-ring) 0) (current-kill 0)))
+ (v-x (or (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)))
+ (v-t (format-time-string (car org-time-stamp-formats) ct))
+ (v-T (format-time-string (cdr org-time-stamp-formats) ct))
+ (v-u (concat "[" (substring v-t 1 -1) "]"))
+ (v-U (concat "[" (substring v-T 1 -1) "]"))
+ ;; `initial' and `annotation' might habe been passed.
+ ;; But if the property list has them, we prefer those values
+ (v-i (or (plist-get org-store-link-plist :initial)
+ initial
+ (org-capture-get :initial)
+ ""))
+ (v-a (or (plist-get org-store-link-plist :annotation)
+ annotation
+ (org-capture-get :annotation)
+ ""))
+ ;; Is the link empty? Then we do not want it...
+ (v-a (if (equal v-a "[[]]") "" v-a))
+ (clipboards (remove nil (list v-i
+ (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)
+ v-c)))
+ (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
+ (v-A (if (and v-a (string-match l-re v-a))
+ (replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
+ v-a))
+ (v-l (if (and v-a (string-match l-re v-a))
+ (replace-match "\\1" nil nil v-a)
+ v-a))
+ (v-n user-full-name)
+ (v-k (if (marker-buffer org-clock-marker)
+ (org-no-properties org-clock-heading)))
+ (v-K (if (marker-buffer org-clock-marker)
+ (org-make-link-string
+ (buffer-file-name (marker-buffer org-clock-marker))
+ org-clock-heading)))
+ (v-f (or (org-capture-get :original-file-nondirectory) ""))
+ (v-F (or (org-capture-get :original-file) ""))
+ v-I
+ (org-startup-folded nil)
+ (org-inhibit-startup t)
+ org-time-was-given org-end-time-was-given x
+ prompt completions char time pos default histvar strings)
+
+ (setq org-store-link-plist
+ (plist-put org-store-link-plist :annotation v-a)
+ org-store-link-plist
+ (plist-put org-store-link-plist :initial v-i))
+ (setq initial v-i)
+
+ (unless template (setq template "") (message "No template") (ding)
+ (sit-for 1))
+ (save-window-excursion
+ (delete-other-windows)
+ (org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
+ (erase-buffer)
+ (insert template)
+ (goto-char (point-min))
+ (org-capture-steal-local-variables buffer)
+ (setq buffer-file-name nil)
+
+ ;; %[] Insert contents of a file.
+ (goto-char (point-min))
+ (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
+ (unless (org-capture-escaped-%)
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (filename (expand-file-name (match-string 1))))
+ (goto-char start)
+ (delete-region start end)
+ (condition-case error
+ (insert-file-contents filename)
+ (error (insert (format "%%![Couldn't insert %s: %s]"
+ filename error)))))))
+ ;; %() embedded elisp
+ (org-capture-expand-embedded-elisp)
+
+ ;; The current time
+ (goto-char (point-min))
+ (while (re-search-forward "%<\\([^>\n]+\\)>" nil t)
+ (replace-match (format-time-string (match-string 1)) t t))
+
+ ;; Simple %-escapes
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (when (and initial (equal (match-string 0) "%i"))
+ (save-match-data
+ (let* ((lead (buffer-substring
+ (point-at-bol) (match-beginning 0))))
+ (setq v-i (mapconcat 'identity
+ (org-split-string initial "\n")
+ (concat "\n" lead))))))
+ (replace-match
+ (or (org-add-props (eval (intern (concat "v-" (match-string 1))))
+ '(org-protected t)) "")
+ t t)))
+
+ ;; From the property list
+ (when plist-p
+ (goto-char (point-min))
+ (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (and (setq x (or (plist-get org-store-link-plist
+ (intern (match-string 1))) ""))
+ (replace-match x t t)))))
+
+ ;; Turn on org-mode in temp buffer, set local variables
+ ;; This is to support completion in interactive prompts
+ (let ((org-inhibit-startup t)) (org-mode))
+ ;; Interactive template entries
+ (goto-char (point-min))
+ (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
+ (not (get-text-property (1- (point)) 'org-protected)))
+ (unless (org-capture-escaped-%)
+ (setq char (if (match-end 3) (match-string-no-properties 3))
+ prompt (if (match-end 2) (match-string-no-properties 2)))
+ (goto-char (match-beginning 0))
+ (replace-match "")
+ (setq completions nil default nil)
+ (when prompt
+ (setq completions (org-split-string prompt "|")
+ prompt (pop completions)
+ default (car completions)
+ histvar (intern (concat
+ "org-capture-template-prompt-history::"
+ (or prompt "")))
+ completions (mapcar 'list completions)))
+ (unless (boundp histvar) (set histvar nil))
+ (cond
+ ((member char '("G" "g"))
+ (let* ((org-last-tags-completion-table
+ (org-global-tags-completion-table
+ (if (equal char "G")
+ (org-agenda-files)
+ (and file (list file)))))
+ (org-add-colon-after-tag-completion t)
+ (ins (org-icompleting-read
+ (if prompt (concat prompt ": ") "Tags: ")
+ 'org-tags-completion-function nil nil nil
+ 'org-tags-history)))
+ (setq ins (mapconcat 'identity
+ (org-split-string
+ ins (org-re "[^[:alnum:]_@#%]+"))
+ ":"))
+ (when (string-match "\\S-" ins)
+ (or (equal (char-before) ?:) (insert ":"))
+ (insert ins)
+ (or (equal (char-after) ?:) (insert ":"))
+ (and (org-at-heading-p) (org-set-tags nil 'align)))))
+ ((equal char "C")
+ (cond ((= (length clipboards) 1) (insert (car clipboards)))
+ ((> (length clipboards) 1)
+ (insert (read-string "Clipboard/kill value: "
+ (car clipboards) '(clipboards . 1)
+ (car clipboards))))))
+ ((equal char "L")
+ (cond ((= (length clipboards) 1)
+ (org-insert-link 0 (car clipboards)))
+ ((> (length clipboards) 1)
+ (org-insert-link 0 (read-string "Clipboard/kill value: "
+ (car clipboards)
+ '(clipboards . 1)
+ (car clipboards))))))
+ ((equal char "p")
+ (org-set-property (org-no-properties prompt) nil))
+ (char
+ ;; These are the date/time related ones
+ (setq org-time-was-given (equal (upcase char) char))
+ (setq time (org-read-date (equal (upcase char) char) t nil
+ prompt))
+ (if (equal (upcase char) char) (setq org-time-was-given t))
+ (org-insert-time-stamp time org-time-was-given
+ (member char '("u" "U"))
+ nil nil (list org-end-time-was-given)))
+ (t
+ (let (org-completion-use-ido)
+ (push (org-completing-read-no-i
+ (concat (if prompt prompt "Enter string")
+ (if default (concat " [" default "]"))
+ ": ")
+ completions nil nil nil histvar default)
+ strings)
+ (insert (car strings)))))))
+ ;; Replace %n escapes with nth %^{...} string
+ (setq strings (nreverse strings))
+ (goto-char (point-min))
+ (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (replace-match
+ (nth (1- (string-to-number (match-string 1))) strings)
+ nil t)))
+ ;; Make sure there are no empty lines before the text, and that
+ ;; it ends with a newline character
+ (goto-char (point-min))
+ (while (looking-at "[ \t]*\n") (replace-match ""))
+ (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n"))
+ ;; Return the expanded template and kill the temporary buffer
+ (untabify (point-min) (point-max))
+ (set-buffer-modified-p nil)
+ (prog1 (buffer-string) (kill-buffer (current-buffer))))))
+
+(defun org-capture-escaped-% ()
+ "Check if % was escaped - if yes, unescape it now."
+ (if (equal (char-before (match-beginning 0)) ?\\)
+ (progn
+ (delete-region (1- (match-beginning 0)) (match-beginning 0))
+ t)
+ nil))
+
+(defun org-capture-expand-embedded-elisp ()
+ "Evaluate embedded elisp %(sexp) and replace with the result."
+ (goto-char (point-min))
+ (while (re-search-forward "%(" nil t)
+ (unless (org-capture-escaped-%)
+ (goto-char (match-beginning 0))
+ (let ((template-start (point)))
+ (forward-char 1)
+ (let ((result (org-eval (read (current-buffer)))))
+ (delete-region template-start (point))
+ (insert result))))))
+
+(defun org-capture-inside-embedded-elisp-p ()
+ "Return non-nil if point is inside of embedded elisp %(sexp)."
+ (let (beg end)
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (save-excursion
+ ;; `looking-at' and `search-backward' below do not match the "%(" if
+ ;; point is in its middle
+ (when (equal (char-before) ?%)
+ (backward-char))
+ (save-match-data
+ (when (or (looking-at "%(") (search-backward "%(" nil t))
+ (setq beg (point))
+ (setq end (progn (forward-char) (forward-sexp) (1- (point)))))))
+ (when (and beg end)
+ (and (<= (point) end) (>= (point) beg))))))
+
+;;;###autoload
+(defun org-capture-import-remember-templates ()
+ "Set org-capture-templates to be similar to `org-remember-templates'."
+ (interactive)
+ (when (and (yes-or-no-p
+ "Import old remember templates into org-capture-templates? ")
+ (yes-or-no-p
+ "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? "))
+ (require 'org-remember)
+ (setq org-capture-templates
+ (mapcar
+ (lambda (entry)
+ (let ((desc (car entry))
+ (key (char-to-string (nth 1 entry)))
+ (template (nth 2 entry))
+ (file (or (nth 3 entry) org-default-notes-file))
+ (position (or (nth 4 entry) org-remember-default-headline))
+ (type 'entry)
+ (prepend org-reverse-note-order)
+ immediate target)
+ (cond
+ ((member position '(top bottom))
+ (setq target (list 'file file)
+ prepend (eq position 'top)))
+ ((eq position 'date-tree)
+ (setq target (list 'file+datetree file)
+ prepend nil))
+ (t (setq target (list 'file+headline file position))))
+
+ (when (string-match "%!" template)
+ (setq template (replace-match "" t t template)
+ immediate t))
+
+ (append (list key desc type target template)
+ (if prepend '(:prepend t))
+ (if immediate '(:immediate-finish t)))))
+
+ org-remember-templates))))
+
+(provide 'org-capture)
+
+;;; org-capture.el ends here
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
new file mode 100644
index 0000000..bb6f2b9
--- /dev/null
+++ b/lisp/org-clock.el
@@ -0,0 +1,2780 @@
+;;; org-clock.el --- The time clocking code for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the time clocking code for Org-mode
+
+(require 'org-exp)
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
+(declare-function notifications-notify "notifications" (&rest params))
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+(defvar org-time-stamp-formats)
+(defvar org-ts-what)
+(defvar org-frame-title-format-backup frame-title-format)
+
+(defgroup org-clock nil
+ "Options concerning clocking working time in Org-mode."
+ :tag "Org Clock"
+ :group 'org-progress)
+
+(defcustom org-clock-into-drawer org-log-into-drawer
+ "Should clocking info be wrapped into a drawer?
+When t, clocking info will always be inserted into a :LOGBOOK: drawer.
+If necessary, the drawer will be created.
+When nil, the drawer will not be created, but used when present.
+When an integer and the number of clocking entries in an item
+reaches or exceeds this number, a drawer will be created.
+When a string, it names the drawer to be used.
+
+The default for this variable is the value of `org-log-into-drawer',
+which see."
+ :group 'org-todo
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Only when drawer exists" nil)
+ (integer :tag "When at least N clock entries")
+ (const :tag "Into LOGBOOK drawer" "LOGBOOK")
+ (string :tag "Into Drawer named...")))
+
+(defun org-clock-into-drawer ()
+ "Return the value of `org-clock-into-drawer', but let properties overrule.
+If the current entry has or inherits a CLOCK_INTO_DRAWER
+property, it will be used instead of the default value; otherwise
+if the current entry has or inherits a LOG_INTO_DRAWER property,
+it will be used instead of the default value.
+The default is the value of the customizable variable `org-clock-into-drawer',
+which see."
+ (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit))
+ (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
+ (cond
+ ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer)
+ ((or (equal p "t") (equal q "t")) "LOGBOOK")
+ ((not p) q)
+ (t p))))
+
+(defcustom org-clock-out-when-done t
+ "When non-nil, clock will be stopped when the clocked entry is marked DONE.
+DONE here means any DONE-like state.
+A nil value means clock will keep running until stopped explicitly with
+`C-c C-x C-o', or until the clock is started in a different item.
+Instead of t, this can also be a list of TODO states that should trigger
+clocking out."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "No" nil)
+ (const :tag "Yes, when done" t)
+ (repeat :tag "State list"
+ (string :tag "TODO keyword"))))
+
+(defcustom org-clock-out-remove-zero-time-clocks nil
+ "Non-nil means remove the clock line when the resulting time is zero."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-in-switch-to-state nil
+ "Set task to a special todo state while clocking it.
+The value should be the state to which the entry should be
+switched. If the value is a function, it must take one
+parameter (the current TODO state of the item) and return the
+state to switch it to."
+ :group 'org-clock
+ :group 'org-todo
+ :type '(choice
+ (const :tag "Don't force a state" nil)
+ (string :tag "State")
+ (symbol :tag "Function")))
+
+(defcustom org-clock-out-switch-to-state nil
+ "Set task to a special todo state after clocking out.
+The value should be the state to which the entry should be
+switched. If the value is a function, it must take one
+parameter (the current TODO state of the item) and return the
+state to switch it to."
+ :group 'org-clock
+ :group 'org-todo
+ :type '(choice
+ (const :tag "Don't force a state" nil)
+ (string :tag "State")
+ (symbol :tag "Function")))
+
+(defcustom org-clock-history-length 5
+ "Number of clock tasks to remember in history."
+ :group 'org-clock
+ :type 'integer)
+
+(defcustom org-clock-goto-may-find-recent-task t
+ "Non-nil means `org-clock-goto' can go to recent task if no active clock."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-heading-function nil
+ "When non-nil, should be a function to create `org-clock-heading'.
+This is the string shown in the mode line when a clock is running.
+The function is called with point at the beginning of the headline."
+ :group 'org-clock
+ :type 'function)
+
+(defcustom org-clock-string-limit 0
+ "Maximum length of clock strings in the mode line. 0 means no limit."
+ :group 'org-clock
+ :type 'integer)
+
+(defcustom org-clock-in-resume nil
+ "If non-nil, resume clock when clocking into task with open clock.
+When clocking into a task with a clock entry which has not been closed,
+the clock can be resumed from that point."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-persist nil
+ "When non-nil, save the running clock when Emacs is closed.
+The clock is resumed when Emacs restarts.
+When this is t, both the running clock, and the entire clock
+history are saved. When this is the symbol `clock', only the
+running clock is saved.
+
+When Emacs restarts with saved clock information, the file containing the
+running clock as well as all files mentioned in the clock history will
+be visited.
+All this depends on running `org-clock-persistence-insinuate' in .emacs"
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Just the running clock" clock)
+ (const :tag "Just the history" history)
+ (const :tag "Clock and history" t)
+ (const :tag "No persistence" nil)))
+
+(defcustom org-clock-persist-file (convert-standard-filename
+ "~/.emacs.d/org-clock-save.el")
+ "File to save clock data to."
+ :group 'org-clock
+ :type 'string)
+
+(defcustom org-clock-persist-query-save nil
+ "When non-nil, ask before saving the current clock on exit."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-persist-query-resume t
+ "When non-nil, ask before resuming any stored clock during load."
+ :group 'org-clock
+ :type 'boolean)
+
+(defcustom org-clock-sound nil
+ "Sound that will used for notifications.
+Possible values:
+
+nil no sound played.
+t standard Emacs beep
+file name play this sound file. If not possible, fall back to beep"
+ :group 'org-clock
+ :type '(choice
+ (const :tag "No sound" nil)
+ (const :tag "Standard beep" t)
+ (file :tag "Play sound file")))
+
+(defcustom org-clock-modeline-total 'auto
+ "Default setting for the time included for the mode line clock.
+This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
+Allowed values are:
+
+current Only the time in the current instance of the clock
+today All time clocked into this task today
+repeat All time clocked into this task since last repeat
+all All time ever recorded for this task
+auto Automatically, either `all', or `repeat' for repeating tasks"
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Current clock" current)
+ (const :tag "Today's task time" today)
+ (const :tag "Since last repeat" repeat)
+ (const :tag "All task time" all)
+ (const :tag "Automatically, `all' or since `repeat'" auto)))
+
+(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(defcustom org-clock-task-overrun-text nil
+ "Extra mode line text to indicate that the clock is overrun.
+The can be nil to indicate that instead of adding text, the clock time
+should get a different face (`org-mode-line-clock-overrun').
+When this is a string, it is prepended to the clock string as an indication,
+also using the face `org-mode-line-clock-overrun'."
+ :group 'org-clock
+ :version "24.1"
+ :type '(choice
+ (const :tag "Just mark the time string" nil)
+ (string :tag "Text to prepend")))
+
+(defcustom org-show-notification-handler nil
+ "Function or program to send notification with.
+The function or program will be called with the notification
+string as argument."
+ :group 'org-clock
+ :type '(choice
+ (string :tag "Program")
+ (function :tag "Function")))
+
+(defgroup org-clocktable nil
+ "Options concerning the clock table in Org-mode."
+ :tag "Org Clock Table"
+ :group 'org-clock)
+
+(defcustom org-clocktable-defaults
+ (list
+ :maxlevel 2
+ :lang org-export-default-language
+ :scope 'file
+ :block nil
+ :tstart nil
+ :tend nil
+ :step nil
+ :stepskip0 nil
+ :fileskip0 nil
+ :tags nil
+ :emphasize nil
+ :link nil
+ :narrow '40!
+ :indent t
+ :formula nil
+ :timestamp nil
+ :level nil
+ :tcolumns nil
+ :formatter nil)
+ "Default properties for clock tables."
+ :group 'org-clock
+ :version "24.1"
+ :type 'plist)
+
+(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default
+ "Function to turn clocking data into a table.
+For more information, see `org-clocktable-write-default'."
+ :group 'org-clocktable
+ :version "24.1"
+ :type 'function)
+
+;; FIXME: translate es and nl last string "Clock summary at"
+(defcustom org-clock-clocktable-language-setup
+ '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
+ ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
+ ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
+ ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
+ "Terms used in clocktable, translated to different languages."
+ :group 'org-clocktable
+ :version "24.1"
+ :type 'alist)
+
+(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file)
+ "Default properties for new clocktables.
+These will be inserted into the BEGIN line, to make it easy for users to
+play with them."
+ :group 'org-clocktable
+ :type 'plist)
+
+(defcustom org-clock-idle-time nil
+ "When non-nil, resolve open clocks if the user is idle more than X minutes."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Never" nil)
+ (integer :tag "After N minutes")))
+
+(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running
+ "When to automatically resolve open clocks found in Org buffers."
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When no clock is running" when-no-clock-is-running)))
+
+(defcustom org-clock-report-include-clocking-task nil
+ "When non-nil, include the current clocking task time in clock reports."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-resolve-expert nil
+ "Non-nil means do not show the splash buffer with the clock resolver."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-continuously nil
+ "Non-nil means to start clocking from the last clock-out time, if any."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-clock)
+
+(defcustom org-clock-total-time-cell-format "*%s*"
+ "Format string for the total time cells."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-file-time-cell-format "*%s*"
+ "Format string for the file time cells."
+ :group 'org-clock
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-clock-clocked-in-display 'mode-line
+ "When clocked in for a task, org-mode can display the current
+task and accumulated time in the mode line and/or frame title.
+Allowed values are:
+
+both displays in both mode line and frame title
+mode-line displays only in mode line (default)
+frame-title displays only in frame title
+nil current clock is not displayed"
+ :group 'org-clock
+ :type '(choice
+ (const :tag "Mode line" mode-line)
+ (const :tag "Frame title" frame-title)
+ (const :tag "Both" both)
+ (const :tag "None" nil)))
+
+(defcustom org-clock-frame-title-format '(t org-mode-line-string)
+ "The value for `frame-title-format' when clocking in.
+
+When `org-clock-clocked-in-display' is set to 'frame-title
+or 'both, clocking in will replace `frame-title-format' with
+this value. Clocking out will restore `frame-title-format'.
+
+`org-frame-title-string' is a format string using the same
+specifications than `frame-title-format', which see."
+ :version "24.1"
+ :group 'org-clock
+ :type 'sexp)
+
+(defvar org-clock-in-prepare-hook nil
+ "Hook run when preparing the clock.
+This hook is run before anything happens to the task that
+you want to clock in. For example, you can use this hook
+to add an effort property.")
+(defvar org-clock-in-hook nil
+ "Hook run when starting the clock.")
+(defvar org-clock-out-hook nil
+ "Hook run when stopping the current clock.")
+
+(defvar org-clock-cancel-hook nil
+ "Hook run when cancelling the current clock.")
+(defvar org-clock-goto-hook nil
+ "Hook run when selecting the currently clocked-in entry.")
+(defvar org-clock-has-been-used nil
+ "Has the clock been used during the current Emacs session?")
+
+;;; The clock for measuring work time.
+
+(defvar org-mode-line-string "")
+(put 'org-mode-line-string 'risky-local-variable t)
+
+(defvar org-clock-mode-line-timer nil)
+(defvar org-clock-idle-timer nil)
+(defvar org-clock-heading) ; defined in org.el
+(defvar org-clock-heading-for-remember "")
+(defvar org-clock-start-time "")
+
+(defvar org-clock-leftover-time nil
+ "If non-nil, user cancelled a clock; this is when leftover time started.")
+
+(defvar org-clock-effort ""
+ "Effort estimate of the currently clocking task.")
+
+(defvar org-clock-total-time nil
+ "Holds total time, spent previously on currently clocked item.
+This does not include the time in the currently running clock.")
+
+(defvar org-clock-history nil
+ "List of marker pointing to recent clocked tasks.")
+
+(defvar org-clock-default-task (make-marker)
+ "Marker pointing to the default task that should clock time.
+The clock can be made to switch to this task after clocking out
+of a different task.")
+
+(defvar org-clock-interrupted-task (make-marker)
+ "Marker pointing to the task that has been interrupted by the current clock.")
+
+(defvar org-clock-mode-line-map (make-sparse-keymap))
+(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto)
+(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu)
+
+(defun org-clock-menu ()
+ (interactive)
+ (popup-menu
+ '("Clock"
+ ["Clock out" org-clock-out t]
+ ["Change effort estimate" org-clock-modify-effort-estimate t]
+ ["Go to clock entry" org-clock-goto t]
+ ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"])))
+
+(defun org-clock-history-push (&optional pos buffer)
+ "Push a marker to the clock history."
+ (setq org-clock-history-length (max 1 (min 35 org-clock-history-length)))
+ (let ((m (move-marker (make-marker)
+ (or pos (point)) (org-base-buffer
+ (or buffer (current-buffer)))))
+ n l)
+ (while (setq n (member m org-clock-history))
+ (move-marker (car n) nil))
+ (setq org-clock-history
+ (delq nil
+ (mapcar (lambda (x) (if (marker-buffer x) x nil))
+ org-clock-history)))
+ (when (>= (setq l (length org-clock-history)) org-clock-history-length)
+ (setq org-clock-history
+ (nreverse
+ (nthcdr (- l org-clock-history-length -1)
+ (nreverse org-clock-history)))))
+ (push m org-clock-history)))
+
+(defun org-clock-save-markers-for-cut-and-paste (beg end)
+ "Save relative positions of markers in region."
+ (org-check-and-save-marker org-clock-marker beg end)
+ (org-check-and-save-marker org-clock-hd-marker beg end)
+ (org-check-and-save-marker org-clock-default-task beg end)
+ (org-check-and-save-marker org-clock-interrupted-task beg end)
+ (mapc (lambda (m) (org-check-and-save-marker m beg end))
+ org-clock-history))
+
+(defun org-clocking-buffer ()
+ "Return the clocking buffer if we are currently clocking a task or nil."
+ (marker-buffer org-clock-marker))
+
+(defun org-clocking-p ()
+ "Return t when clocking a task."
+ (not (equal (org-clocking-buffer) nil)))
+
+(defvar org-clock-before-select-task-hook nil
+ "Hook called in task selection just before prompting the user.")
+
+(defun org-clock-select-task (&optional prompt)
+ "Select a task that recently was associated with clocking."
+ (interactive)
+ (let (sel-list rpl (i 0) s)
+ (save-window-excursion
+ (org-switch-to-buffer-other-window
+ (get-buffer-create "*Clock Task Select*"))
+ (erase-buffer)
+ (when (marker-buffer org-clock-default-task)
+ (insert (org-add-props "Default Task\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?d org-clock-default-task))
+ (push s sel-list))
+ (when (marker-buffer org-clock-interrupted-task)
+ (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))
+ (push s sel-list))
+ (when (org-clocking-p)
+ (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?c org-clock-marker))
+ (push s sel-list))
+ (insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
+ (mapc
+ (lambda (m)
+ (when (marker-buffer m)
+ (setq i (1+ i)
+ s (org-clock-insert-selection-line
+ (if (< i 10)
+ (+ i ?0)
+ (+ i (- ?A 10))) m))
+ (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
+ (push s sel-list)))
+ org-clock-history)
+ (run-hooks 'org-clock-before-select-task-hook)
+ (org-fit-window-to-buffer)
+ (message (or prompt "Select task for clocking:"))
+ (setq rpl (read-char-exclusive))
+ (cond
+ ((eq rpl ?q) nil)
+ ((eq rpl ?x) nil)
+ ((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
+ (t (error "Invalid task choice %c" rpl))))))
+
+(defun org-clock-insert-selection-line (i marker)
+ "Insert a line for the clock selection menu.
+And return a cons cell with the selection character integer and the marker
+pointing to it."
+ (when (marker-buffer marker)
+ (let (file cat task heading prefix)
+ (with-current-buffer (org-base-buffer (marker-buffer marker))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (ignore-errors
+ (goto-char marker)
+ (setq file (buffer-file-name (marker-buffer marker))
+ cat (org-get-category)
+ heading (org-get-heading 'notags)
+ prefix (save-excursion
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (match-string 0))
+ task (substring
+ (org-fontify-like-in-org-mode
+ (concat prefix heading)
+ org-odd-levels-only)
+ (length prefix)))))))
+ (when (and cat task)
+ (insert (format "[%c] %-15s %s\n" i cat task))
+ (cons i marker)))))
+
+(defvar org-clock-task-overrun nil
+ "Internal flag indicating if the clock has overrun the planned time.")
+(defvar org-clock-update-period 60
+ "Number of seconds between mode line clock string updates.")
+
+(defun org-clock-get-clock-string ()
+ "Form a clock-string, that will be shown in the mode line.
+If an effort estimate was defined for the current item, use
+01:30/01:50 format (clocked/estimated).
+If not, show simply the clocked time like 01:50."
+ (let* ((clocked-time (org-clock-get-clocked-time))
+ (h (floor clocked-time 60))
+ (m (- clocked-time (* 60 h))))
+ (if org-clock-effort
+ (let* ((effort-in-minutes
+ (org-duration-string-to-minutes org-clock-effort))
+ (effort-h (floor effort-in-minutes 60))
+ (effort-m (- effort-in-minutes (* effort-h 60)))
+ (work-done-str
+ (org-propertize
+ (format org-time-clocksum-format h m)
+ 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
+ 'org-mode-line-clock-overrun 'org-mode-line-clock)))
+ (effort-str (format org-time-clocksum-format effort-h effort-m))
+ (clockstr (org-propertize
+ (concat " [%s/" effort-str
+ "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
+ 'face 'org-mode-line-clock)))
+ (format clockstr work-done-str))
+ (org-propertize (format
+ (concat "[" org-time-clocksum-format " (%s)]")
+ h m org-clock-heading)
+ 'face 'org-mode-line-clock))))
+
+(defun org-clock-update-mode-line ()
+ (if org-clock-effort
+ (org-clock-notify-once-if-expired)
+ (setq org-clock-task-overrun nil))
+ (setq org-mode-line-string
+ (org-propertize
+ (let ((clock-string (org-clock-get-clock-string))
+ (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
+ (if (and (> org-clock-string-limit 0)
+ (> (length clock-string) org-clock-string-limit))
+ (org-propertize
+ (substring clock-string 0 org-clock-string-limit)
+ 'help-echo (concat help-text ": " org-clock-heading))
+ (org-propertize clock-string 'help-echo help-text)))
+ 'local-map org-clock-mode-line-map
+ 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)))
+ (if (and org-clock-task-overrun org-clock-task-overrun-text)
+ (setq org-mode-line-string
+ (concat (org-propertize
+ org-clock-task-overrun-text
+ 'face 'org-mode-line-clock-overrun) org-mode-line-string)))
+ (force-mode-line-update))
+
+(defun org-clock-get-clocked-time ()
+ "Get the clocked time for the current item in minutes.
+The time returned includes the time spent on this task in
+previous clocking intervals."
+ (let ((currently-clocked-time
+ (floor (- (org-float-time)
+ (org-float-time org-clock-start-time)) 60)))
+ (+ currently-clocked-time (or org-clock-total-time 0))))
+
+(defun org-clock-modify-effort-estimate (&optional value)
+ "Add to or set the effort estimate of the item currently being clocked.
+VALUE can be a number of minutes, or a string with format hh:mm or mm.
+When the string starts with a + or a - sign, the current value of the effort
+property will be changed by that amount.
+This will update the \"Effort\" property of currently clocked item, and
+the mode line."
+ (interactive)
+ (if (org-clock-is-active)
+ (let ((current org-clock-effort) sign)
+ (unless value
+ ;; Prompt user for a value or a change
+ (setq value
+ (read-string
+ (format "Set effort (hh:mm or mm%s): "
+ (if current
+ (format ", prefix + to add to %s" org-clock-effort)
+ "")))))
+ (when (stringp value)
+ ;; A string. See if it is a delta
+ (setq sign (string-to-char value))
+ (if (member sign '(?- ?+))
+ (setq current (org-duration-string-to-minutes current)
+ value (substring value 1))
+ (setq current 0))
+ (setq value (org-duration-string-to-minutes value))
+ (if (equal ?- sign)
+ (setq value (- current value))
+ (if (equal ?+ sign) (setq value (+ current value)))))
+ (setq value (max 0 value)
+ org-clock-effort (org-minutes-to-hh:mm-string value))
+ (org-entry-put org-clock-marker "Effort" org-clock-effort)
+ (org-clock-update-mode-line)
+ (message "Effort is now %s" org-clock-effort))
+ (message "Clock is not currently active")))
+
+(defvar org-clock-notification-was-shown nil
+ "Shows if we have shown notification already.")
+
+(defun org-clock-notify-once-if-expired ()
+ "Show notification if we spent more time than we estimated before.
+Notification is shown only once."
+ (when (org-clocking-p)
+ (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort))
+ (clocked-time (org-clock-get-clocked-time)))
+ (if (setq org-clock-task-overrun
+ (if (or (null effort-in-minutes) (zerop effort-in-minutes))
+ nil
+ (>= clocked-time effort-in-minutes)))
+ (unless org-clock-notification-was-shown
+ (setq org-clock-notification-was-shown t)
+ (org-notify
+ (format "Task '%s' should be finished by now. (%s)"
+ org-clock-heading org-clock-effort) t))
+ (setq org-clock-notification-was-shown nil)))))
+
+(defun org-notify (notification &optional play-sound)
+ "Send a NOTIFICATION and maybe PLAY-SOUND."
+ (org-show-notification notification)
+ (if play-sound (org-clock-play-sound)))
+
+(defun org-show-notification (notification)
+ "Show notification.
+Use `org-show-notification-handler' if defined,
+use libnotify if available, or fall back on a message."
+ (cond ((functionp org-show-notification-handler)
+ (funcall org-show-notification-handler notification))
+ ((stringp org-show-notification-handler)
+ (start-process "emacs-timer-notification" nil
+ org-show-notification-handler notification))
+ ((fboundp 'notifications-notify)
+ (notifications-notify
+ :title "Org-mode message"
+ :body notification
+ ;; FIXME how to link to the Org icon?
+ ;; :app-icon "~/.emacs.d/icons/mail.png"
+ :urgency 'low))
+ ((executable-find "notify-send")
+ (start-process "emacs-timer-notification" nil
+ "notify-send" notification))
+ ;; Maybe the handler will send a message, so only use message as
+ ;; a fall back option
+ (t (message "%s" notification))))
+
+(defun org-clock-play-sound ()
+ "Play sound as configured by `org-clock-sound'.
+Use alsa's aplay tool if available."
+ (cond
+ ((not org-clock-sound))
+ ((eq org-clock-sound t) (beep t) (beep t))
+ ((stringp org-clock-sound)
+ (let ((file (expand-file-name org-clock-sound)))
+ (if (file-exists-p file)
+ (if (executable-find "aplay")
+ (start-process "org-clock-play-notification" nil
+ "aplay" file)
+ (condition-case nil
+ (play-sound-file file)
+ (error (beep t) (beep t)))))))))
+
+(defvar org-clock-mode-line-entry nil
+ "Information for the mode line about the running clock.")
+
+(defun org-find-open-clocks (file)
+ "Search through the given file and find all open clocks."
+ (let ((buf (or (get-file-buffer file)
+ (find-file-noselect file)))
+ clocks)
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)
+ (push (cons (copy-marker (match-end 1) t)
+ (org-time-string-to-time (match-string 1))) clocks))))
+ clocks))
+
+(defsubst org-is-active-clock (clock)
+ "Return t if CLOCK is the currently active clock."
+ (and (org-clock-is-active)
+ (= org-clock-marker (car clock))))
+
+(defmacro org-with-clock-position (clock &rest forms)
+ "Evaluate FORMS with CLOCK as the current active clock."
+ `(with-current-buffer (marker-buffer (car ,clock))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (car ,clock))
+ (beginning-of-line)
+ ,@forms))))
+(def-edebug-spec org-with-clock-position (form body))
+(put 'org-with-clock-position 'lisp-indent-function 1)
+
+(defmacro org-with-clock (clock &rest forms)
+ "Evaluate FORMS with CLOCK as the current active clock.
+This macro also protects the current active clock from being altered."
+ `(org-with-clock-position ,clock
+ (let ((org-clock-start-time (cdr ,clock))
+ (org-clock-total-time)
+ (org-clock-history)
+ (org-clock-effort)
+ (org-clock-marker (car ,clock))
+ (org-clock-hd-marker (save-excursion
+ (outline-back-to-heading t)
+ (point-marker))))
+ ,@forms)))
+(def-edebug-spec org-with-clock (form body))
+(put 'org-with-clock 'lisp-indent-function 1)
+
+(defsubst org-clock-clock-in (clock &optional resume start-time)
+ "Clock in to the clock located by CLOCK.
+If necessary, clock-out of the currently active clock."
+ (org-with-clock-position clock
+ (let ((org-clock-in-resume (or resume org-clock-in-resume)))
+ (org-clock-in nil start-time))))
+
+(defsubst org-clock-clock-out (clock &optional fail-quietly at-time)
+ "Clock out of the clock located by CLOCK."
+ (let ((temp (copy-marker (car clock)
+ (marker-insertion-type (car clock)))))
+ (if (org-is-active-clock clock)
+ (org-clock-out nil fail-quietly at-time)
+ (org-with-clock clock
+ (org-clock-out nil fail-quietly at-time)))
+ (setcar clock temp)))
+
+(defsubst org-clock-clock-cancel (clock)
+ "Cancel the clock located by CLOCK."
+ (let ((temp (copy-marker (car clock)
+ (marker-insertion-type (car clock)))))
+ (if (org-is-active-clock clock)
+ (org-clock-cancel)
+ (org-with-clock clock
+ (org-clock-cancel)))
+ (setcar clock temp)))
+
+(defvar org-clock-clocking-in nil)
+(defvar org-clock-resolving-clocks nil)
+(defvar org-clock-resolving-clocks-due-to-idleness nil)
+
+(defun org-clock-resolve-clock (clock resolve-to clock-out-time
+ &optional close-p restart-p fail-quietly)
+ "Resolve `CLOCK' given the time `RESOLVE-TO', and the present.
+`CLOCK' is a cons cell of the form (MARKER START-TIME)."
+ (let ((org-clock-resolving-clocks t))
+ (cond
+ ((null resolve-to)
+ (org-clock-clock-cancel clock)
+ (if (and restart-p (not org-clock-clocking-in))
+ (org-clock-clock-in clock)))
+
+ ((eq resolve-to 'now)
+ (if restart-p
+ (error "RESTART-P is not valid here"))
+ (if (or close-p org-clock-clocking-in)
+ (org-clock-clock-out clock fail-quietly)
+ (unless (org-is-active-clock clock)
+ (org-clock-clock-in clock t))))
+
+ ((not (time-less-p resolve-to (current-time)))
+ (error "RESOLVE-TO must refer to a time in the past"))
+
+ (t
+ (if restart-p
+ (error "RESTART-P is not valid here"))
+ (org-clock-clock-out clock fail-quietly (or clock-out-time
+ resolve-to))
+ (unless org-clock-clocking-in
+ (if close-p
+ (setq org-clock-leftover-time (and (null clock-out-time)
+ resolve-to))
+ (org-clock-clock-in clock nil (and clock-out-time
+ resolve-to))))))))
+
+(defun org-clock-jump-to-current-clock (&optional effective-clock)
+ (interactive)
+ (let ((org-clock-into-drawer (org-clock-into-drawer))
+ (clock (or effective-clock (cons org-clock-marker
+ org-clock-start-time))))
+ (unless (marker-buffer (car clock))
+ (error "No clock is currently running"))
+ (org-with-clock clock (org-clock-goto))
+ (with-current-buffer (marker-buffer (car clock))
+ (goto-char (car clock))
+ (if org-clock-into-drawer
+ (let ((logbook
+ (if (stringp org-clock-into-drawer)
+ (concat ":" org-clock-into-drawer ":")
+ ":LOGBOOK:")))
+ (ignore-errors
+ (outline-flag-region
+ (save-excursion
+ (outline-back-to-heading t)
+ (search-forward logbook)
+ (goto-char (match-beginning 0)))
+ (save-excursion
+ (outline-back-to-heading t)
+ (search-forward logbook)
+ (search-forward ":END:")
+ (goto-char (match-end 0)))
+ nil)))))))
+
+(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
+ "Resolve an open org-mode clock.
+An open clock was found, with `dangling' possibly being non-nil.
+If this function was invoked with a prefix argument, non-dangling
+open clocks are ignored. The given clock requires some sort of
+user intervention to resolve it, either because a clock was left
+dangling or due to an idle timeout. The clock resolution can
+either be:
+
+ (a) deleted, the user doesn't care about the clock
+ (b) restarted from the current time (if no other clock is open)
+ (c) closed, giving the clock X minutes
+ (d) closed and then restarted
+ (e) resumed, as if the user had never left
+
+The format of clock is (CONS MARKER START-TIME), where MARKER
+identifies the buffer and position the clock is open at (and
+thus, the heading it's under), and START-TIME is when the clock
+was started."
+ (assert clock)
+ (let* ((ch
+ (save-window-excursion
+ (save-excursion
+ (unless org-clock-resolving-clocks-due-to-idleness
+ (org-clock-jump-to-current-clock clock))
+ (unless org-clock-resolve-expert
+ (with-output-to-temp-buffer "*Org Clock*"
+ (princ "Select a Clock Resolution Command:
+
+i/q/C-g Ignore this question; the same as keeping all the idle time.
+
+k/K Keep X minutes of the idle time (default is all). If this
+ amount is less than the default, you will be clocked out
+ that many minutes after the time that idling began, and then
+ clocked back in at the present time.
+g/G Indicate that you \"got back\" X minutes ago. This is quite
+ different from 'k': it clocks you out from the beginning of
+ the idle period and clock you back in X minutes ago.
+s/S Subtract the idle time from the current clock. This is the
+ same as keeping 0 minutes.
+C Cancel the open timer altogether. It will be as though you
+ never clocked in.
+j/J Jump to the current clock, to make manual adjustments.
+
+For all these options, using uppercase makes your final state
+to be CLOCKED OUT.")))
+ (org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
+ (let (char-pressed)
+ (when (featurep 'xemacs)
+ (message (concat (funcall prompt-fn clock)
+ " [jkKgGsScCiq]? "))
+ (setq char-pressed (read-char-exclusive)))
+ (while (or (null char-pressed)
+ (and (not (memq char-pressed
+ '(?k ?K ?g ?G ?s ?S ?C
+ ?j ?J ?i ?q)))
+ (or (ding) t)))
+ (setq char-pressed
+ (read-char (concat (funcall prompt-fn clock)
+ " [jkKgGSscCiq]? ")
+ nil 45)))
+ (and (not (memq char-pressed '(?i ?q))) char-pressed)))))
+ (default
+ (floor (/ (org-float-time
+ (time-subtract (current-time) last-valid)) 60)))
+ (keep
+ (and (memq ch '(?k ?K))
+ (read-number "Keep how many minutes? " default)))
+ (gotback
+ (and (memq ch '(?g ?G))
+ (read-number "Got back how many minutes ago? " default)))
+ (subtractp (memq ch '(?s ?S)))
+ (barely-started-p (< (- (org-float-time last-valid)
+ (org-float-time (cdr clock))) 45))
+ (start-over (and subtractp barely-started-p)))
+ (cond
+ ((memq ch '(?j ?J))
+ (if (eq ch ?J)
+ (org-clock-resolve-clock clock 'now nil t nil fail-quietly))
+ (org-clock-jump-to-current-clock clock))
+ ((or (null ch)
+ (not (memq ch '(?k ?K ?g ?G ?s ?S ?C))))
+ (message ""))
+ (t
+ (org-clock-resolve-clock
+ clock (cond
+ ((or (eq ch ?C)
+ ;; If the time on the clock was less than a minute before
+ ;; the user went away, and they've ask to subtract all the
+ ;; time...
+ start-over)
+ nil)
+ ((or subtractp
+ (and gotback (= gotback 0)))
+ last-valid)
+ ((or (and keep (= keep default))
+ (and gotback (= gotback default)))
+ 'now)
+ (keep
+ (time-add last-valid (seconds-to-time (* 60 keep))))
+ (gotback
+ (time-subtract (current-time)
+ (seconds-to-time (* 60 gotback))))
+ (t
+ (error "Unexpected, please report this as a bug")))
+ (and gotback last-valid)
+ (memq ch '(?K ?G ?S))
+ (and start-over
+ (not (memq ch '(?K ?G ?S ?C))))
+ fail-quietly)))))
+
+(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
+ "Resolve all currently open org-mode clocks.
+If `only-dangling-p' is non-nil, only ask to resolve dangling
+\(i.e., not currently open and valid) clocks."
+ (interactive "P")
+ (unless org-clock-resolving-clocks
+ (let ((org-clock-resolving-clocks t))
+ (dolist (file (org-files-list))
+ (let ((clocks (org-find-open-clocks file)))
+ (dolist (clock clocks)
+ (let ((dangling (or (not (org-clock-is-active))
+ (/= (car clock) org-clock-marker))))
+ (if (or (not only-dangling-p) dangling)
+ (org-clock-resolve
+ clock
+ (or prompt-fn
+ (function
+ (lambda (clock)
+ (format
+ "Dangling clock started %d mins ago"
+ (floor
+ (/ (- (org-float-time (current-time))
+ (org-float-time (cdr clock))) 60))))))
+ (or last-valid
+ (cdr clock)))))))))))
+
+(defun org-emacs-idle-seconds ()
+ "Return the current Emacs idle time in seconds, or nil if not idle."
+ (let ((idle-time (current-idle-time)))
+ (if idle-time
+ (org-float-time idle-time)
+ 0)))
+
+(defun org-mac-idle-seconds ()
+ "Return the current Mac idle time in seconds."
+ (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))
+
+(defvar org-x11idle-exists-p
+ ;; Check that x11idle exists
+ (and (eq window-system 'x)
+ (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0)
+ ;; Check that x11idle can retrieve the idle time
+ (eq (call-process-shell-command "x11idle" nil nil nil) 0)))
+
+(defun org-x11-idle-seconds ()
+ "Return the current X11 idle time in seconds."
+ (/ (string-to-number (shell-command-to-string "x11idle")) 1000))
+
+(defun org-user-idle-seconds ()
+ "Return the number of seconds the user has been idle for.
+This routine returns a floating point number."
+ (cond
+ ((eq system-type 'darwin)
+ (org-mac-idle-seconds))
+ ((and (eq window-system 'x) org-x11idle-exists-p)
+ (org-x11-idle-seconds))
+ (t
+ (org-emacs-idle-seconds))))
+
+(defvar org-clock-user-idle-seconds)
+
+(defun org-resolve-clocks-if-idle ()
+ "Resolve all currently open org-mode clocks.
+This is performed after `org-clock-idle-time' minutes, to check
+if the user really wants to stay clocked in after being idle for
+so long."
+ (when (and org-clock-idle-time (not org-clock-resolving-clocks)
+ org-clock-marker)
+ (let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
+ (org-clock-user-idle-start
+ (time-subtract (current-time)
+ (seconds-to-time org-clock-user-idle-seconds)))
+ (org-clock-resolving-clocks-due-to-idleness t))
+ (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))
+ (org-clock-resolve
+ (cons org-clock-marker
+ org-clock-start-time)
+ (function
+ (lambda (clock)
+ (format "Clocked in & idle for %.1f mins"
+ (/ (org-float-time
+ (time-subtract (current-time)
+ org-clock-user-idle-start))
+ 60.0))))
+ org-clock-user-idle-start)))))
+
+(defvar org-clock-current-task nil
+ "Task currently clocked in.")
+(defun org-clock-set-current ()
+ "Set `org-clock-current-task' to the task currently clocked in."
+ (setq org-clock-current-task (nth 4 (org-heading-components))))
+
+(defun org-clock-delete-current ()
+ "Reset `org-clock-current-task' to nil."
+ (setq org-clock-current-task nil))
+
+(defvar org-clock-out-time nil) ; store the time of the last clock-out
+(defun org-clock-in (&optional select start-time)
+ "Start the clock on the current item.
+If necessary, clock-out of the currently active clock.
+With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked
+tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task
+and mark it as the default task, a special task that will always be offered
+in the clocking selection, associated with the letter `d'.
+When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \
+clock in by using the last clock-out
+time as the start time \(see `org-clock-continuously' to
+make this the default behavior.)"
+ (interactive "P")
+ (setq org-clock-notification-was-shown nil)
+ (catch 'abort
+ (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
+ (org-clocking-p)))
+ ts selected-task target-pos (msg-extra "")
+ (leftover (and (not org-clock-resolving-clocks)
+ org-clock-leftover-time)))
+
+ (when (and org-clock-auto-clock-resolution
+ (or (not interrupting)
+ (eq t org-clock-auto-clock-resolution))
+ (not org-clock-clocking-in)
+ (not org-clock-resolving-clocks))
+ (setq org-clock-leftover-time nil)
+ (let ((org-clock-clocking-in t))
+ (org-resolve-clocks))) ; check if any clocks are dangling
+
+ (when (equal select '(64))
+ ;; Set start-time to `org-clock-out-time'
+ (let ((org-clock-continuously t))
+ (org-clock-in nil org-clock-out-time)))
+
+ (when (equal select '(4))
+ (setq selected-task (org-clock-select-task "Clock-in on task: "))
+ (if selected-task
+ (setq selected-task (copy-marker selected-task))
+ (error "Abort")))
+
+ (when (equal select '(16))
+ ;; Mark as default clocking task
+ (org-clock-mark-default-task))
+
+ (when interrupting
+ ;; We are interrupting the clocking of a different task.
+ ;; Save a marker to this task, so that we can go back.
+ ;; First check if we are trying to clock into the same task!
+ (when (save-excursion
+ (unless selected-task
+ (org-back-to-heading t))
+ (and (equal (marker-buffer org-clock-hd-marker)
+ (if selected-task
+ (marker-buffer selected-task)
+ (current-buffer)))
+ (= (marker-position org-clock-hd-marker)
+ (if selected-task
+ (marker-position selected-task)
+ (point)))
+ (equal org-clock-current-task (nth 4 (org-heading-components)))))
+ (message "Clock continues in \"%s\"" org-clock-heading)
+ (throw 'abort nil))
+ (move-marker org-clock-interrupted-task
+ (marker-position org-clock-marker)
+ (marker-buffer org-clock-marker))
+ (let ((org-clock-clocking-in t))
+ (org-clock-out nil t)))
+
+ ;; Clock in at which position?
+ (setq target-pos
+ (if (and (eobp) (not (org-at-heading-p)))
+ (point-at-bol 0)
+ (point)))
+ (run-hooks 'org-clock-in-prepare-hook)
+ (save-excursion
+ (when (and selected-task (marker-buffer selected-task))
+ ;; There is a selected task, move to the correct buffer
+ ;; and set the new target position.
+ (set-buffer (org-base-buffer (marker-buffer selected-task)))
+ (setq target-pos (marker-position selected-task))
+ (move-marker selected-task nil))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char target-pos)
+ (org-back-to-heading t)
+ (or interrupting (move-marker org-clock-interrupted-task nil))
+ (save-excursion
+ (forward-char) ;; make sure the marker is not at the
+ ;; beginning of the heading, since the
+ ;; user is liking to insert stuff here
+ ;; manually
+ (org-clock-history-push))
+ (org-clock-set-current)
+ (cond ((functionp org-clock-in-switch-to-state)
+ (looking-at org-complex-heading-regexp)
+ (let ((newstate (funcall org-clock-in-switch-to-state
+ (match-string 2))))
+ (if newstate (org-todo newstate))))
+ ((and org-clock-in-switch-to-state
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
+ org-clock-in-switch-to-state
+ "\\>"))))
+ (org-todo org-clock-in-switch-to-state)))
+ (setq org-clock-heading-for-remember
+ (and (looking-at org-complex-heading-regexp)
+ (match-end 4)
+ (org-trim (buffer-substring (match-end 1)
+ (match-end 4)))))
+ (setq org-clock-heading
+ (cond ((and org-clock-heading-function
+ (functionp org-clock-heading-function))
+ (funcall org-clock-heading-function))
+ ((and (looking-at org-complex-heading-regexp)
+ (match-string 4))
+ (replace-regexp-in-string
+ "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
+ (match-string 4)))
+ (t "???")))
+ (setq org-clock-heading (org-propertize org-clock-heading
+ 'face nil))
+ (org-clock-find-position org-clock-in-resume)
+ (cond
+ ((and org-clock-in-resume
+ (looking-at
+ (concat "^[ \t]*" org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (message "Matched %s" (match-string 1))
+ (setq ts (concat "[" (match-string 1) "]"))
+ (goto-char (match-end 1))
+ (setq org-clock-start-time
+ (apply 'encode-time
+ (org-parse-time-string (match-string 1))))
+ (setq org-clock-effort (org-get-effort))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start))))
+ ((eq org-clock-in-resume 'auto-restart)
+ ;; called from org-clock-load during startup,
+ ;; do not interrupt, but warn!
+ (message "Cannot restart clock because task does not contain unfinished clock")
+ (ding)
+ (sit-for 2)
+ (throw 'abort nil))
+ (t
+ (insert-before-markers "\n")
+ (backward-char 1)
+ (org-indent-line)
+ (when (and (save-excursion
+ (end-of-line 0)
+ (org-in-item-p)))
+ (beginning-of-line 1)
+ (org-indent-line-to (- (org-get-indentation) 2)))
+ (insert org-clock-string " ")
+ (setq org-clock-effort (org-get-effort))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start)))
+ (setq org-clock-start-time
+ (or (and org-clock-continuously org-clock-out-time)
+ (and leftover
+ (y-or-n-p
+ (format
+ "You stopped another clock %d mins ago; start this one from then? "
+ (/ (- (org-float-time (current-time))
+ (org-float-time leftover)) 60)))
+ leftover)
+ start-time
+ (current-time)))
+ (setq ts (org-insert-time-stamp org-clock-start-time
+ 'with-hm 'inactive))))
+ (move-marker org-clock-marker (point) (buffer-base-buffer))
+ (move-marker org-clock-hd-marker
+ (save-excursion (org-back-to-heading t) (point))
+ (buffer-base-buffer))
+ (setq org-clock-has-been-used t)
+ ;; add to mode line
+ (when (or (eq org-clock-clocked-in-display 'mode-line)
+ (eq org-clock-clocked-in-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-mode-line-string)))))
+ ;; add to frame title
+ (when (or (eq org-clock-clocked-in-display 'frame-title)
+ (eq org-clock-clocked-in-display 'both))
+ (setq frame-title-format org-clock-frame-title-format))
+ (org-clock-update-mode-line)
+ (when org-clock-mode-line-timer
+ (cancel-timer org-clock-mode-line-timer)
+ (setq org-clock-mode-line-timer nil))
+ (when org-clock-clocked-in-display
+ (setq org-clock-mode-line-timer
+ (run-with-timer org-clock-update-period
+ org-clock-update-period
+ 'org-clock-update-mode-line)))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil))
+ (setq org-clock-idle-timer
+ (run-with-timer 60 60 'org-resolve-clocks-if-idle))
+ (message "Clock starts at %s - %s" ts msg-extra)
+ (run-hooks 'org-clock-in-hook)))))))
+
+;;;###autoload
+(defun org-clock-in-last (&optional arg)
+ "Clock in the last closed clocked item.
+When already clocking in, send an warning.
+With a universal prefix argument, select the task you want to
+clock in from the last clocked in tasks.
+With two universal prefix arguments, start clocking using the
+last clock-out time, if any.
+With three universal prefix arguments, interactively prompt
+for a todo state to switch to, overriding the existing value
+`org-clock-in-switch-to-state'."
+ (interactive "P")
+ (if (equal arg '(4))
+ (org-clock-in (org-clock-select-task))
+ (let ((start-time (if (or org-clock-continuously (equal arg '(16)))
+ (or org-clock-out-time (current-time))
+ (current-time))))
+ (if (null org-clock-history)
+ (message "No last clock")
+ (let ((org-clock-in-switch-to-state
+ (if (and (not org-clock-current-task) (equal arg '(64)))
+ (completing-read "Switch to state: "
+ (and org-clock-history
+ (with-current-buffer
+ (marker-buffer (car org-clock-history))
+ org-todo-keywords-1)))
+ org-clock-in-switch-to-state))
+ (already-clocking org-clock-current-task))
+ (org-clock-clock-in (list (car org-clock-history)) nil start-time)
+ (or already-clocking
+ ;; Don't display a message if we are already clocking in
+ (message "Clocking back: %s (in %s)"
+ org-clock-current-task
+ (buffer-name (marker-buffer org-clock-marker)))))))))
+
+(defun org-clock-mark-default-task ()
+ "Mark current task as default task."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading t)
+ (move-marker org-clock-default-task (point))))
+
+(defvar msg-extra)
+(defun org-clock-get-sum-start ()
+ "Return the time from which clock times should be counted.
+This is for the currently running clock as it is displayed
+in the mode line. This function looks at the properties
+LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the
+corresponding variable `org-clock-modeline-total' and then
+decides which time to use."
+ (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL")
+ (symbol-name org-clock-modeline-total)))
+ (lr (org-entry-get nil "LAST_REPEAT")))
+ (cond
+ ((equal cmt "current")
+ (setq msg-extra "showing time in current clock instance")
+ (current-time))
+ ((equal cmt "today")
+ (setq msg-extra "showing today's task time.")
+ (let* ((dt (decode-time (current-time))))
+ (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
+ (if org-extend-today-until
+ (setf (nth 2 dt) org-extend-today-until))
+ (apply 'encode-time dt)))
+ ((or (equal cmt "all")
+ (and (or (not cmt) (equal cmt "auto"))
+ (not lr)))
+ (setq msg-extra "showing entire task time.")
+ nil)
+ ((or (equal cmt "repeat")
+ (and (or (not cmt) (equal cmt "auto"))
+ lr))
+ (setq msg-extra "showing task time since last repeat.")
+ (if (not lr)
+ nil
+ (org-time-string-to-time lr)))
+ (t nil))))
+
+(defun org-clock-find-position (find-unclosed)
+ "Find the location where the next clock line should be inserted.
+When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
+line and position cursor in that line."
+ (org-back-to-heading t)
+ (catch 'exit
+ (let* ((org-clock-into-drawer (org-clock-into-drawer))
+ (beg (save-excursion
+ (beginning-of-line 2)
+ (or (bolp) (newline))
+ (point)))
+ (end (progn (outline-next-heading) (point)))
+ (re (concat "^[ \t]*" org-clock-string))
+ (cnt 0)
+ (drawer (if (stringp org-clock-into-drawer)
+ org-clock-into-drawer "LOGBOOK"))
+ first last ind-last)
+ (goto-char beg)
+ (when (and find-unclosed
+ (re-search-forward
+ (concat "^[ \t]*" org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
+ end t))
+ (beginning-of-line 1)
+ (throw 'exit t))
+ (when (eobp) (newline) (setq end (max (point) end)))
+ (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t)
+ ;; we seem to have a CLOCK drawer, so go there.
+ (beginning-of-line 2)
+ (or org-log-states-order-reversed
+ (and (re-search-forward org-property-end-re nil t)
+ (goto-char (match-beginning 0))))
+ (throw 'exit t))
+ ;; Lets count the CLOCK lines
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (setq first (or first (match-beginning 0))
+ last (match-beginning 0)
+ cnt (1+ cnt)))
+ (when (and (integerp org-clock-into-drawer)
+ last
+ (>= (1+ cnt) org-clock-into-drawer))
+ ;; Wrap current entries into a new drawer
+ (goto-char last)
+ (setq ind-last (org-get-indentation))
+ (beginning-of-line 2)
+ (if (and (>= (org-get-indentation) ind-last)
+ (org-at-item-p))
+ (when (and (>= (org-get-indentation) ind-last)
+ (org-at-item-p))
+ (let ((struct (org-list-struct)))
+ (goto-char (org-list-get-bottom-point struct)))))
+ (insert ":END:\n")
+ (beginning-of-line 0)
+ (org-indent-line-to ind-last)
+ (goto-char first)
+ (insert ":" drawer ":\n")
+ (beginning-of-line 0)
+ (org-indent-line)
+ (org-flag-drawer t)
+ (beginning-of-line 2)
+ (or org-log-states-order-reversed
+ (and (re-search-forward org-property-end-re nil t)
+ (goto-char (match-beginning 0))))
+ (throw 'exit nil))
+
+ (goto-char beg)
+ (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
+ (not (equal (match-string 1) org-clock-string)))
+ ;; Planning info, skip to after it
+ (beginning-of-line 2)
+ (or (bolp) (newline)))
+ (when (or (eq org-clock-into-drawer t)
+ (stringp org-clock-into-drawer)
+ (and (integerp org-clock-into-drawer)
+ (< org-clock-into-drawer 2)))
+ (insert ":" drawer ":\n:END:\n")
+ (beginning-of-line -1)
+ (org-indent-line)
+ (org-flag-drawer t)
+ (beginning-of-line 2)
+ (org-indent-line)
+ (beginning-of-line)
+ (or org-log-states-order-reversed
+ (and (re-search-forward org-property-end-re nil t)
+ (goto-char (match-beginning 0))))))))
+
+(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
+ "Stop the currently running clock.
+Throw an error if there is no running clock and FAIL-QUIETLY is nil.
+With a universal prefix, prompt for a state to switch the clocked out task
+to, overriding the existing value of `org-clock-out-switch-to-state'."
+ (interactive "P")
+ (catch 'exit
+ (when (not (org-clocking-p))
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
+ (force-mode-line-update)
+ (if fail-quietly (throw 'exit t) (error "No active clock")))
+ (let ((org-clock-out-switch-to-state
+ (if switch-to-state
+ (completing-read "Switch to state: "
+ (with-current-buffer
+ (marker-buffer org-clock-marker)
+ org-todo-keywords-1)
+ nil t "DONE")
+ org-clock-out-switch-to-state))
+ (now (current-time))
+ ts te s h m remove)
+ (setq org-clock-out-time now)
+ (save-excursion ; Do not replace this with `with-current-buffer'.
+ (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (save-restriction
+ (widen)
+ (goto-char org-clock-marker)
+ (beginning-of-line 1)
+ (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
+ (equal (match-string 1) org-clock-string))
+ (setq ts (match-string 2))
+ (if fail-quietly (throw 'exit nil) (error "Clock start time is gone")))
+ (goto-char (match-end 0))
+ (delete-region (point) (point-at-eol))
+ (insert "--")
+ (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
+ (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te)))
+ (org-float-time (apply 'encode-time (org-parse-time-string ts))))
+ h (floor (/ s 3600))
+ s (- s (* 3600 h))
+ m (floor (/ s 60))
+ s (- s (* 60 s)))
+ (insert " => " (format "%2d:%02d" h m))
+ (when (setq remove (and org-clock-out-remove-zero-time-clocks
+ (= (+ h m) 0)))
+ (beginning-of-line 1)
+ (delete-region (point) (point-at-eol))
+ (and (looking-at "\n") (> (point-max) (1+ (point)))
+ (delete-char 1)))
+ (move-marker org-clock-marker nil)
+ (move-marker org-clock-hd-marker nil)
+ (when org-log-note-clock-out
+ (org-add-log-setup 'clock-out nil nil nil nil
+ (concat "# Task: " (org-get-heading t) "\n\n")))
+ (when org-clock-mode-line-timer
+ (cancel-timer org-clock-mode-line-timer)
+ (setq org-clock-mode-line-timer nil))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil))
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
+ (when org-clock-out-switch-to-state
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((org-inhibit-logging t)
+ (org-clock-out-when-done nil))
+ (cond
+ ((functionp org-clock-out-switch-to-state)
+ (looking-at org-complex-heading-regexp)
+ (let ((newstate (funcall org-clock-out-switch-to-state
+ (match-string 2))))
+ (if newstate (org-todo newstate))))
+ ((and org-clock-out-switch-to-state
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
+ org-clock-out-switch-to-state
+ "\\>"))))
+ (org-todo org-clock-out-switch-to-state))))))
+ (force-mode-line-update)
+ (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m
+ (if remove " => LINE REMOVED" ""))
+ (run-hooks 'org-clock-out-hook)
+ (unless (org-clocking-p)
+ (org-clock-delete-current)))))))
+
+(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
+
+(defun org-clock-remove-empty-clock-drawer nil
+ "Remove empty clock drawer in the current subtree."
+ (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
+ org-log-into-drawer))
+ (clock-drawer (if (eq t olid) "LOGBOOK" olid))
+ (end (save-excursion (org-end-of-subtree t t))))
+ (when clock-drawer
+ (save-excursion
+ (org-back-to-heading t)
+ (while (and (< (point) end)
+ (search-forward clock-drawer end t))
+ (goto-char (match-beginning 0))
+ (org-remove-empty-drawer-at clock-drawer (point))
+ (forward-line 1))))))
+
+(defun org-at-clock-log-p nil
+ "Is the cursor on the clock log line?"
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at "^[ \t]*CLOCK:")))
+
+(defun org-clock-timestamps-up nil
+ "Increase CLOCK timestamps at cursor."
+ (interactive)
+ (org-clock-timestamps-change 'up))
+
+(defun org-clock-timestamps-down nil
+ "Increase CLOCK timestamps at cursor."
+ (interactive)
+ (org-clock-timestamps-change 'down))
+
+(defun org-clock-timestamps-change (updown)
+ "Change CLOCK timestamps synchronously at cursor.
+UPDOWN tells whether to change 'up or 'down."
+ (setq org-ts-what nil)
+ (when (org-at-timestamp-p t)
+ (let ((tschange (if (eq updown 'up) 'org-timestamp-up
+ 'org-timestamp-down))
+ ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (save-excursion
+ (move-beginning-of-line 1)
+ (re-search-forward org-ts-regexp3 nil t)
+ (setq ts1 (match-string 0) begts1 (match-beginning 0))
+ (when (re-search-forward org-ts-regexp3 nil t)
+ (setq ts2 (match-string 0) begts2 (match-beginning 0))))
+ ;; Are we on the second timestamp?
+ (if (<= begts2 (point)) (setq updatets1 t))
+ (if (not ts2)
+ ;; fall back on org-timestamp-up if there is only one
+ (funcall tschange)
+ ;; setq this so that (boundp 'org-ts-what is non-nil)
+ (funcall tschange)
+ (let ((ts (if updatets1 ts2 ts1))
+ (begts (if updatets1 begts1 begts2)))
+ (setq tdiff
+ (subtract-time
+ (org-time-string-to-time org-last-changed-timestamp)
+ (org-time-string-to-time ts)))
+ (save-excursion
+ (goto-char begts)
+ (org-timestamp-change
+ (round (/ (org-float-time tdiff)
+ (cond ((eq org-ts-what 'minute) 60)
+ ((eq org-ts-what 'hour) 3600)
+ ((eq org-ts-what 'day) (* 24 3600))
+ ((eq org-ts-what 'month) (* 24 3600 31))
+ ((eq org-ts-what 'year) (* 24 3600 365.2)))))
+ org-ts-what 'updown)))))))
+
+(defun org-clock-cancel ()
+ "Cancel the running clock by removing the start timestamp."
+ (interactive)
+ (when (not (org-clocking-p))
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
+ (force-mode-line-update)
+ (error "No active clock"))
+ (save-excursion ; Do not replace this with `with-current-buffer'.
+ (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (goto-char org-clock-marker)
+ (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
+ (progn (delete-region (1- (point-at-bol)) (point-at-eol))
+ (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (message "Clock gone, cancel the timer anyway")
+ (sit-for 2)))
+ (move-marker org-clock-marker nil)
+ (move-marker org-clock-hd-marker nil)
+ (setq global-mode-string
+ (delq 'org-mode-line-string global-mode-string))
+ (setq frame-title-format org-frame-title-format-backup)
+ (force-mode-line-update)
+ (message "Clock canceled")
+ (run-hooks 'org-clock-cancel-hook))
+
+(defun org-clock-goto (&optional select)
+ "Go to the currently clocked-in entry, or to the most recently clocked one.
+With prefix arg SELECT, offer recently clocked tasks for selection."
+ (interactive "@P")
+ (let* ((recent nil)
+ (m (cond
+ (select
+ (or (org-clock-select-task "Select task to go to: ")
+ (error "No task selected")))
+ ((org-clocking-p) org-clock-marker)
+ ((and org-clock-goto-may-find-recent-task
+ (car org-clock-history)
+ (marker-buffer (car org-clock-history)))
+ (setq recent t)
+ (car org-clock-history))
+ (t (error "No active or recent clock task")))))
+ (org-pop-to-buffer-same-window (marker-buffer m))
+ (if (or (< m (point-min)) (> m (point-max))) (widen))
+ (goto-char m)
+ (org-show-entry)
+ (org-back-to-heading t)
+ (org-cycle-hide-drawers 'children)
+ (recenter)
+ (org-reveal)
+ (if recent
+ (message "No running clock, this is the most recently clocked task"))
+ (run-hooks 'org-clock-goto-hook)))
+
+(defvar org-clock-file-total-minutes nil
+ "Holds the file total time in minutes, after a call to `org-clock-sum'.")
+(make-variable-buffer-local 'org-clock-file-total-minutes)
+
+(defun org-clock-sum-today (&optional headline-filter)
+ "Sum the times for each subtree for today."
+ (interactive)
+ (let ((range (org-clock-special-range 'today)))
+ (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today)))
+
+(defun org-clock-sum (&optional tstart tend headline-filter propname)
+ "Sum the times for each subtree.
+Puts the resulting times in minutes as a text property on each headline.
+TSTART and TEND can mark a time range to be considered.
+HEADLINE-FILTER is a zero-arg function that, if specified, is called for
+each headline in the time range with point at the headline. Headlines for
+which HEADLINE-FILTER returns nil are excluded from the clock summation.
+PROPNAME lets you set a custom text property instead of :org-clock-minutes."
+ (interactive)
+ (let* ((bmp (buffer-modified-p))
+ (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
+ org-clock-string
+ "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
+ (lmax 30)
+ (ltimes (make-vector lmax 0))
+ (t1 0)
+ (level 0)
+ ts te dt
+ time)
+ (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
+ (if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
+ (if (consp tstart) (setq tstart (org-float-time tstart)))
+ (if (consp tend) (setq tend (org-float-time tend)))
+ (remove-text-properties (point-min) (point-max)
+ `(,(or propname :org-clock-minutes) t
+ :org-clock-force-headline-inclusion t))
+ (save-excursion
+ (goto-char (point-max))
+ (while (re-search-backward re nil t)
+ (cond
+ ((match-end 2)
+ ;; Two time stamps
+ (setq ts (match-string 2)
+ te (match-string 3)
+ ts (org-float-time
+ (apply 'encode-time (org-parse-time-string ts)))
+ te (org-float-time
+ (apply 'encode-time (org-parse-time-string te)))
+ ts (if tstart (max ts tstart) ts)
+ te (if tend (min te tend) te)
+ dt (- te ts)
+ t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)))
+ ((match-end 4)
+ ;; A naked time
+ (setq t1 (+ t1 (string-to-number (match-string 5))
+ (* 60 (string-to-number (match-string 4))))))
+ (t ;; A headline
+ ;; Add the currently clocking item time to the total
+ (when (and org-clock-report-include-clocking-task
+ (equal (org-clocking-buffer) (current-buffer))
+ (equal (marker-position org-clock-hd-marker) (point))
+ tstart
+ tend
+ (>= (org-float-time org-clock-start-time) tstart)
+ (<= (org-float-time org-clock-start-time) tend))
+ (let ((time (floor (- (org-float-time)
+ (org-float-time org-clock-start-time)) 60)))
+ (setq t1 (+ t1 time))))
+ (let* ((headline-forced
+ (get-text-property (point)
+ :org-clock-force-headline-inclusion))
+ (headline-included
+ (or (null headline-filter)
+ (save-excursion
+ (save-match-data (funcall headline-filter))))))
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (when (or (> t1 0) (> (aref ltimes level) 0))
+ (when (or headline-included headline-forced)
+ (if headline-included
+ (loop for l from 0 to level do
+ (aset ltimes l (+ (aref ltimes l) t1))))
+ (setq time (aref ltimes level))
+ (goto-char (match-beginning 0))
+ (put-text-property (point) (point-at-eol)
+ (or propname :org-clock-minutes) time)
+ (if headline-filter
+ (save-excursion
+ (save-match-data
+ (while
+ (> (funcall outline-level) 1)
+ (outline-up-heading 1 t)
+ (put-text-property
+ (point) (point-at-eol)
+ :org-clock-force-headline-inclusion t))))))
+ (setq t1 0)
+ (loop for l from level to (1- lmax) do
+ (aset ltimes l 0)))))))
+ (setq org-clock-file-total-minutes (aref ltimes 0)))
+ (set-buffer-modified-p bmp)))
+
+(defun org-clock-sum-current-item (&optional tstart)
+ "Return time, clocked on current item in total."
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-clock-sum tstart)
+ org-clock-file-total-minutes)))
+
+(defun org-clock-display (&optional total-only)
+ "Show subtree times in the entire buffer.
+If TOTAL-ONLY is non-nil, only show the total time for the entire file
+in the echo area.
+
+Use \\[org-clock-remove-overlays] to remove the subtree times."
+ (interactive)
+ (org-clock-remove-overlays)
+ (let (time h m p)
+ (org-clock-sum)
+ (unless total-only
+ (save-excursion
+ (goto-char (point-min))
+ (while (or (and (equal (setq p (point)) (point-min))
+ (get-text-property p :org-clock-minutes))
+ (setq p (next-single-property-change
+ (point) :org-clock-minutes)))
+ (goto-char p)
+ (when (setq time (get-text-property p :org-clock-minutes))
+ (org-clock-put-overlay time (funcall outline-level))))
+ (setq h (/ org-clock-file-total-minutes 60)
+ m (- org-clock-file-total-minutes (* 60 h)))
+ ;; Arrange to remove the overlays upon next change.
+ (when org-remove-highlights-with-change
+ (org-add-hook 'before-change-functions 'org-clock-remove-overlays
+ nil 'local))))
+ (if org-time-clocksum-use-fractional
+ (message (concat "Total file time: " org-time-clocksum-fractional-format
+ " (%d hours and %d minutes)")
+ (/ (+ (* h 60.0) m) 60.0) h m)
+ (message (concat "Total file time: " org-time-clocksum-format
+ " (%d hours and %d minutes)") h m h m))))
+
+(defvar org-clock-overlays nil)
+(make-variable-buffer-local 'org-clock-overlays)
+
+(defun org-clock-put-overlay (time &optional level)
+ "Put an overlays on the current line, displaying TIME.
+If LEVEL is given, prefix time with a corresponding number of stars.
+This creates a new overlay and stores it in `org-clock-overlays', so that it
+will be easy to remove."
+ (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h)))
+ (l (if level (org-get-valid-level level 0) 0))
+ (fmt (concat "%s " (if org-time-clocksum-use-fractional
+ org-time-clocksum-fractional-format
+ org-time-clocksum-format) "%s"))
+ (off 0)
+ ov tx)
+ (org-move-to-column c)
+ (unless (eolp) (skip-chars-backward "^ \t"))
+ (skip-chars-backward " \t")
+ (setq ov (make-overlay (point-at-bol) (point-at-eol))
+ tx (concat (buffer-substring (point-at-bol) (point))
+ (make-string (+ off (max 0 (- c (current-column)))) ?.)
+ (org-add-props (if org-time-clocksum-use-fractional
+ (format fmt
+ (make-string l ?*)
+ (/ (+ (* h 60.0) m) 60.0)
+ (make-string (- 16 l) ?\ ))
+ (format fmt
+ (make-string l ?*) h m
+ (make-string (- 16 l) ?\ )))
+ (list 'face 'org-clock-overlay))
+ ""))
+ (if (not (featurep 'xemacs))
+ (overlay-put ov 'display tx)
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'end-glyph (make-glyph tx)))
+ (push ov org-clock-overlays)))
+
+(defun org-clock-remove-overlays (&optional beg end noremove)
+ "Remove the occur highlights from the buffer.
+BEG and END are ignored. If NOREMOVE is nil, remove this function
+from the `before-change-functions' in the current buffer."
+ (interactive)
+ (unless org-inhibit-highlight-removal
+ (mapc 'delete-overlay org-clock-overlays)
+ (setq org-clock-overlays nil)
+ (unless noremove
+ (remove-hook 'before-change-functions
+ 'org-clock-remove-overlays 'local))))
+
+(defvar org-state) ;; dynamically scoped into this function
+(defun org-clock-out-if-current ()
+ "Clock out if the current entry contains the running clock.
+This is used to stop the clock after a TODO entry is marked DONE,
+and is only done if the variable `org-clock-out-when-done' is not nil."
+ (when (and (org-clocking-p)
+ org-clock-out-when-done
+ (marker-buffer org-clock-marker)
+ (or (and (eq t org-clock-out-when-done)
+ (member org-state org-done-keywords))
+ (and (listp org-clock-out-when-done)
+ (member org-state org-clock-out-when-done)))
+ (equal (or (buffer-base-buffer (org-clocking-buffer))
+ (org-clocking-buffer))
+ (or (buffer-base-buffer (current-buffer))
+ (current-buffer)))
+ (< (point) org-clock-marker)
+ (> (save-excursion (outline-next-heading) (point))
+ org-clock-marker))
+ ;; Clock out, but don't accept a logging message for this.
+ (let ((org-log-note-clock-out nil)
+ (org-clock-out-switch-to-state nil))
+ (org-clock-out))))
+
+(add-hook 'org-after-todo-state-change-hook
+ 'org-clock-out-if-current)
+
+;;;###autoload
+(defun org-get-clocktable (&rest props)
+ "Get a formatted clocktable with parameters according to PROPS.
+The table is created in a temporary buffer, fully formatted and
+fontified, and then returned."
+ ;; Set the defaults
+ (setq props (plist-put props :name "clocktable"))
+ (unless (plist-member props :maxlevel)
+ (setq props (plist-put props :maxlevel 2)))
+ (unless (plist-member props :scope)
+ (setq props (plist-put props :scope 'agenda)))
+ (with-temp-buffer
+ (org-mode)
+ (org-create-dblock props)
+ (org-update-dblock)
+ (font-lock-fontify-buffer)
+ (forward-line 2)
+ (buffer-substring (point) (progn
+ (re-search-forward "^[ \t]*#\\+END" nil t)
+ (point-at-bol)))))
+
+(defun org-clock-report (&optional arg)
+ "Create a table containing a report about clocked time.
+If the cursor is inside an existing clocktable block, then the table
+will be updated. If not, a new clocktable will be inserted. The scope
+of the new clock will be subtree when called from within a subtree, and
+file elsewhere.
+
+When called with a prefix argument, move to the first clock table in the
+buffer and update it."
+ (interactive "P")
+ (org-clock-remove-overlays)
+ (when arg
+ (org-find-dblock "clocktable")
+ (org-show-entry))
+ (if (org-in-clocktable-p)
+ (goto-char (org-in-clocktable-p))
+ (let ((props (if (ignore-errors
+ (save-excursion (org-back-to-heading)))
+ (list :name "clocktable" :scope 'subtree)
+ (list :name "clocktable"))))
+ (org-create-dblock
+ (org-combine-plists org-clock-clocktable-default-properties props))))
+ (org-update-dblock))
+
+(defun org-day-of-week (day month year)
+ "Returns the day of the week as an integer."
+ (nth 6
+ (decode-time
+ (date-to-time
+ (format "%d-%02d-%02dT00:00:00" year month day)))))
+
+(defun org-quarter-to-date (quarter year)
+ "Get the date (week day year) of the first day of a given quarter."
+ (let (startday)
+ (cond
+ ((= quarter 1)
+ (setq startday (org-day-of-week 1 1 year))
+ (cond
+ ((= startday 0)
+ (list 52 7 (- year 1)))
+ ((= startday 6)
+ (list 52 6 (- year 1)))
+ ((<= startday 4)
+ (list 1 startday year))
+ ((> startday 4)
+ (list 53 startday (- year 1)))
+ )
+ )
+ ((= quarter 2)
+ (setq startday (org-day-of-week 1 4 year))
+ (cond
+ ((= startday 0)
+ (list 13 startday year))
+ ((< startday 4)
+ (list 14 startday year))
+ ((>= startday 4)
+ (list 13 startday year))
+ )
+ )
+ ((= quarter 3)
+ (setq startday (org-day-of-week 1 7 year))
+ (cond
+ ((= startday 0)
+ (list 26 startday year))
+ ((< startday 4)
+ (list 27 startday year))
+ ((>= startday 4)
+ (list 26 startday year))
+ )
+ )
+ ((= quarter 4)
+ (setq startday (org-day-of-week 1 10 year))
+ (cond
+ ((= startday 0)
+ (list 39 startday year))
+ ((<= startday 4)
+ (list 40 startday year))
+ ((> startday 4)
+ (list 39 startday year)))))))
+
+(defun org-clock-special-range (key &optional time as-strings)
+ "Return two times bordering a special time range.
+Key is a symbol specifying the range and can be one of `today', `yesterday',
+`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
+A week starts Monday 0:00 and ends Sunday 24:00.
+The range is determined relative to TIME. TIME defaults to the current time.
+The return value is a cons cell with two internal times like the ones
+returned by `current time' or `encode-time'. if AS-STRINGS is non-nil,
+the returned times will be formatted strings."
+ (if (integerp key) (setq key (intern (number-to-string key))))
+ (let* ((tm (decode-time (or time (current-time))))
+ (s 0) (m (nth 1 tm)) (h (nth 2 tm))
+ (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
+ (dow (nth 6 tm))
+ (skey (symbol-name key))
+ (shift 0)
+ (q (cond ((>= (nth 4 tm) 10) 4)
+ ((>= (nth 4 tm) 7) 3)
+ ((>= (nth 4 tm) 4) 2)
+ ((>= (nth 4 tm) 1) 1)))
+ s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
+ interval tmp shiftedy shiftedm shiftedq)
+ (cond
+ ((string-match "^[0-9]+$" skey)
+ (setq y (string-to-number skey) m 1 d 1 key 'year))
+ ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ (setq y (string-to-number (match-string 1 skey))
+ month (string-to-number (match-string 2 skey))
+ d 1 key 'month))
+ ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey)
+ (require 'cal-iso)
+ (setq y (string-to-number (match-string 1 skey))
+ w (string-to-number (match-string 2 skey)))
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (list w 1 y))))
+ (setq d (nth 1 date) month (car date) y (nth 2 date)
+ dow 1
+ key 'week))
+ ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (require 'cal-iso)
+ (setq y (string-to-number (match-string 1 skey)))
+ (setq q (string-to-number (match-string 2 skey)))
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (org-quarter-to-date q y))))
+ (setq d (nth 1 date) month (car date) y (nth 2 date)
+ dow 1
+ key 'quarter))
+ ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ (setq y (string-to-number (match-string 1 skey))
+ month (string-to-number (match-string 2 skey))
+ d (string-to-number (match-string 3 skey))
+ key 'day))
+ ((string-match "\\([-+][0-9]+\\)$" skey)
+ (setq shift (string-to-number (match-string 1 skey))
+ key (intern (substring skey 0 (match-beginning 1))))
+ (if (and (memq key '(quarter thisq)) (> shift 0))
+ (error "Looking forward with quarters isn't implemented"))))
+
+ (when (= shift 0)
+ (cond ((eq key 'yesterday) (setq key 'today shift -1))
+ ((eq key 'lastweek) (setq key 'week shift -1))
+ ((eq key 'lastmonth) (setq key 'month shift -1))
+ ((eq key 'lastyear) (setq key 'year shift -1))
+ ((eq key 'lastq) (setq key 'quarter shift -1))))
+ (cond
+ ((memq key '(day today))
+ (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
+ ((memq key '(week thisweek))
+ (setq diff (+ (* -7 shift) (if (= dow 0) 6 (1- dow)))
+ m 0 h 0 d (- d diff) d1 (+ 7 d)))
+ ((memq key '(month thismonth))
+ (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
+ ((memq key '(quarter thisq))
+ ; compute if this shift remains in this year
+ ; if not, compute how many years and quarters we have to shift (via floor*)
+ ; and compute the shifted years, months and quarters
+ (cond
+ ((< (+ (- q 1) shift) 0) ; shift not in this year
+ (setq interval (* -1 (+ (- q 1) shift)))
+ ; set tmp to ((years to shift) (quarters to shift))
+ (setq tmp (org-floor* interval 4))
+ ; due to the use of floor, 0 quarters actually means 4
+ (if (= 0 (nth 1 tmp))
+ (setq shiftedy (- y (nth 0 tmp))
+ shiftedm 1
+ shiftedq 1)
+ (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+ shiftedm (- 13 (* 3 (nth 1 tmp)))
+ shiftedq (- 5 (nth 1 tmp))))
+ (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
+ ((> (+ q shift) 0) ; shift is within this year
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
+ ((memq key '(year thisyear))
+ (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
+ (t (error "No such time block %s" key)))
+ (setq ts (encode-time s m h d month y)
+ te (encode-time (or s1 s) (or m1 m) (or h1 h)
+ (or d1 d) (or month1 month) (or y1 y)))
+ (setq fm (cdr org-time-stamp-formats))
+ (cond
+ ((memq key '(day today))
+ (setq txt (format-time-string "%A, %B %d, %Y" ts)))
+ ((memq key '(week thisweek))
+ (setq txt (format-time-string "week %G-W%V" ts)))
+ ((memq key '(month thismonth))
+ (setq txt (format-time-string "%B %Y" ts)))
+ ((memq key '(year thisyear))
+ (setq txt (format-time-string "the year %Y" ts)))
+ ((memq key '(quarter thisq))
+ (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
+ )
+ (if as-strings
+ (list (format-time-string fm ts) (format-time-string fm te) txt)
+ (list ts te txt))))
+
+(defun org-count-quarter (n)
+ (cond
+ ((= n 1) "1st")
+ ((= n 2) "2nd")
+ ((= n 3) "3rd")
+ ((= n 4) "4th")))
+
+(defun org-clocktable-shift (dir n)
+ "Try to shift the :block date of the clocktable at point.
+Point must be in the #+BEGIN: line of a clocktable, or this function
+will throw an error.
+DIR is a direction, a symbol `left', `right', `up', or `down'.
+Both `left' and `down' shift the block toward the past, `up' and `right'
+push it toward the future.
+N is the number of shift steps to take. The size of the step depends on
+the currently selected interval size."
+ (setq n (prefix-numeric-value n))
+ (and (memq dir '(left down)) (setq n (- n)))
+ (save-excursion
+ (goto-char (point-at-bol))
+ (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)"))
+ (error "Line needs a :block definition before this command works")
+ (let* ((b (match-beginning 1)) (e (match-end 1))
+ (s (match-string 1))
+ block shift ins y mw d date wp m)
+ (cond
+ ((equal s "yesterday") (setq s "today-1"))
+ ((equal s "lastweek") (setq s "thisweek-1"))
+ ((equal s "lastmonth") (setq s "thismonth-1"))
+ ((equal s "lastyear") (setq s "thisyear-1"))
+ ((equal s "lastq") (setq s "thisq-1")))
+
+ (cond
+ ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s)
+ (setq block (match-string 1 s)
+ shift (if (match-end 2)
+ (string-to-number (match-string 2 s))
+ 0))
+ (setq shift (+ shift n))
+ (setq ins (if (= shift 0) block (format "%s%+d" block shift))))
+ ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s)
+ ;; 1 1 2 3 3 4 4 5 6 6 5 2
+ (setq y (string-to-number (match-string 1 s))
+ wp (and (match-end 3) (match-string 3 s))
+ mw (and (match-end 4) (string-to-number (match-string 4 s)))
+ d (and (match-end 6) (string-to-number (match-string 6 s))))
+ (cond
+ (d (setq ins (format-time-string
+ "%Y-%m-%d"
+ (encode-time 0 0 0 (+ d n) m y))))
+ ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+ (setq ins (format-time-string
+ "%G-W%V"
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0))
+ (require 'cal-iso)
+ ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year
+ (if (> (+ mw n) 4)
+ (setq mw 0
+ y (+ 1 y))
+ ())
+ ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year
+ (if (= (+ mw n) 0)
+ (setq mw 5
+ y (- y 1))
+ ())
+ (setq date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (setq ins (format-time-string
+ (concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
+ (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
+ (mw
+ (setq ins (format-time-string
+ "%Y-%m"
+ (encode-time 0 0 0 1 (+ mw n) y))))
+ (y
+ (setq ins (number-to-string (+ y n))))))
+ (t (error "Cannot shift clocktable block")))
+ (when ins
+ (goto-char b)
+ (insert ins)
+ (delete-region (point) (+ (point) (- e b)))
+ (beginning-of-line 1)
+ (org-update-dblock)
+ t)))))
+
+(defun org-dblock-write:clocktable (params)
+ "Write the standard clocktable."
+ (setq params (org-combine-plists org-clocktable-defaults params))
+ (catch 'exit
+ (let* ((scope (plist-get params :scope))
+ (block (plist-get params :block))
+ (ts (plist-get params :tstart))
+ (te (plist-get params :tend))
+ (link (plist-get params :link))
+ (maxlevel (or (plist-get params :maxlevel) 3))
+ (step (plist-get params :step))
+ (timestamp (plist-get params :timestamp))
+ (formatter (or (plist-get params :formatter)
+ org-clock-clocktable-formatter
+ 'org-clocktable-write-default))
+ cc range-text ipos pos one-file-with-archives
+ scope-is-list tbls level)
+ ;; Check if we need to do steps
+ (when block
+ ;; Get the range text for the header
+ (setq cc (org-clock-special-range block nil t)
+ ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ (when step
+ ;; Write many tables, in steps
+ (unless (or block (and ts te))
+ (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))
+ (org-clocktable-steps params)
+ (throw 'exit nil))
+
+ (setq ipos (point)) ; remember the insertion position
+
+ ;; Get the right scope
+ (setq pos (point))
+ (cond
+ ((and scope (listp scope) (symbolp (car scope)))
+ (setq scope (eval scope)))
+ ((eq scope 'agenda)
+ (setq scope (org-agenda-files t)))
+ ((eq scope 'agenda-with-archives)
+ (setq scope (org-agenda-files t))
+ (setq scope (org-add-archive-files scope)))
+ ((eq scope 'file-with-archives)
+ (setq scope (org-add-archive-files (list (buffer-file-name)))
+ one-file-with-archives t)))
+ (setq scope-is-list (and scope (listp scope)))
+ (if scope-is-list
+ ;; we collect from several files
+ (let* ((files scope)
+ file)
+ (org-agenda-prepare-buffers files)
+ (while (setq file (pop files))
+ (with-current-buffer (find-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (push (org-clock-get-table-data file params) tbls))))))
+ ;; Just from the current file
+ (save-restriction
+ ;; get the right range into the restriction
+ (org-agenda-prepare-buffers (list (buffer-file-name)))
+ (cond
+ ((not scope)) ; use the restriction as it is now
+ ((eq scope 'file) (widen))
+ ((eq scope 'subtree) (org-narrow-to-subtree))
+ ((eq scope 'tree)
+ (while (org-up-heading-safe))
+ (org-narrow-to-subtree))
+ ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
+ (symbol-name scope)))
+ (setq level (string-to-number (match-string 1 (symbol-name scope))))
+ (catch 'exit
+ (while (org-up-heading-safe)
+ (looking-at org-outline-regexp)
+ (if (<= (org-reduced-level (funcall outline-level)) level)
+ (throw 'exit nil))))
+ (org-narrow-to-subtree)))
+ ;; do the table, with no file name.
+ (push (org-clock-get-table-data nil params) tbls)))
+
+ ;; OK, at this point we tbls as a list of tables, one per file
+ (setq tbls (nreverse tbls))
+
+ (setq params (plist-put params :multifile scope-is-list))
+ (setq params (plist-put params :one-file-with-archives
+ one-file-with-archives))
+
+ (funcall formatter ipos tbls params))))
+
+(defun org-clocktable-write-default (ipos tables params)
+ "Write out a clock table at position IPOS in the current buffer.
+TABLES is a list of tables with clocking data as produced by
+`org-clock-get-table-data'. PARAMS is the parameter property list obtained
+from the dynamic block definition."
+ ;; This function looks quite complicated, mainly because there are a
+ ;; lot of options which can add or remove columns. I have massively
+ ;; commented this function, the I hope it is understandable. If
+ ;; someone wants to write their own special formatter, this maybe
+ ;; much easier because there can be a fixed format with a
+ ;; well-defined number of columns...
+ (let* ((hlchars '((1 . "*") (2 . "/")))
+ (lwords (assoc (or (plist-get params :lang)
+ org-export-default-language)
+ org-clock-clocktable-language-setup))
+ (multifile (plist-get params :multifile))
+ (block (plist-get params :block))
+ (ts (plist-get params :tstart))
+ (te (plist-get params :tend))
+ (header (plist-get params :header))
+ (narrow (plist-get params :narrow))
+ (link (plist-get params :link))
+ (maxlevel (or (plist-get params :maxlevel) 3))
+ (emph (plist-get params :emphasize))
+ (level-p (plist-get params :level))
+ (timestamp (plist-get params :timestamp))
+ (properties (plist-get params :properties))
+ (ntcol (max 1 (or (plist-get params :tcolumns) 100)))
+ (rm-file-column (plist-get params :one-file-with-archives))
+ (indent (plist-get params :indent))
+ (case-fold-search t)
+ range-text total-time tbl level hlc formula pcol
+ file-time entries entry headline
+ recalc content narrow-cut-p tcol)
+
+ ;; Implement abbreviations
+ (when (plist-get params :compact)
+ (setq level nil indent t narrow (or narrow '40!) ntcol 1))
+
+ ;; Some consistency test for parameters
+ (unless (integerp ntcol)
+ (setq params (plist-put params :tcolumns (setq ntcol 100))))
+
+ (when (and narrow (integerp narrow) link)
+ ;; We cannot have both integer narrow and link
+ (message
+ "Using hard narrowing in clocktable to allow for links")
+ (setq narrow (intern (format "%d!" narrow))))
+
+ (when narrow
+ (cond
+ ((integerp narrow))
+ ((and (symbolp narrow)
+ (string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
+ (setq narrow-cut-p t
+ narrow (string-to-number (substring (symbol-name narrow)
+ 0 -1))))
+ (t
+ (error "Invalid value %s of :narrow property in clock table"
+ narrow))))
+
+ (when block
+ ;; Get the range text for the header
+ (setq range-text (nth 2 (org-clock-special-range block nil t))))
+
+ ;; Compute the total time
+ (setq total-time (apply '+ (mapcar 'cadr tables)))
+
+ ;; Now we need to output this tsuff
+ (goto-char ipos)
+
+ ;; Insert the text *before* the actual table
+ (insert-before-markers
+ (or header
+ ;; Format the standard header
+ (concat
+ (nth 9 lwords) " ["
+ (substring
+ (format-time-string (cdr org-time-stamp-formats))
+ 1 -1)
+ "]"
+ (if block (concat ", for " range-text ".") "")
+ "\n\n")))
+
+ ;; Insert the narrowing line
+ (when (and narrow (integerp narrow) (not narrow-cut-p))
+ (insert-before-markers
+ "|" ; table line starter
+ (if multifile "|" "") ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
+ (format "<%d>| |\n" narrow))) ; headline and time columns
+
+ ;; Insert the table header line
+ (insert-before-markers
+ "|" ; table line starter
+ (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
+ (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
+ (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
+ (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
+ (concat (nth 4 lwords) "|"
+ (nth 5 lwords) "|\n")) ; headline and time columns
+
+ ;; Insert the total time in the table
+ (insert-before-markers
+ "|-\n" ; a hline
+ "|" ; table line starter
+ (if multifile (concat "| " (nth 6 lwords) " ") "")
+ ; file column, maybe
+ (if level-p "|" "") ; level column, maybe
+ (if timestamp "|" "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ; properties columns, maybe
+ (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline
+ (format org-clock-total-time-cell-format
+ (org-minutes-to-hh:mm-string (or total-time 0))) ; the time
+ "|\n") ; close line
+
+ ;; Now iterate over the tables and insert the data
+ ;; but only if any time has been collected
+ (when (and total-time (> total-time 0))
+
+ (while (setq tbl (pop tables))
+ ;; now tbl is the table resulting from one file.
+ (setq file-time (nth 1 tbl))
+ (when (or (and file-time (> file-time 0))
+ (not (plist-get params :fileskip0)))
+ (insert-before-markers "|-\n") ; a hline because a new file starts
+ ;; First the file time, if we have multiple files
+ (when multifile
+ ;; Summarize the time collected from this file
+ (insert-before-markers
+ (format (concat "| %s %s | %s%s"
+ (format org-clock-file-time-cell-format (nth 8 lwords))
+ " | *%s*|\n")
+ (file-name-nondirectory (car tbl))
+ (if level-p "| " "") ; level column, maybe
+ (if timestamp "| " "") ; timestamp column, maybe
+ (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
+ (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
+
+ ;; Get the list of node entries and iterate over it
+ (setq entries (nth 2 tbl))
+ (while (setq entry (pop entries))
+ (setq level (car entry)
+ headline (nth 1 entry)
+ hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
+ (when narrow-cut-p
+ (if (and (string-match (concat "\\`" org-bracket-link-regexp
+ "\\'")
+ headline)
+ (match-end 3))
+ (setq headline
+ (format "[[%s][%s]]"
+ (match-string 1 headline)
+ (org-shorten-string (match-string 3 headline)
+ narrow)))
+ (setq headline (org-shorten-string headline narrow))))
+ (insert-before-markers
+ "|" ; start the table line
+ (if multifile "|" "") ; free space for file name column?
+ (if level-p (format "%d|" (car entry)) "") ; level, maybe
+ (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
+ (if properties
+ (concat
+ (mapconcat
+ (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
+ properties "|") "|") "") ;properties columns, maybe
+ (if indent (org-clocktable-indent-string level) "") ; indentation
+ hlc headline hlc "|" ; headline
+ (make-string (min (1- ntcol) (or (- level 1))) ?|)
+ ; empty fields for higher levels
+ hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
+ "|\n" ; close line
+ )))))
+ ;; When exporting subtrees or regions the region might be
+ ;; activated, so let's disable ̀delete-active-region'
+ (let ((delete-active-region nil)) (backward-delete-char 1))
+ (if (setq formula (plist-get params :formula))
+ (cond
+ ((eq formula '%)
+ ;; compute the column where the % numbers need to go
+ (setq pcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)
+ (min maxlevel (or ntcol 100))))
+ ;; compute the column where the total time is
+ (setq tcol (+ 2
+ (if multifile 1 0)
+ (if level-p 1 0)
+ (if timestamp 1 0)))
+ (insert
+ (format
+ "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
+ pcol ; the column where the % numbers should go
+ (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
+ tcol ; column of the total time
+ tcol (1- pcol) ; range of columns where times can be found
+ ))
+ (setq recalc t))
+ ((stringp formula)
+ (insert "\n#+TBLFM: " formula)
+ (setq recalc t))
+ (t (error "Invalid formula in clocktable")))
+ ;; Should we rescue an old formula?
+ (when (stringp (setq content (plist-get params :content)))
+ (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content)
+ (setq recalc t)
+ (insert "\n" (match-string 1 (plist-get params :content)))
+ (beginning-of-line 0))))
+ ;; Back to beginning, align the table, recalculate if necessary
+ (goto-char ipos)
+ (skip-chars-forward "^|")
+ (org-table-align)
+ (when org-hide-emphasis-markers
+ ;; we need to align a second time
+ (org-table-align))
+ (when recalc
+ (if (eq formula '%)
+ (save-excursion
+ (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
+ (org-table-goto-column pcol nil 'force)
+ (insert "%")))
+ (org-table-recalculate 'all))
+ (when rm-file-column
+ ;; The file column is actually not wanted
+ (forward-char 1)
+ (org-table-delete-column))
+ total-time))
+
+(defun org-clocktable-indent-string (level)
+ (if (= level 1)
+ ""
+ (let ((str "\\__"))
+ (while (> level 2)
+ (setq level (1- level)
+ str (concat str "___")))
+ (concat str " "))))
+
+(defun org-clocktable-steps (params)
+ "Step through the range to make a number of clock tables."
+ (let* ((p1 (copy-sequence params))
+ (ts (plist-get p1 :tstart))
+ (te (plist-get p1 :tend))
+ (step0 (plist-get p1 :step))
+ (step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
+ (stepskip0 (plist-get p1 :stepskip0))
+ (block (plist-get p1 :block))
+ cc range-text step-time)
+ (when block
+ (setq cc (org-clock-special-range block nil t)
+ ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ (cond
+ ((numberp ts)
+ ;; If ts is a number, it's an absolute day number from org-agenda.
+ (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts)
+ (setq ts (org-float-time (encode-time 0 0 0 day month year)))))
+ (ts
+ (setq ts (org-float-time
+ (apply 'encode-time (org-parse-time-string ts))))))
+ (cond
+ ((numberp te)
+ ;; Likewise for te.
+ (destructuring-bind (month day year) (calendar-gregorian-from-absolute te)
+ (setq te (org-float-time (encode-time 0 0 0 day month year)))))
+ (te
+ (setq te (org-float-time
+ (apply 'encode-time (org-parse-time-string te))))))
+ (setq p1 (plist-put p1 :header ""))
+ (setq p1 (plist-put p1 :step nil))
+ (setq p1 (plist-put p1 :block nil))
+ (while (< ts te)
+ (or (bolp) (insert "\n"))
+ (setq p1 (plist-put p1 :tstart (format-time-string
+ (org-time-stamp-format nil t)
+ (seconds-to-time ts))))
+ (setq p1 (plist-put p1 :tend (format-time-string
+ (org-time-stamp-format nil t)
+ (seconds-to-time (setq ts (+ ts step))))))
+ (insert "\n" (if (eq step0 'day) "Daily report: "
+ "Weekly report starting on: ")
+ (plist-get p1 :tstart) "\n")
+ (setq step-time (org-dblock-write:clocktable p1))
+ (re-search-forward "^[ \t]*#\\+END:")
+ (when (and (equal step-time 0) stepskip0)
+ ;; Remove the empty table
+ (delete-region (point-at-bol)
+ (save-excursion
+ (re-search-backward "^\\(Daily\\|Weekly\\) report"
+ nil t)
+ (point))))
+ (end-of-line 0))))
+
+(defun org-clock-get-table-data (file params)
+ "Get the clocktable data for file FILE, with parameters PARAMS.
+FILE is only for identification - this function assumes that
+the correct buffer is current, and that the wanted restriction is
+in place.
+The return value will be a list with the file name and the total
+file time (in minutes) as 1st and 2nd elements. The third element
+of this list will be a list of headline entries. Each entry has the
+following structure:
+
+ (LEVEL HEADLINE TIMESTAMP TIME)
+
+LEVEL: The level of the headline, as an integer. This will be
+ the reduced leve, so 1,2,3,... even if only odd levels
+ are being used.
+HEADLINE: The text of the headline. Depending on PARAMS, this may
+ already be formatted like a link.
+TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
+ entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
+ in this sequence.
+TIME: The sum of all time spend in this tree, in minutes. This time
+ will of cause be restricted to the time block and tags match
+ specified in PARAMS."
+ (let* ((maxlevel (or (plist-get params :maxlevel) 3))
+ (timestamp (plist-get params :timestamp))
+ (ts (plist-get params :tstart))
+ (te (plist-get params :tend))
+ (block (plist-get params :block))
+ (link (plist-get params :link))
+ (tags (plist-get params :tags))
+ (properties (plist-get params :properties))
+ (inherit-property-p (plist-get params :inherit-props))
+ todo-only
+ (matcher (if tags (cdr (org-make-tags-matcher tags))))
+ cc range-text st p time level hdl props tsp tbl)
+
+ (setq org-clock-file-total-minutes nil)
+ (when block
+ (setq cc (org-clock-special-range block nil t)
+ ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
+ (when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
+ (when (and ts (listp ts))
+ (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts))))
+ (when (and te (listp te))
+ (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
+ ;; Now the times are strings we can parse.
+ (if ts (setq ts (org-float-time
+ (apply 'encode-time (org-parse-time-string ts)))))
+ (if te (setq te (org-float-time
+ (apply 'encode-time (org-parse-time-string te)))))
+ (save-excursion
+ (org-clock-sum ts te
+ (unless (null matcher)
+ (lambda ()
+ (let* ((tags-list (org-get-tags-at))
+ (org-scanner-tags tags-list)
+ (org-trust-scanner-tags t))
+ (eval matcher)))))
+ (goto-char (point-min))
+ (setq st t)
+ (while (or (and (bobp) (prog1 st (setq st nil))
+ (get-text-property (point) :org-clock-minutes)
+ (setq p (point-min)))
+ (setq p (next-single-property-change
+ (point) :org-clock-minutes)))
+ (goto-char p)
+ (when (setq time (get-text-property p :org-clock-minutes))
+ (save-excursion
+ (beginning-of-line 1)
+ (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
+ (setq level (org-reduced-level
+ (- (match-end 1) (match-beginning 1))))
+ (<= level maxlevel))
+ (setq hdl (if (not link)
+ (match-string 2)
+ (org-make-link-string
+ (format "file:%s::%s"
+ (buffer-file-name)
+ (save-match-data
+ (org-make-org-heading-search-string
+ (match-string 2))))
+ (match-string 2)))
+ tsp (when timestamp
+ (setq props (org-entry-properties (point)))
+ (or (cdr (assoc "SCHEDULED" props))
+ (cdr (assoc "DEADLINE" props))
+ (cdr (assoc "TIMESTAMP" props))
+ (cdr (assoc "TIMESTAMP_IA" props))))
+ props (when properties
+ (remove nil
+ (mapcar
+ (lambda (p)
+ (when (org-entry-get (point) p inherit-property-p)
+ (cons p (org-entry-get (point) p inherit-property-p))))
+ properties))))
+ (when (> time 0) (push (list level hdl tsp time props) tbl))))))
+ (setq tbl (nreverse tbl))
+ (list file org-clock-file-total-minutes tbl))))
+
+(defun org-clock-time% (total &rest strings)
+ "Compute a time fraction in percent.
+TOTAL s a time string like 10:21 specifying the total times.
+STRINGS is a list of strings that should be checked for a time.
+The first string that does have a time will be used.
+This function is made for clock tables."
+ (let ((re "\\([0-9]+\\):\\([0-9]+\\)")
+ tot s)
+ (save-match-data
+ (catch 'exit
+ (if (not (string-match re total))
+ (throw 'exit 0.)
+ (setq tot (+ (string-to-number (match-string 2 total))
+ (* 60 (string-to-number (match-string 1 total)))))
+ (if (= tot 0.) (throw 'exit 0.)))
+ (while (setq s (pop strings))
+ (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
+ (throw 'exit
+ (/ (* 100.0 (+ (string-to-number (match-string 2 s))
+ (* 60 (string-to-number
+ (match-string 1 s)))))
+ tot))))
+ 0))))
+
+;; Saving and loading the clock
+
+(defvar org-clock-loaded nil
+ "Was the clock file loaded?")
+
+(defun org-clock-save ()
+ "Persist various clock-related data to disk.
+The details of what will be saved are regulated by the variable
+`org-clock-persist'."
+ (when (and org-clock-persist
+ (or org-clock-loaded
+ org-clock-has-been-used
+ (not (file-exists-p org-clock-persist-file))))
+ (let (b)
+ (with-current-buffer (find-file (expand-file-name org-clock-persist-file))
+ (progn
+ (delete-region (point-min) (point-max))
+ ;;Store clock
+ (insert (format ";; org-persist.el - %s at %s\n"
+ system-name (format-time-string
+ (cdr org-time-stamp-formats))))
+ (if (and (memq org-clock-persist '(t clock))
+ (setq b (org-clocking-buffer))
+ (setq b (or (buffer-base-buffer b) b))
+ (buffer-live-p b)
+ (buffer-file-name b)
+ (or (not org-clock-persist-query-save)
+ (y-or-n-p (concat "Save current clock ("
+ (substring-no-properties
+ org-clock-heading)
+ ") "))))
+ (insert "(setq resume-clock '(\""
+ (buffer-file-name (org-clocking-buffer))
+ "\" . " (int-to-string (marker-position org-clock-marker))
+ "))\n"))
+ ;; Store clocked task history. Tasks are stored reversed to make
+ ;; reading simpler
+ (when (and (memq org-clock-persist '(t history))
+ org-clock-history)
+ (insert
+ "(setq stored-clock-history '("
+ (mapconcat
+ (lambda (m)
+ (when (and (setq b (marker-buffer m))
+ (setq b (or (buffer-base-buffer b) b))
+ (buffer-live-p b)
+ (buffer-file-name b))
+ (concat "(\"" (buffer-file-name b)
+ "\" . " (int-to-string (marker-position m))
+ ")")))
+ (reverse org-clock-history) " ") "))\n"))
+ (save-buffer)
+ (kill-buffer (current-buffer)))))))
+
+(defun org-clock-load ()
+ "Load clock-related data from disk, maybe resuming a stored clock."
+ (when (and org-clock-persist (not org-clock-loaded))
+ (let ((filename (expand-file-name org-clock-persist-file))
+ (org-clock-in-resume 'auto-restart)
+ resume-clock stored-clock-history)
+ (if (not (file-readable-p filename))
+ (message "Not restoring clock data; %s not found"
+ org-clock-persist-file)
+ (message "%s" "Restoring clock data")
+ (setq org-clock-loaded t)
+ (load-file filename)
+ ;; load history
+ (when stored-clock-history
+ (save-window-excursion
+ (mapc (lambda (task)
+ (if (file-exists-p (car task))
+ (org-clock-history-push (cdr task)
+ (find-file (car task)))))
+ stored-clock-history)))
+ ;; resume clock
+ (when (and resume-clock org-clock-persist
+ (file-exists-p (car resume-clock))
+ (or (not org-clock-persist-query-resume)
+ (y-or-n-p
+ (concat
+ "Resume clock ("
+ (with-current-buffer (find-file (car resume-clock))
+ (save-excursion
+ (goto-char (cdr resume-clock))
+ (org-back-to-heading t)
+ (and (looking-at org-complex-heading-regexp)
+ (match-string 4))))
+ ") "))))
+ (when (file-exists-p (car resume-clock))
+ (with-current-buffer (find-file (car resume-clock))
+ (goto-char (cdr resume-clock))
+ (let ((org-clock-auto-clock-resolution nil))
+ (org-clock-in)
+ (if (outline-invisible-p)
+ (org-show-context))))))))))
+
+;;;###autoload
+(defun org-clock-persistence-insinuate ()
+ "Set up hooks for clock persistence."
+ (add-hook 'org-mode-hook 'org-clock-load)
+ (add-hook 'kill-emacs-hook 'org-clock-save))
+
+;; Suggested bindings
+(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
+
+(provide 'org-clock)
+
+;;; org-clock.el ends here
diff --git a/lisp/org-colview-xemacs.el b/lisp/org-colview-xemacs.el
new file mode 100644
index 0000000..3da7f8d
--- /dev/null
+++ b/lisp/org-colview-xemacs.el
@@ -0,0 +1,1720 @@
+;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
+
+;; Copyright (C) 2004-2012
+;; Carsten Dominik
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of Org mode, it is not part of GNU Emacs.
+;;
+;; You can redistribute it and/or modify it under the terms of the
+;; GNU General Public License as published by the Free Software
+;; Foundation; either version 3, or (at your option) any later
+;; version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this file; see the file COPYING.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the column view for Org.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org)
+
+(declare-function org-agenda-redo "org-agenda" ())
+
+
+;;; Define additional faces for column view
+
+(when (featurep 'xemacs)
+
+ (defface org-columns-level-1;; font-lock-function-name-face
+ (org-compatible-face
+ 'outline-1
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1" :background "grey90"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue" :background "grey30"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue" :background "grey30"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t))))
+ "Face used for columns-level 1 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-2;; font-lock-variable-name-face
+ (org-compatible-face
+ 'outline-2
+ '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod" :background "grey30"))
+ (((class color) (min-colors 8) (background light)) (:foreground "yellow" :background "grey90"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
+ (t (:bold t))))
+ "Face used for columns-level 2 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-3;; font-lock-keyword-face
+ (org-compatible-face
+ 'outline-3
+ '((((class color) (min-colors 88) (background light)) (:foreground "Purple" :background "grey90"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1" :background "grey30"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Purple" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Cyan" :background "grey30"))
+ (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
+ (t (:bold t))))
+ "Face used for columns-level 3 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-4;; font-lock-comment-face
+ (org-compatible-face
+ 'outline-4
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick" :background "grey90"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1" :background "grey30"))
+ (((class color) (min-colors 16) (background light)) (:foreground "red"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t))))
+ "Face used for columns-level 4 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-5;; font-lock-type-face
+ (org-compatible-face
+ 'outline-5
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :background "grey30"))
+ (((class color) (min-colors 8)) (:foreground "green"))))
+ "Face used for columns-level 5 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-6;; font-lock-constant-face
+ (org-compatible-face
+ 'outline-6
+ '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine" :background "grey30"))
+ (((class color) (min-colors 8)) (:foreground "magenta"))))
+ "Face used for columns-level 6 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-7;; font-lock-builtin-face
+ (org-compatible-face
+ 'outline-7
+ '((((class color) (min-colors 16) (background light)) (:foreground "Orchid" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue" :background "grey30"))
+ (((class color) (min-colors 8)) (:foreground "blue"))))
+ "Face used for columns-level 7 headlines."
+ :group 'org-faces)
+
+ (defface org-columns-level-8;; font-lock-string-face
+ (org-compatible-face
+ 'outline-8
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown" :background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon" :background "grey30"))
+ (((class color) (min-colors 8)) (:foreground "green"))))
+ "Face used for columns-level 8 headlines."
+ :group 'org-faces)
+
+
+ (defface org-columns-space;; font-lock-function-name-face
+ (org-compatible-face
+ 'outline-1
+ '((((class color) (min-colors 88) (background light)) (:background "grey90"))
+ (((class color) (min-colors 88) (background dark)) (:background "grey30"))
+ (((class color) (min-colors 16) (background light)) (:background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:background "grey30"))
+ (((class color) (min-colors 8)) (:bold t :underline t))))
+ "Face used for columns space headlines."
+ :group 'org-faces)
+
+ (defface org-columns-space1;; font-lock-function-name-face
+ (org-compatible-face
+ 'outline-1
+ '((((class color) (min-colors 88) (background light)) (:background "grey90"))
+ (((class color) (min-colors 88) (background dark)) (:background "grey30"))
+ (((class color) (min-colors 16) (background light)) (:background "grey90"))
+ (((class color) (min-colors 16) (background dark)) (:background "grey30"))
+ (((class color) (min-colors 8)) (:bold t :underline t))))
+ "Face used for columns space headlines."
+ :group 'org-faces)
+ )
+
+(when (featurep 'xemacs)
+ (defconst org-columns-level-faces
+ '(org-columns-level-1
+ org-columns-level-2 org-columns-level-3
+ org-columns-level-4 org-columns-level-5 org-columns-level-6
+ org-columns-level-7 org-columns-level-8
+ ))
+
+ (defun org-get-columns-level-face (n)
+ "Get the right face for match N in font-lock matching of headlines."
+ (setq org-l (- (match-end 2) (match-beginning 1) 1))
+ (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
+ (setq org-f (nth (% (1- org-l) org-n-level-faces) org-columns-level-faces))
+ (cond
+ ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
+ ((eq n 2) org-f)
+ (t (if org-level-color-stars-only nil org-f))))
+ )
+
+
+;;; Column View
+
+(defvar org-columns-overlays nil
+ "Holds the list of current column overlays.")
+
+(defvar org-columns-current-fmt nil
+ "Local variable, holds the currently active column format.")
+(make-variable-buffer-local 'org-columns-current-fmt)
+(defvar org-columns-current-fmt-compiled nil
+ "Local variable, holds the currently active column format.
+This is the compiled version of the format.")
+(make-variable-buffer-local 'org-columns-current-fmt-compiled)
+(defvar org-columns-current-widths nil
+ "Local variable, holds the currently widths of fields.")
+(make-variable-buffer-local 'org-columns-current-widths)
+(defvar org-columns-current-maxwidths nil
+ "Local variable, holds the currently active maximum column widths.")
+(make-variable-buffer-local 'org-columns-current-maxwidths)
+(defvar org-columns-begin-marker (make-marker)
+ "Points to the position where last a column creation command was called.")
+(defvar org-columns-top-level-marker (make-marker)
+ "Points to the position where current columns region starts.")
+
+(defvar org-columns-map (make-sparse-keymap)
+ "The keymap valid in column display.")
+
+(defun org-columns-content ()
+ "Switch to contents view while in columns view."
+ (interactive)
+ (org-overview)
+ (org-content))
+
+(org-defkey org-columns-map "c" 'org-columns-content)
+(org-defkey org-columns-map "o" 'org-overview)
+(org-defkey org-columns-map "e" 'org-columns-edit-value)
+(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
+(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle)
+(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
+(org-defkey org-columns-map "v" 'org-columns-show-value)
+(org-defkey org-columns-map "q" 'org-columns-quit)
+(org-defkey org-columns-map "r" 'org-columns-redo)
+(org-defkey org-columns-map "g" 'org-columns-redo)
+(org-defkey org-columns-map [left] 'org-columns-backward-char)
+(org-defkey org-columns-map "\M-b" 'org-columns-backward-char)
+(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
+(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
+(org-defkey org-columns-map "\M-f" 'org-columns-forward-char)
+(org-defkey org-columns-map [right] 'org-columns-forward-char)
+(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
+(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
+(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "<" 'org-columns-narrow)
+(org-defkey org-columns-map ">" 'org-columns-widen)
+(org-defkey org-columns-map [(meta right)] 'org-columns-move-right)
+(org-defkey org-columns-map [(meta left)] 'org-columns-move-left)
+(org-defkey org-columns-map [(shift meta right)] 'org-columns-new)
+(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
+(dotimes (i 10)
+ (org-defkey org-columns-map (number-to-string i)
+ `(lambda () (interactive)
+ (org-columns-next-allowed-value nil ,i))))
+
+(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
+ '("Column"
+ ["Edit property" org-columns-edit-value t]
+ ["Next allowed value" org-columns-next-allowed-value t]
+ ["Previous allowed value" org-columns-previous-allowed-value t]
+ ["Show full value" org-columns-show-value t]
+ ["Edit allowed values" org-columns-edit-allowed t]
+ "--"
+ ["Edit column attributes" org-columns-edit-attributes t]
+ ["Increase column width" org-columns-widen t]
+ ["Decrease column width" org-columns-narrow t]
+ "--"
+ ["Move column right" org-columns-move-right t]
+ ["Move column left" org-columns-move-left t]
+ ["Add column" org-columns-new t]
+ ["Delete column" org-columns-delete t]
+ "--"
+ ["CONTENTS" org-columns-content t]
+ ["OVERVIEW" org-overview t]
+ ["Refresh columns display" org-columns-redo t]
+ "--"
+ ["Open link" org-columns-open-link t]
+ "--"
+ ["Quit" org-columns-quit t]))
+
+(defun org-columns-current-column ()
+ (if (featurep 'xemacs)
+ (/ (current-column) 2)
+ (current-column)))
+
+(defun org-columns-forward-char ()
+ (interactive)
+ (forward-char)
+ (if (featurep 'xemacs)
+ (while (not (or (eolp)
+ (member (extent-at
+ (point) (current-buffer)
+ 'org-columns-key) org-columns-overlays)))
+ (forward-char))))
+
+(defun org-columns-backward-char ()
+ (interactive)
+ (backward-char)
+ (if (featurep 'xemacs)
+ (while (not (or (bolp)
+ (member (extent-at (point) (current-buffer) 'org-columns-key) org-columns-overlays)))
+ (backward-char))))
+
+(defun org-columns-new-overlay (beg end &optional string face)
+ "Create a new column overlay and add it to the list."
+ (let ((ov (make-overlay beg end)))
+ (if (featurep 'xemacs)
+ (progn
+ (overlay-put ov 'face (or face 'org-columns-space1))
+ (overlay-put ov 'start-open t)
+ (if string
+ (org-overlay-display ov string (or face 'org-columns-space1))))
+ (overlay-put ov 'face (or face 'secondary-selection))
+ (org-overlay-display ov string face))
+ (push ov org-columns-overlays)
+ ov))
+
+(defun org-columns-display-here (&optional props)
+ "Overlay the current line with column display."
+ (interactive)
+ (let* ((fmt org-columns-current-fmt-compiled)
+ (beg (point-at-bol))
+ (level-face (save-excursion
+ (beginning-of-line 1)
+ (and (looking-at "\\(\\**\\)\\(\\* \\)")
+ (org-get-level-face 2))))
+ (item (save-match-data
+ (org-remove-tabs
+ (buffer-substring-no-properties
+ (point-at-bol) (point-at-eol)))))
+ (color (if (featurep 'xemacs)
+ (save-excursion
+ (beginning-of-line 1)
+ (and (looking-at "\\(\\**\\)\\(\\* \\)")
+ (org-get-columns-level-face 2)))
+ (list :foreground
+ (face-attribute
+ (or level-face
+ (and (eq major-mode 'org-agenda-mode)
+ (get-text-property (point-at-bol) 'face))
+ 'default) :foreground))))
+ (face (if (featurep 'xemacs) color (list color 'org-column)))
+ (pl (- (point)
+ (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
+ (point))))
+ (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
+ pom property ass width f string ov column val modval s2 title calc)
+ ;; Check if the entry is in another buffer.
+ (unless props
+ (if (eq major-mode 'org-agenda-mode)
+ (setq pom (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))
+ props (if pom (org-entry-properties pom) nil))
+ (setq props (org-entry-properties nil))))
+ ;; Walk the format
+ (while (setq column (pop fmt))
+ (setq property (car column)
+ title (nth 1 column)
+ ass (if (equal property "ITEM")
+ (cons "ITEM" item)
+ (assoc property props))
+ width (or (cdr (assoc property org-columns-current-maxwidths))
+ (nth 2 column)
+ (length property))
+ f (format (if (featurep 'xemacs) "%%-%d.%ds |" "%%-%d.%ds | ")
+ width width)
+ val (or (cdr ass) "")
+ calc (nth 7 column)
+ modval (cond ((and org-columns-modify-value-for-display-function
+ (functionp
+ org-columns-modify-value-for-display-function))
+ (funcall org-columns-modify-value-for-display-function
+ title val))
+ ((equal property "ITEM")
+ (if (derived-mode-p 'org-mode)
+ (org-columns-cleanup-item
+ val org-columns-current-fmt-compiled)))
+ ((and calc (functionp calc)
+ (not (string= val ""))
+ (not (get-text-property 0 'org-computed val)))
+ (org-columns-number-to-string
+ (funcall calc (org-columns-string-to-number
+ val (nth 4 column)))
+ (nth 4 column)))))
+ (setq s2 (org-columns-add-ellipses (or modval val) width))
+ (setq string (format f s2))
+ ;; Create the overlay
+ (org-unmodified
+ (setq ov (org-columns-new-overlay
+ beg (setq beg (1+ beg)) string face))
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'org-columns-key property)
+ (overlay-put ov 'org-columns-value (cdr ass))
+ (overlay-put ov 'org-columns-value-modified modval)
+ (overlay-put ov 'org-columns-pom pom)
+ (overlay-put ov 'org-columns-format f)
+ (when (featurep 'xemacs)
+ (if (or (not (char-after beg))
+ (equal (char-after beg) ?\n))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char beg)
+ (org-unmodified (insert " "))
+ ;; FIXME: add props and remove later?
+ )))
+ (goto-char beg)
+ (org-columns-new-overlay
+ beg (1+ beg) nil 'org-columns-space)
+ (setq beg (1+ beg))))
+
+ (if (or (not (char-after beg))
+ (equal (char-after beg) ?\n))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char beg)
+ ;; FIXME: add props and remove later?
+ (org-unmodified (insert " "))))))
+ ;; Make the rest of the line disappear.
+ (org-unmodified
+ (setq ov (org-columns-new-overlay beg (point-at-eol)))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'intangible t)
+ (push ov org-columns-overlays)
+ (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+ (overlay-put ov 'keymap org-columns-map)
+ (push ov org-columns-overlays)
+ (let ((inhibit-read-only t))
+ (put-text-property (max (point-min) (1- (point-at-bol)))
+ (min (point-max) (1+ (point-at-eol)))
+ 'read-only "Type `e' to edit property")))))
+
+(defun org-columns-add-ellipses (string width)
+ "Truncate STRING with WIDTH characters, with ellipses."
+ (cond
+ ((<= (length string) width) string)
+ ((<= width (length org-columns-ellipses))
+ (substring org-columns-ellipses 0 width))
+ (t (concat (substring string 0 (- width (length org-columns-ellipses)))
+ org-columns-ellipses))))
+
+(defvar org-columns-full-header-line-format nil
+ "The full header line format, will be shifted by horizontal scrolling." )
+(defvar org-previous-header-line-format nil
+ "The header line format before column view was turned on.")
+(defvar org-columns-inhibit-recalculation nil
+ "Inhibit recomputing of columns on column view startup.")
+
+
+(defvar header-line-format)
+(defvar org-columns-previous-hscroll 0)
+
+(defun org-columns-display-here-title ()
+ "Overlay the newline before the current line with the table title."
+ (interactive)
+ (let ((fmt org-columns-current-fmt-compiled)
+ string (title "")
+ property width f column str widths)
+ (while (setq column (pop fmt))
+ (setq property (car column)
+ str (or (nth 1 column) property)
+ width (or (cdr (assoc property org-columns-current-maxwidths))
+ (nth 2 column)
+ (length str))
+ widths (push width widths)
+ f (format "%%-%d.%ds | " width width)
+ string (format f str)
+ title (concat title string)))
+ (if (featurep 'xemacs)
+ (let ((ext (make-extent nil nil)))
+ (set-extent-endpoints ext 0 (length title) title)
+ (set-extent-face ext (list 'bold 'underline 'org-columns-space1))
+ (org-set-local 'org-previous-header-line-format
+ (specifier-specs top-gutter))
+ (org-set-local 'org-columns-current-widths (nreverse widths))
+ (set-specifier top-gutter (make-gutter-specifier
+ (cons (current-buffer) title))))
+ (setq title (concat
+ (org-add-props " " nil 'display '(space :align-to 0))
+ (org-add-props title nil 'face '(:weight bold :underline t))))
+ (org-set-local 'org-previous-header-line-format header-line-format)
+ (org-set-local 'org-columns-current-widths (nreverse widths))
+ (setq org-columns-full-header-line-format title)
+ (setq org-columns-previous-hscroll -1)
+ (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))))
+
+(defun org-columns-hscoll-title ()
+ "Set the `header-line-format' so that it scrolls along with the table."
+ (sit-for .0001) ; need to force a redisplay to update window-hscroll
+ (when (not (= (window-hscroll) org-columns-previous-hscroll))
+ (setq header-line-format
+ (concat (substring org-columns-full-header-line-format 0 1)
+ (substring org-columns-full-header-line-format
+ (1+ (window-hscroll))))
+ org-columns-previous-hscroll (window-hscroll))
+ (force-mode-line-update)))
+
+(defvar org-colview-initial-truncate-line-value nil
+ "Remember the value of `truncate-lines' across colview.")
+
+(defun org-columns-remove-overlays ()
+ "Remove all currently active column overlays."
+ (interactive)
+ (when (marker-buffer org-columns-begin-marker)
+ (with-current-buffer (marker-buffer org-columns-begin-marker)
+ (when (local-variable-p 'org-previous-header-line-format (current-buffer))
+ (if (featurep 'xemacs)
+ (set-specifier top-gutter
+ (make-gutter-specifier
+ (cons (current-buffer)
+ (cdar org-previous-header-line-format))))
+ (setq header-line-format org-previous-header-line-format)
+ (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
+ (kill-local-variable 'org-previous-header-line-format))
+ (move-marker org-columns-begin-marker nil)
+ (move-marker org-columns-top-level-marker nil)
+ (org-unmodified
+ (mapc 'delete-overlay org-columns-overlays)
+ (setq org-columns-overlays nil)
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(read-only t))))
+ (when (local-variable-p 'org-colview-initial-truncate-line-value
+ (current-buffer))
+ (setq truncate-lines org-colview-initial-truncate-line-value)))))
+
+
+(defun org-columns-cleanup-item (item fmt)
+ "Remove from ITEM what is a column in the format FMT."
+ (if (not org-complex-heading-regexp)
+ item
+ (when (string-match org-complex-heading-regexp item)
+ (setq item
+ (concat
+ (org-add-props (match-string 1 item) nil
+ 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+ (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+ " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
+ (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
+ (add-text-properties
+ 0 (1+ (match-end 1))
+ (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ item)
+ item)))
+
+(defun org-columns-compact-links (s)
+ "Replace [[link][desc]] with [desc] or [link]."
+ (while (string-match org-bracket-link-regexp s)
+ (setq s (replace-match
+ (concat "[" (match-string (if (match-end 3) 3 1) s) "]")
+ t t s)))
+ s)
+
+(defun org-columns-show-value ()
+ "Show the full value of the property."
+ (interactive)
+ (let ((value (get-char-property (point) 'org-columns-value)))
+ (message "Value is: %s" (or value ""))))
+
+(defvar org-agenda-columns-active) ;; defined in org-agenda.el
+
+(defun org-columns-quit ()
+ "Remove the column overlays and in this way exit column editing."
+ (interactive)
+ (org-unmodified
+ (org-columns-remove-overlays)
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(read-only t))))
+ (when (eq major-mode 'org-agenda-mode)
+ (setq org-agenda-columns-active nil)
+ (message
+ "Modification not yet reflected in Agenda buffer, use `r' to refresh")))
+
+(defun org-columns-check-computed ()
+ "Check if this column value is computed.
+If yes, throw an error indicating that changing it does not make sense."
+ (let ((val (get-char-property (point) 'org-columns-value)))
+ (when (and (stringp val)
+ (get-char-property 0 'org-computed val))
+ (error "This value is computed from the entry's children"))))
+
+(defun org-columns-todo (&optional arg)
+ "Change the TODO state during column view."
+ (interactive "P")
+ (org-columns-edit-value "TODO"))
+
+(defun org-columns-set-tags-or-toggle (&optional arg)
+ "Toggle checkbox at point, or set tags for current headline."
+ (interactive "P")
+ (if (string-match "\\`\\[[ xX-]\\]\\'"
+ (get-char-property (point) 'org-columns-value))
+ (org-columns-next-allowed-value)
+ (org-columns-edit-value "TAGS")))
+
+(defun org-columns-edit-value (&optional key)
+ "Edit the value of the property at point in column view.
+Where possible, use the standard interface for changing this line."
+ (interactive)
+ (org-columns-check-computed)
+ (let* ((col (current-column))
+ (key (or key (get-char-property (point) 'org-columns-key)))
+ (value (get-char-property (point) 'org-columns-value))
+ (bol (point-at-bol)) (eol (point-at-eol))
+ (pom (or (get-text-property bol 'org-hd-marker)
+ (point))) ; keep despite of compiler warning
+ (line-overlays
+ (delq nil (mapcar (lambda (x)
+ (and (eq (overlay-buffer x) (current-buffer))
+ (>= (overlay-start x) bol)
+ (<= (overlay-start x) eol)
+ x))
+ org-columns-overlays)))
+ (org-columns-time (time-to-number-of-days (current-time)))
+ nval eval allowed)
+ (cond
+ ((equal key "CLOCKSUM")
+ (error "This special column cannot be edited"))
+ ((equal key "ITEM")
+ (setq eval '(org-with-point-at pom (org-edit-headline))))
+ ((equal key "TODO")
+ (setq eval '(org-with-point-at
+ pom
+ (call-interactively 'org-todo))))
+ ((equal key "PRIORITY")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-priority))))
+ ((equal key "TAGS")
+ (setq eval '(org-with-point-at
+ pom
+ (let ((org-fast-tag-selection-single-key
+ (if (eq org-fast-tag-selection-single-key 'expert)
+ t org-fast-tag-selection-single-key)))
+ (call-interactively 'org-set-tags)))))
+ ((equal key "DEADLINE")
+ (setq eval '(org-with-point-at
+ pom
+ (call-interactively 'org-deadline))))
+ ((equal key "SCHEDULED")
+ (setq eval '(org-with-point-at
+ pom
+ (call-interactively 'org-schedule))))
+ (t
+ (setq allowed (org-property-get-allowed-values pom key 'table))
+ (if allowed
+ (setq nval (org-icompleting-read
+ "Value: " allowed nil
+ (not (get-text-property 0 'org-unrestricted
+ (caar allowed)))))
+ (setq nval (read-string "Edit: " value)))
+ (setq nval (org-trim nval))
+ (when (not (equal nval value))
+ (setq eval '(org-entry-put pom key nval)))))
+ (when eval
+
+ (cond
+ ((equal major-mode 'org-agenda-mode)
+ (org-columns-eval eval)
+ ;; The following let preserves the current format, and makes sure
+ ;; that in only a single file things need to be upated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties
+ (max (point-min) (1- bol)) eol '(read-only t)))
+ (unwind-protect
+ (progn
+ (setq org-columns-overlays
+ (org-delete-all line-overlays org-columns-overlays))
+ (mapc 'delete-overlay line-overlays)
+ (org-columns-eval eval))
+ (org-columns-display-here)))
+ (org-move-to-column col)
+ (if (and (derived-mode-p 'org-mode)
+ (nth 3 (assoc key org-columns-current-fmt-compiled)))
+ (org-columns-update key)))))))
+
+(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
+ "Edit the current headline, the part without TODO keyword, TAGS."
+ (org-back-to-heading)
+ (when (looking-at org-todo-line-regexp)
+ (let ((pos (point))
+ (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+ (txt (match-string 3))
+ (post "")
+ txt2)
+ (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt)
+ (setq post (match-string 0 txt)
+ txt (substring txt 0 (match-beginning 0))))
+ (setq txt2 (read-string "Edit: " txt))
+ (when (not (equal txt txt2))
+ (goto-char pos)
+ (insert pre txt2 post)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil t)))))
+
+(defun org-columns-edit-allowed ()
+ "Edit the list of allowed values for the current property."
+ (interactive)
+ (let* ((pom (or (org-get-at-bol 'org-marker)
+ (org-get-at-bol 'org-hd-marker)
+ (point)))
+ (key (get-char-property (point) 'org-columns-key))
+ (key1 (concat key "_ALL"))
+ (allowed (org-entry-get pom key1 t))
+ nval)
+ ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
+ ;; FIXME: Write back to #+PROPERTY setting if that is needed.
+ (setq nval (read-string "Allowed: " allowed))
+ (org-entry-put
+ (cond ((marker-position org-entry-property-inherited-from)
+ org-entry-property-inherited-from)
+ ((marker-position org-columns-top-level-marker)
+ org-columns-top-level-marker)
+ (t pom))
+ key1 nval)))
+
+(defun org-columns-eval (form)
+ (let (hidep)
+ (save-excursion
+ (beginning-of-line 1)
+ ;; `next-line' is needed here, because it skips invisible line.
+ (condition-case nil (org-no-warnings (next-line 1)) (error nil))
+ (setq hidep (org-at-heading-p 1)))
+ (eval form)
+ (and hidep (hide-entry))))
+
+(defun org-columns-previous-allowed-value ()
+ "Switch to the previous allowed value for this column."
+ (interactive)
+ (org-columns-next-allowed-value t))
+
+(defun org-columns-next-allowed-value (&optional previous nth)
+ "Switch to the next allowed value for this column.
+When PREVIOUS is set, go to the previous value. When NTH is
+an integer, select that value."
+ (interactive)
+ (org-columns-check-computed)
+ (let* ((col (current-column))
+ (key (get-char-property (point) 'org-columns-key))
+ (value (get-char-property (point) 'org-columns-value))
+ (bol (point-at-bol)) (eol (point-at-eol))
+ (pom (or (get-text-property bol 'org-hd-marker)
+ (point))) ; keep despite of compiler waring
+ (line-overlays
+ (delq nil (mapcar (lambda (x)
+ (and (eq (overlay-buffer x) (current-buffer))
+ (>= (overlay-start x) bol)
+ (<= (overlay-start x) eol)
+ x))
+ org-columns-overlays)))
+ (allowed (or (org-property-get-allowed-values pom key)
+ (and (memq
+ (nth 4 (assoc key org-columns-current-fmt-compiled))
+ '(checkbox checkbox-n-of-m checkbox-percent))
+ '("[ ]" "[X]"))
+ (org-colview-construct-allowed-dates value)))
+ nval)
+ (when (integerp nth)
+ (setq nth (1- nth))
+ (if (= nth -1) (setq nth 9)))
+ (when (equal key "ITEM")
+ (error "Cannot edit item headline from here"))
+ (unless (or allowed (member key '("SCHEDULED" "DEADLINE")))
+ (error "Allowed values for this property have not been defined"))
+ (if (member key '("SCHEDULED" "DEADLINE"))
+ (setq nval (if previous 'earlier 'later))
+ (if previous (setq allowed (reverse allowed)))
+ (cond
+ (nth
+ (setq nval (nth nth allowed))
+ (if (not nval)
+ (error "There are only %d allowed values for property `%s'"
+ (length allowed) key)))
+ ((member value allowed)
+ (setq nval (or (car (cdr (member value allowed)))
+ (car allowed)))
+ (if (equal nval value)
+ (error "Only one allowed value for this property")))
+ (t (setq nval (car allowed)))))
+ (cond
+ ((equal major-mode 'org-agenda-mode)
+ (org-columns-eval '(org-entry-put pom key nval))
+ ;; The following let preserves the current format, and makes sure
+ ;; that in only a single file things need to be upated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (remove-text-properties (1- bol) eol '(read-only t))
+ (unwind-protect
+ (progn
+ (setq org-columns-overlays
+ (org-delete-all line-overlays org-columns-overlays))
+ (mapc 'delete-overlay line-overlays)
+ (org-columns-eval '(org-entry-put pom key nval)))
+ (org-columns-display-here)))
+ (org-move-to-column col)
+ (and (nth 3 (assoc key org-columns-current-fmt-compiled))
+ (org-columns-update key))))))
+
+(defun org-colview-construct-allowed-dates (s)
+ "Construct a list of three dates around the date in S.
+This respects the format of the time stamp in S, active or non-active,
+and also including time or not. S must be just a time stamp, no text
+around it."
+ (when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
+ (let* ((time (org-parse-time-string s 'nodefaults))
+ (active (equal (string-to-char s) ?<))
+ (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
+ time-before time-after)
+ (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (setf (car time) (or (car time) 0))
+ (setf (nth 1 time) (or (nth 1 time) 0))
+ (setf (nth 2 time) (or (nth 2 time) 0))
+ (setq time-before (copy-sequence time))
+ (setq time-after (copy-sequence time))
+ (setf (nth 3 time-before) (1- (nth 3 time)))
+ (setf (nth 3 time-after) (1+ (nth 3 time)))
+ (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
+ (list time-before time time-after)))))
+
+(defun org-verify-version (task)
+ (cond
+ ((eq task 'columns)
+ (if (or (and (featurep 'xemacs) (not (featurep 'org-colview-xemacs)))
+ (and (not (featurep 'xemacs)) (< emacs-major-version 22)))
+ (error "This version of Emacs cannot run Column View")))))
+
+(defun org-columns-open-link (&optional arg)
+ (interactive "P")
+ (let ((value (get-char-property (point) 'org-columns-value)))
+ (org-open-link-from-string value arg)))
+
+(defun org-columns-get-format-and-top-level ()
+ (let (fmt)
+ (when (condition-case nil (org-back-to-heading) (error nil))
+ (setq fmt (org-entry-get nil "COLUMNS" t)))
+ (setq fmt (or fmt org-columns-default-format))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (org-columns-compile-format fmt)
+ (if (marker-position org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker
+ org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker (point)))
+ fmt))
+
+(defun org-columns ()
+ "Turn on column view on an org-mode file."
+ (interactive)
+ (org-verify-version 'columns)
+ (when (featurep 'xemacs)
+ (set-face-foreground 'org-columns-space
+ (face-background 'org-columns-space)))
+ (org-columns-remove-overlays)
+ (move-marker org-columns-begin-marker (point))
+ (let ((org-columns-time (time-to-number-of-days (current-time)))
+ beg end fmt cache maxwidths)
+ (setq fmt (org-columns-get-format-and-top-level))
+ (save-excursion
+ (goto-char org-columns-top-level-marker)
+ (setq beg (point))
+ (unless org-columns-inhibit-recalculation
+ (org-columns-compute-all))
+ (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
+ (point-max)))
+ ;; Get and cache the properties
+ (goto-char beg)
+ (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (org-clock-sum))))
+ (while (re-search-forward org-outline-regexp-bol end t)
+ (if (and org-columns-skip-archived-trees
+ (looking-at (concat ".*:" org-archive-tag ":")))
+ (org-end-of-subtree t)
+ (push (cons (org-current-line) (org-entry-properties)) cache)))
+ (when cache
+ (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
+ (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-columns-display-here-title)
+ (unless (local-variable-p 'org-colview-initial-truncate-line-value
+ (current-buffer))
+ (org-set-local 'org-colview-initial-truncate-line-value
+ truncate-lines))
+ (setq truncate-lines t)
+ (mapc (lambda (x)
+ (org-goto-line (car x))
+ (org-columns-display-here (cdr x)))
+ cache)))))
+
+(eval-when-compile (defvar org-columns-time))
+
+(defvar org-columns-compile-map
+ '(("none" none +)
+ (":" add_times +)
+ ("+" add_numbers +)
+ ("$" currency +)
+ ("X" checkbox +)
+ ("X/" checkbox-n-of-m +)
+ ("X%" checkbox-percent +)
+ ("max" max_numbers max)
+ ("min" min_numbers min)
+ ("mean" mean_numbers
+ (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+ (":max" max_times max)
+ (":min" min_times min)
+ (":mean" mean_times
+ (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+ ("@min" min_age min (lambda (x) (- org-columns-time x)))
+ ("@max" max_age max (lambda (x) (- org-columns-time x)))
+ ("@mean" mean_age
+ (lambda (&rest x) (/ (apply '+ x) (float (length x))))
+ (lambda (x) (- org-columns-time x)))
+ ("est+" estimate org-estimate-combine))
+ "Operator <-> format,function,calc map.
+Used to compile/uncompile columns format and completing read in
+interactive function `org-columns-new'.
+
+ operator string used in #+COLUMNS definition describing the
+ summary type
+ format symbol describing summary type selected interactively in
+ `org-columns-new' and internally in
+ `org-columns-number-to-string' and
+ `org-columns-string-to-number'
+ function called with a list of values as argument to calculate
+ the summary value
+ calc function called on every element before summarizing. This is
+ optional and should only be specified if needed")
+
+
+(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
+ "Insert a new column, to the left of the current column."
+ (interactive)
+ (let ((n (org-columns-current-column))
+ (editp (and prop (assoc prop org-columns-current-fmt-compiled)))
+ cell)
+ (setq prop (org-icompleting-read
+ "Property: " (mapcar 'list (org-buffer-property-keys t nil t))
+ nil nil prop))
+ (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
+ (setq width (read-string "Column width: " (if width (number-to-string width))))
+ (if (string-match "\\S-" width)
+ (setq width (string-to-number width))
+ (setq width nil))
+ (setq fmt (org-icompleting-read "Summary [none]: "
+ (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map)
+ nil t))
+ (setq fmt (intern fmt)
+ fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
+ (if (eq fmt 'none) (setq fmt nil))
+ (if editp
+ (progn
+ (setcar editp prop)
+ (setcdr editp (list title width nil fmt nil fun)))
+ (setq cell (nthcdr (1- n) org-columns-current-fmt-compiled))
+ (setcdr cell (cons (list prop title width nil fmt nil
+ (car fun) (cadr fun))
+ (cdr cell))))
+ (org-columns-store-format)
+ (org-columns-redo)))
+
+(defun org-columns-delete ()
+ "Delete the column at point from columns view."
+ (interactive)
+ (let* ((n (org-columns-current-column))
+ (title (nth 1 (nth n org-columns-current-fmt-compiled))))
+ (when (y-or-n-p
+ (format "Are you sure you want to remove column \"%s\"? " title))
+ (setq org-columns-current-fmt-compiled
+ (delq (nth n org-columns-current-fmt-compiled)
+ org-columns-current-fmt-compiled))
+ (org-columns-store-format)
+ (org-columns-redo)
+ (if (>= (org-columns-current-column)
+ (length org-columns-current-fmt-compiled))
+ (org-columns-backward-char)))))
+
+(defun org-columns-edit-attributes ()
+ "Edit the attributes of the current column."
+ (interactive)
+ (let* ((n (org-columns-current-column))
+ (info (nth n org-columns-current-fmt-compiled)))
+ (apply 'org-columns-new info)))
+
+(defun org-columns-widen (arg)
+ "Make the column wider by ARG characters."
+ (interactive "p")
+ (let* ((n (org-columns-current-column))
+ (entry (nth n org-columns-current-fmt-compiled))
+ (width (or (nth 2 entry)
+ (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (setq width (max 1 (+ width arg)))
+ (setcar (nthcdr 2 entry) width)
+ (org-columns-store-format)
+ (org-columns-redo)))
+
+(defun org-columns-narrow (arg)
+ "Make the column narrower by ARG characters."
+ (interactive "p")
+ (org-columns-widen (- arg)))
+
+(defun org-columns-move-right ()
+ "Swap this column with the one to the right."
+ (interactive)
+ (let* ((n (org-columns-current-column))
+ (cell (nthcdr n org-columns-current-fmt-compiled))
+ e)
+ (when (>= n (1- (length org-columns-current-fmt-compiled)))
+ (error "Cannot shift this column further to the right"))
+ (setq e (car cell))
+ (setcar cell (car (cdr cell)))
+ (setcdr cell (cons e (cdr (cdr cell))))
+ (org-columns-store-format)
+ (org-columns-redo)
+ (org-columns-forward-char)))
+
+(defun org-columns-move-left ()
+ "Swap this column with the one to the left."
+ (interactive)
+ (let* ((n (org-columns-current-column)))
+ (when (= n 0)
+ (error "Cannot shift this column further to the left"))
+ (org-columns-backward-char)
+ (org-columns-move-right)
+ (org-columns-backward-char)))
+
+(defun org-columns-store-format ()
+ "Store the text version of the current columns format in appropriate place.
+This is either in the COLUMNS property of the node starting the current column
+display, or in the #+COLUMNS line of the current buffer."
+ (let (fmt (cnt 0))
+ (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (if (marker-position org-columns-top-level-marker)
+ (save-excursion
+ (goto-char org-columns-top-level-marker)
+ (if (and (org-at-heading-p)
+ (org-entry-get nil "COLUMNS"))
+ (org-entry-put nil "COLUMNS" fmt)
+ (goto-char (point-min))
+ ;; Overwrite all #+COLUMNS lines....
+ (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
+ (setq cnt (1+ cnt))
+ (replace-match (concat "#+COLUMNS: " fmt) t t))
+ (unless (> cnt 0)
+ (goto-char (point-min))
+ (or (org-at-heading-p t) (outline-next-heading))
+ (let ((inhibit-read-only t))
+ (insert-before-markers "#+COLUMNS: " fmt "\n")))
+ (org-set-local 'org-columns-default-format fmt))))))
+
+(defvar org-agenda-overriding-columns-format nil
+ "When set, overrides any other format definition for the agenda.
+Don't set this, this is meant for dynamic scoping.")
+
+(defun org-columns-get-autowidth-alist (s cache)
+ "Derive the maximum column widths from the format and the cache."
+ (let ((start 0) rtn)
+ (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start)
+ (push (cons (match-string 1 s) 1) rtn)
+ (setq start (match-end 0)))
+ (mapc (lambda (x)
+ (setcdr x (apply 'max
+ (mapcar
+ (lambda (y)
+ (length (or (cdr (assoc (car x) (cdr y))) " ")))
+ cache))))
+ rtn)
+ rtn))
+
+(defun org-columns-compute-all ()
+ "Compute all columns that have operators defined."
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (let ((columns org-columns-current-fmt-compiled)
+ (org-columns-time (time-to-number-of-days (current-time)))
+ col)
+ (while (setq col (pop columns))
+ (when (nth 3 col)
+ (save-excursion
+ (org-columns-compute (car col)))))))
+
+(defun org-columns-update (property)
+ "Recompute PROPERTY, and update the columns display for it."
+ (org-columns-compute property)
+ (let (fmt val pos face)
+ (save-excursion
+ (mapc (lambda (ov)
+ (when (equal (overlay-get ov 'org-columns-key) property)
+ (setq pos (overlay-start ov))
+ (goto-char pos)
+ (when (setq val (cdr (assoc property
+ (get-text-property
+ (point-at-bol) 'org-summaries))))
+ (setq fmt (overlay-get ov 'org-columns-format))
+ (overlay-put ov 'org-columns-value val)
+ (if (featurep 'xemacs)
+ (progn
+ (setq face (glyph-face (extent-end-glyph ov)))
+ (org-overlay-display ov (format fmt val) face))
+ (org-overlay-display ov (format fmt val))))))
+ org-columns-overlays))))
+
+(defun org-columns-compute (property)
+ "Sum the values of property PROPERTY hierarchically, for the entire buffer."
+ (interactive)
+ (let* ((re org-outline-regexp-bol)
+ (lmax 30) ; Does anyone use deeper levels???
+ (lvals (make-vector lmax nil))
+ (lflag (make-vector lmax nil))
+ (level 0)
+ (ass (assoc property org-columns-current-fmt-compiled))
+ (format (nth 4 ass))
+ (printf (nth 5 ass))
+ (fun (nth 6 ass))
+ (calc (or (nth 7 ass) 'identity))
+ (beg org-columns-top-level-marker)
+ last-level val valflag flag end sumpos sum-alist sum str str1 useval)
+ (save-excursion
+ ;; Find the region to compute
+ (goto-char beg)
+ (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
+ (goto-char end)
+ ;; Walk the tree from the back and do the computations
+ (while (re-search-backward re beg t)
+ (setq sumpos (match-beginning 0)
+ last-level level
+ level (org-outline-level)
+ val (org-entry-get nil property)
+ valflag (and val (string-match "\\S-" val)))
+ (cond
+ ((< level last-level)
+ ;; put the sum of lower levels here as a property
+ (setq sum (when (aref lvals last-level)
+ (apply fun (aref lvals last-level)))
+ flag (aref lflag last-level) ; any valid entries from children?
+ str (org-columns-number-to-string sum format printf)
+ str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
+ useval (if flag str1 (if valflag val ""))
+ sum-alist (get-text-property sumpos 'org-summaries))
+ (if (assoc property sum-alist)
+ (setcdr (assoc property sum-alist) useval)
+ (push (cons property useval) sum-alist)
+ (org-unmodified
+ (add-text-properties sumpos (1+ sumpos)
+ (list 'org-summaries sum-alist))))
+ (when (and val (not (equal val (if flag str val))))
+ (org-entry-put nil property (if flag str val)))
+ ;; add current to current level accumulator
+ (when (or flag valflag)
+ (push (if flag
+ sum
+ (funcall calc (org-columns-string-to-number
+ (if flag str val) format)))
+ (aref lvals level))
+ (aset lflag level t))
+ ;; clear accumulators for deeper levels
+ (loop for l from (1+ level) to (1- lmax) do
+ (aset lvals l nil)
+ (aset lflag l nil)))
+ ((>= level last-level)
+ ;; add what we have here to the accumulator for this level
+ (when valflag
+ (push (funcall calc (org-columns-string-to-number val format))
+ (aref lvals level))
+ (aset lflag level t)))
+ (t (error "This should not happen")))))))
+
+(defun org-columns-redo ()
+ "Construct the column display again."
+ (interactive)
+ (message "Recomputing columns...")
+ (save-excursion
+ (if (marker-position org-columns-begin-marker)
+ (goto-char org-columns-begin-marker))
+ (org-columns-remove-overlays)
+ (if (derived-mode-p 'org-mode)
+ (call-interactively 'org-columns)
+ (org-agenda-redo)
+ (call-interactively 'org-agenda-columns)))
+ (when (featurep 'xemacs)
+ (while (not (or (eolp)
+ (member (extent-at (point)) org-columns-overlays)))
+ (forward-char)))
+ (message "Recomputing columns...done"))
+
+(defun org-columns-not-in-agenda ()
+ (if (eq major-mode 'org-agenda-mode)
+ (error "This command is only allowed in Org-mode buffers")))
+
+(defun org-string-to-number (s)
+ "Convert string to number, and interpret hh:mm:ss."
+ (if (not (string-match ":" s))
+ (string-to-number s)
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum)))
+
+(defun org-columns-number-to-string (n fmt &optional printf)
+ "Convert a computed column number to a string value, according to FMT."
+ (cond
+ ((memq fmt '(estimate)) (org-estimate-print n printf))
+ ((not (numberp n)) "")
+ ((memq fmt '(add_times max_times min_times mean_times))
+ (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
+ (format org-time-clocksum-format h m)))
+ ((eq fmt 'checkbox)
+ (cond ((= n (floor n)) "[X]")
+ ((> n 1.) "[-]")
+ (t "[ ]")))
+ ((memq fmt '(checkbox-n-of-m checkbox-percent))
+ (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1))))))
+ (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent))))
+ (printf (format printf n))
+ ((eq fmt 'currency)
+ (format "%.2f" n))
+ ((memq fmt '(min_age max_age mean_age))
+ (org-format-time-period n))
+ (t (number-to-string n))))
+
+(defun org-nofm-to-completion (n m &optional percent)
+ (if (not percent)
+ (format "[%d/%d]" n m)
+ (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))
+
+(defun org-columns-string-to-number (s fmt)
+ "Convert a column value to a number that can be used for column computing."
+ (if s
+ (cond
+ ((memq fmt '(min_age max_age mean_age))
+ (cond ((string= s "") org-columns-time)
+ ((string-match
+ "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+ s)
+ (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+ (string-to-number (match-string 2 s))))
+ (string-to-number (match-string 3 s))))
+ (string-to-number (match-string 4 s))))
+ (t (time-to-number-of-days (apply 'encode-time
+ (org-parse-time-string s t))))))
+ ((string-match ":" s)
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum))
+ ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
+ (if (equal s "[X]") 1. 0.000001))
+ ((memq fmt '(estimate)) (org-string-to-estimate s))
+ (t (string-to-number s)))))
+
+(defun org-columns-uncompile-format (cfmt)
+ "Turn the compiled columns format back into a string representation."
+ (let ((rtn "") e s prop title op op-match width fmt printf fun calc)
+ (while (setq e (pop cfmt))
+ (setq prop (car e)
+ title (nth 1 e)
+ width (nth 2 e)
+ op (nth 3 e)
+ fmt (nth 4 e)
+ printf (nth 5 e)
+ fun (nth 6 e)
+ calc (nth 7 e))
+ (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map))
+ (setq op (car op-match)))
+ (if (and op printf) (setq op (concat op ";" printf)))
+ (if (equal title prop) (setq title nil))
+ (setq s (concat "%" (if width (number-to-string width))
+ prop
+ (if title (concat "(" title ")"))
+ (if op (concat "{" op "}"))))
+ (setq rtn (concat rtn " " s)))
+ (org-trim rtn)))
+
+(defun org-columns-compile-format (fmt)
+ "Turn a column format string into an alist of specifications.
+The alist has one entry for each column in the format. The elements of
+that list are:
+property the property
+title the title field for the columns
+width the column width in characters, can be nil for automatic
+operator the operator if any
+format the output format for computed results, derived from operator
+printf a printf format for computed values
+fun the lisp function to compute summary values, derived from operator
+calc function to get values from base elements"
+ (let ((start 0) width prop title op op-match f printf fun calc)
+ (setq org-columns-current-fmt-compiled nil)
+ (while (string-match
+ (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
+ fmt start)
+ (setq start (match-end 0)
+ width (match-string 1 fmt)
+ prop (match-string 2 fmt)
+ title (or (match-string 3 fmt) prop)
+ op (match-string 4 fmt)
+ f nil
+ printf nil
+ fun '+
+ calc nil)
+ (if width (setq width (string-to-number width)))
+ (when (and op (string-match ";" op))
+ (setq printf (substring op (match-end 0))
+ op (substring op 0 (match-beginning 0))))
+ (when (setq op-match (assoc op org-columns-compile-map))
+ (setq f (cadr op-match)
+ fun (caddr op-match)
+ calc (cadddr op-match)))
+ (push (list prop title width op f printf fun calc)
+ org-columns-current-fmt-compiled))
+ (setq org-columns-current-fmt-compiled
+ (nreverse org-columns-current-fmt-compiled))))
+
+
+;;; Dynamic block for Column view
+
+(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
+ "Get the column view of the current buffer or subtree.
+The first optional argument MAXLEVEL sets the level limit. A
+second optional argument SKIP-EMPTY-ROWS tells whether to skip
+empty rows, an empty row being one where all the column view
+specifiers except ITEM are empty. This function returns a list
+containing the title row and all other rows. Each row is a list
+of fields."
+ (if (featurep 'xemacs)
+ (save-excursion
+ (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
+ (re-comment (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (re-archive (concat ".*:" org-archive-tag ":"))
+ (n (length title)) row tbl)
+ (goto-char (point-min))
+
+ (while (re-search-forward org-heading-regexp nil t)
+ (catch 'next
+ (when (and (or (null maxlevel)
+ (>= maxlevel
+ (if org-odd-levels-only
+ (/ (1+ (length (match-string 1))) 2)
+ (length (match-string 1)))))
+ (get-char-property (match-beginning 0) 'org-columns-key))
+ (goto-char (match-beginning 0))
+ (when (save-excursion
+ (goto-char (point-at-bol))
+ (or (looking-at re-comment)
+ (looking-at re-archive)))
+ (org-end-of-subtree t)
+ (throw 'next t))
+ (setq row nil)
+ (loop for i from 0 to (1- n) do
+ (push
+ (org-quote-vert
+ (or (get-char-property (point)
+ 'org-columns-value-modified)
+ (get-char-property (point) 'org-columns-value)
+ ""))
+ row)
+ (org-columns-forward-char))
+ (setq row (nreverse row))
+ (unless (and skip-empty-rows
+ (eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
+ (push row tbl)))))
+ (append (list title 'hline) (nreverse tbl))))
+ (save-excursion
+ (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
+ (n (length title)) row tbl)
+ (goto-char (point-min))
+ (while (and (re-search-forward "^\\(\\*+\\) " nil t)
+ (or (null maxlevel)
+ (>= maxlevel
+ (if org-odd-levels-only
+ (/ (1+ (length (match-string 1))) 2)
+ (length (match-string 1))))))
+ (when (get-char-property (match-beginning 0) 'org-columns-key)
+ (setq row nil)
+ (loop for i from 0 to (1- n) do
+ (push (or (get-char-property (+ (match-beginning 0) i)
+ 'org-columns-value-modified)
+ (get-char-property (+ (match-beginning 0) i)
+ 'org-columns-value)
+ "")
+ row))
+ (setq row (nreverse row))
+ (unless (and skip-empty-rows
+ (eq 1 (length (delete "" (delete-dups row)))))
+ (push row tbl))))
+ (append (list title 'hline) (nreverse tbl))))))
+
+(defun org-dblock-write:columnview (params)
+ "Write the column view table.
+PARAMS is a property list of parameters:
+
+:width enforce same column widths with <N> specifiers.
+:id the :ID: property of the entry where the columns view
+ should be built. When the symbol `local', call locally.
+ When `global' call column view with the cursor at the beginning
+ of the buffer (usually this means that the whole buffer switches
+ to column view). When \"file:path/to/file.org\", invoke column
+ view at the start of that file. Otherwise, the ID is located
+ using `org-id-find'.
+:hlines When t, insert a hline before each item. When a number, insert
+ a hline before each level <= that number.
+:vlines When t, make each column a colgroup to enforce vertical lines.
+:maxlevel When set to a number, don't capture headlines below this level.
+:skip-empty-rows
+ When t, skip rows where all specifiers other than ITEM are empty."
+ (let ((pos (move-marker (make-marker) (point)))
+ (hlines (plist-get params :hlines))
+ (vlines (plist-get params :vlines))
+ (maxlevel (plist-get params :maxlevel))
+ (content-lines (org-split-string (plist-get params :content) "\n"))
+ (skip-empty-rows (plist-get params :skip-empty-rows))
+ (case-fold-search t)
+ tbl id idpos nfields tmp recalc line
+ id-as-string view-file view-pos)
+ (when (setq id (plist-get params :id))
+ (setq id-as-string (cond ((numberp id) (number-to-string id))
+ ((symbolp id) (symbol-name id))
+ ((stringp id) id)
+ (t "")))
+ (cond ((not id) nil)
+ ((eq id 'global) (setq view-pos (point-min)))
+ ((eq id 'local))
+ ((string-match "^file:\\(.*\\)" id-as-string)
+ (setq view-file (match-string 1 id-as-string)
+ view-pos 1)
+ (unless (file-exists-p view-file)
+ (error "No such file: \"%s\"" id-as-string)))
+ ((setq idpos (org-find-entry-with-id id))
+ (setq view-pos idpos))
+ ((setq idpos (org-id-find id))
+ (setq view-file (car idpos))
+ (setq view-pos (cdr idpos)))
+ (t (error "Cannot find entry with :ID: %s" id))))
+ (with-current-buffer (if view-file
+ (get-file-buffer view-file)
+ (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (or view-pos (point)))
+ (org-columns)
+ (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
+ (setq nfields (length (car tbl)))
+ (org-columns-quit))))
+ (goto-char pos)
+ (move-marker pos nil)
+ (when tbl
+ (when (plist-get params :hlines)
+ (setq tmp nil)
+ (while tbl
+ (if (eq (car tbl) 'hline)
+ (push (pop tbl) tmp)
+ (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
+ (if (and (not (eq (car tmp) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines)
+ (<= (- (match-end 1) (match-beginning 1))
+ hlines))))
+ (push 'hline tmp)))
+ (push (pop tbl) tmp)))
+ (setq tbl (nreverse tmp)))
+ (when vlines
+ (setq tbl (mapcar (lambda (x)
+ (if (eq 'hline x) x (cons "" x)))
+ tbl))
+ (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
+ (setq pos (point))
+ (when content-lines
+ (while (string-match "^#" (car content-lines))
+ (insert (pop content-lines) "\n")))
+ (insert (org-listtable-to-string tbl))
+ (when (plist-get params :width)
+ (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
+ org-columns-current-widths "|")))
+ (while (setq line (pop content-lines))
+ (when (string-match "^#" line)
+ (insert "\n" line)
+ (when (string-match "^[ \t]*#\\+tblfm" line)
+ (setq recalc t))))
+ (if recalc
+ (progn (goto-char pos) (org-table-recalculate 'all))
+ (goto-char pos)
+ (org-table-align)))))
+
+(defun org-listtable-to-string (tbl)
+ "Convert a listtable TBL to a string that contains the Org-mode table.
+The table still need to be aligned. The resulting string has no leading
+and tailing newline characters."
+ (mapconcat
+ (lambda (x)
+ (cond
+ ((listp x)
+ (concat "|" (mapconcat 'identity x "|") "|"))
+ ((eq x 'hline) "|-|")
+ (t (error "Garbage in listtable: %s" x))))
+ tbl "\n"))
+
+(defun org-insert-columns-dblock ()
+ "Create a dynamic block capturing a column view table."
+ (interactive)
+ (when (featurep 'xemacs) (org-columns-quit))
+ (let ((defaults '(:name "columnview" :hlines 1))
+ (id (org-icompleting-read
+ "Capture columns (local, global, entry with :ID: property) [local]: "
+ (append '(("global") ("local"))
+ (mapcar 'list (org-property-values "ID"))))))
+ (if (equal id "") (setq id 'local))
+ (if (equal id "global") (setq id 'global))
+ (setq defaults (append defaults (list :id id)))
+ (org-create-dblock defaults)
+ (org-update-dblock)))
+
+;;; Column view in the agenda
+
+(defvar org-agenda-view-columns-initially nil
+ "When set, switch to columns view immediately after creating the agenda.")
+
+(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
+(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
+(defvar org-agenda-columns-add-appointments-to-effort-sum); as well
+
+(defun org-agenda-columns ()
+ "Turn on or update column view in the agenda."
+ (interactive)
+ (org-verify-version 'columns)
+ (org-columns-remove-overlays)
+ (move-marker org-columns-begin-marker (point))
+ (let ((org-columns-time (time-to-number-of-days (current-time)))
+ cache maxwidths m p a d fmt)
+ (cond
+ ((and (boundp 'org-agenda-overriding-columns-format)
+ org-agenda-overriding-columns-format)
+ (setq fmt org-agenda-overriding-columns-format)
+ (org-set-local 'org-agenda-overriding-columns-format fmt))
+ ((setq m (org-get-at-bol 'org-hd-marker))
+ (setq fmt (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format))))
+ ((and (boundp 'org-columns-current-fmt)
+ (local-variable-p 'org-columns-current-fmt (current-buffer))
+ org-columns-current-fmt)
+ (setq fmt org-columns-current-fmt))
+ ((setq m (next-single-property-change (point-min) 'org-hd-marker))
+ (setq m (get-text-property m 'org-hd-marker))
+ (setq fmt (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format)))))
+ (setq fmt (or fmt org-columns-default-format))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (org-columns-compile-format fmt)
+ (when org-agenda-columns-compute-summary-properties
+ (org-agenda-colview-compute org-columns-current-fmt-compiled))
+ (save-excursion
+ ;; Get and cache the properties
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (setq m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker)))
+ (setq p (org-entry-properties m))
+
+ (when (or (not (setq a (assoc org-effort-property p)))
+ (not (string-match "\\S-" (or (cdr a) ""))))
+ ;; OK, the property is not defined. Use appointment duration?
+ (when (and org-agenda-columns-add-appointments-to-effort-sum
+ (setq d (get-text-property (point) 'duration)))
+ (setq d (org-minutes-to-hh:mm-string d))
+ (put-text-property 0 (length d) 'face 'org-warning d)
+ (push (cons org-effort-property d) p)))
+ (push (cons (org-current-line) p) cache))
+ (beginning-of-line 2))
+ (when cache
+ (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
+ (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-columns-display-here-title)
+ (mapc (lambda (x)
+ (org-goto-line (car x))
+ (org-columns-display-here (cdr x)))
+ cache)
+ (when org-agenda-columns-show-summaries
+ (org-agenda-colview-summarize cache))))))
+
+(defun org-agenda-colview-summarize (cache)
+ "Summarize the summarizable columns in column view in the agenda.
+This will add overlays to the date lines, to show the summary for each day."
+ (let* ((fmt (mapcar (lambda (x)
+ (if (equal (car x) "CLOCKSUM")
+ (list "CLOCKSUM" (nth 2 x) nil 'add_times nil '+ 'identity)
+ (cdr x)))
+ org-columns-current-fmt-compiled))
+ line c c1 stype calc sumfunc props lsum entries prop v)
+ (catch 'exit
+ (when (delq nil (mapcar 'cadr fmt))
+ ;; OK, at least one summation column, it makes sense to try this
+ (goto-char (point-max))
+ (while t
+ (when (or (get-text-property (point) 'org-date-line)
+ (eq (get-text-property (point) 'face)
+ 'org-agenda-structure))
+ ;; OK, this is a date line that should be used
+ (setq line (org-current-line))
+ (setq entries nil c cache cache nil)
+ (while (setq c1 (pop c))
+ (if (> (car c1) line)
+ (push c1 entries)
+ (push c1 cache)))
+ ;; now ENTRIES are the ones we want to use, CACHE is the rest
+ ;; Compute the summaries for the properties we want,
+ ;; set nil properties for the rest.
+ (when (setq entries (mapcar 'cdr entries))
+ (setq props
+ (mapcar
+ (lambda (f)
+ (setq prop (car f)
+ stype (nth 3 f)
+ sumfunc (nth 5 f)
+ calc (or (nth 6 f) 'identity))
+ (cond
+ ((equal prop "ITEM")
+ (cons prop (buffer-substring (point-at-bol)
+ (point-at-eol))))
+ ((not stype) (cons prop ""))
+ (t ;; do the summary
+ (setq lsum nil)
+ (dolist (x entries)
+ (setq v (cdr (assoc prop x)))
+ (if v
+ (push
+ (funcall
+ (if (not (get-text-property 0 'org-computed v))
+ calc
+ 'identity)
+ (org-columns-string-to-number
+ v stype))
+ lsum)))
+ (setq lsum (remove nil lsum))
+ (setq lsum
+ (cond ((> (length lsum) 1)
+ (org-columns-number-to-string
+ (apply sumfunc lsum) stype))
+ ((eq (length lsum) 1)
+ (org-columns-number-to-string
+ (car lsum) stype))
+ (t "")))
+ (put-text-property 0 (length lsum) 'face 'bold lsum)
+ (unless (eq calc 'identity)
+ (put-text-property 0 (length lsum) 'org-computed t lsum))
+ (cons prop lsum))))
+ fmt))
+ (org-columns-display-here props)
+ (org-set-local 'org-agenda-columns-active t)))
+ (if (bobp) (throw 'exit t))
+ (beginning-of-line 0))))))
+
+(defun org-agenda-colview-compute (fmt)
+ "Compute the relevant columns in the contributing source buffers."
+ (let ((files org-agenda-contributing-files)
+ (org-columns-begin-marker (make-marker))
+ (org-columns-top-level-marker (make-marker))
+ f fm a b)
+ (while (setq f (pop files))
+ (setq b (find-buffer-visiting f))
+ (with-current-buffer (or (buffer-base-buffer b) b)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(org-summaries t)))
+ (goto-char (point-min))
+ (org-columns-get-format-and-top-level)
+ (while (setq fm (pop fmt))
+ (if (equal (car fm) "CLOCKSUM")
+ (org-clock-sum)
+ (when (and (nth 4 fm)
+ (setq a (assoc (car fm)
+ org-columns-current-fmt-compiled))
+ (equal (nth 4 a) (nth 4 fm)))
+ (org-columns-compute (car fm)))))))))))
+
+(defun org-format-time-period (interval)
+ "Convert time in fractional days to days/hours/minutes/seconds."
+ (if (numberp interval)
+ (let* ((days (floor interval))
+ (frac-hours (* 24 (- interval days)))
+ (hours (floor frac-hours))
+ (minutes (floor (* 60 (- frac-hours hours))))
+ (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
+ (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
+ ""))
+
+(defun org-estimate-mean-and-var (v)
+ "Return the mean and variance of an estimate."
+ (let* ((low (float (car v)))
+ (high (float (cadr v)))
+ (mean (/ (+ low high) 2.0))
+ (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0)))
+ (list mean var)))
+
+(defun org-estimate-combine (&rest el)
+ "Combine a list of estimates, using mean and variance.
+The mean and variance of the result will be the sum of the means
+and variances (respectively) of the individual estimates."
+ (let ((mean 0)
+ (var 0))
+ (mapc (lambda (e)
+ (let ((stats (org-estimate-mean-and-var e)))
+ (setq mean (+ mean (car stats)))
+ (setq var (+ var (cadr stats)))))
+ el)
+ (let ((stdev (sqrt var)))
+ (list (- mean stdev) (+ mean stdev)))))
+
+(defun org-estimate-print (e &optional fmt)
+ "Prepare a string representation of an estimate.
+This formats these numbers as two numbers with a \"-\" between them."
+ (if (null fmt) (set 'fmt "%.0f"))
+ (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))
+
+(defun org-string-to-estimate (s)
+ "Convert a string to an estimate.
+The string should be two numbers joined with a \"-\"."
+ (if (string-match "\\(.*\\)-\\(.*\\)" s)
+ (list (string-to-number (match-string 1 s))
+ (string-to-number(match-string 2 s)))
+ (list (string-to-number s) (string-to-number s))))
+
+(provide 'org-colview)
+(provide 'org-colview-xemacs)
+
+;;; org-colview-xemacs.el ends here
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
new file mode 100644
index 0000000..e17210b
--- /dev/null
+++ b/lisp/org-colview.el
@@ -0,0 +1,1574 @@
+;;; org-colview.el --- Column View in Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the column view for Org.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org)
+
+(declare-function org-agenda-redo "org-agenda" ())
+(declare-function org-agenda-do-context-action "org-agenda" ())
+(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
+
+(when (featurep 'xemacs)
+ (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'"))
+
+;;; Column View
+
+(defvar org-columns-overlays nil
+ "Holds the list of current column overlays.")
+
+(defvar org-columns-current-fmt nil
+ "Local variable, holds the currently active column format.")
+(make-variable-buffer-local 'org-columns-current-fmt)
+(defvar org-columns-current-fmt-compiled nil
+ "Local variable, holds the currently active column format.
+This is the compiled version of the format.")
+(make-variable-buffer-local 'org-columns-current-fmt-compiled)
+(defvar org-columns-current-widths nil
+ "Loval variable, holds the currently widths of fields.")
+(make-variable-buffer-local 'org-columns-current-widths)
+(defvar org-columns-current-maxwidths nil
+ "Loval variable, holds the currently active maximum column widths.")
+(make-variable-buffer-local 'org-columns-current-maxwidths)
+(defvar org-columns-begin-marker (make-marker)
+ "Points to the position where last a column creation command was called.")
+(defvar org-columns-top-level-marker (make-marker)
+ "Points to the position where current columns region starts.")
+
+(defvar org-columns-map (make-sparse-keymap)
+ "The keymap valid in column display.")
+
+(defun org-columns-content ()
+ "Switch to contents view while in columns view."
+ (interactive)
+ (org-overview)
+ (org-content))
+
+(org-defkey org-columns-map "c" 'org-columns-content)
+(org-defkey org-columns-map "o" 'org-overview)
+(org-defkey org-columns-map "e" 'org-columns-edit-value)
+(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
+(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle)
+(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
+(org-defkey org-columns-map "v" 'org-columns-show-value)
+(org-defkey org-columns-map "q" 'org-columns-quit)
+(org-defkey org-columns-map "r" 'org-columns-redo)
+(org-defkey org-columns-map "g" 'org-columns-redo)
+(org-defkey org-columns-map [left] 'backward-char)
+(org-defkey org-columns-map "\M-b" 'backward-char)
+(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
+(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
+(org-defkey org-columns-map "\M-f"
+ (lambda () (interactive) (goto-char (1+ (point)))))
+(org-defkey org-columns-map [right]
+ (lambda () (interactive) (goto-char (1+ (point)))))
+(org-defkey org-columns-map [down]
+ (lambda () (interactive)
+ (let ((col (current-column)))
+ (beginning-of-line 2)
+ (while (and (org-invisible-p2) (not (eobp)))
+ (beginning-of-line 2))
+ (move-to-column col)
+ (if (eq major-mode 'org-agenda-mode)
+ (org-agenda-do-context-action)))))
+(org-defkey org-columns-map [up]
+ (lambda () (interactive)
+ (let ((col (current-column)))
+ (beginning-of-line 0)
+ (while (and (org-invisible-p2) (not (bobp)))
+ (beginning-of-line 0))
+ (move-to-column col)
+ (if (eq major-mode 'org-agenda-mode)
+ (org-agenda-do-context-action)))))
+(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
+(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
+(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "<" 'org-columns-narrow)
+(org-defkey org-columns-map ">" 'org-columns-widen)
+(org-defkey org-columns-map [(meta right)] 'org-columns-move-right)
+(org-defkey org-columns-map [(meta left)] 'org-columns-move-left)
+(org-defkey org-columns-map [(shift meta right)] 'org-columns-new)
+(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
+(dotimes (i 10)
+ (org-defkey org-columns-map (number-to-string i)
+ `(lambda () (interactive)
+ (org-columns-next-allowed-value nil ,i))))
+
+(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
+ '("Column"
+ ["Edit property" org-columns-edit-value t]
+ ["Next allowed value" org-columns-next-allowed-value t]
+ ["Previous allowed value" org-columns-previous-allowed-value t]
+ ["Show full value" org-columns-show-value t]
+ ["Edit allowed values" org-columns-edit-allowed t]
+ "--"
+ ["Edit column attributes" org-columns-edit-attributes t]
+ ["Increase column width" org-columns-widen t]
+ ["Decrease column width" org-columns-narrow t]
+ "--"
+ ["Move column right" org-columns-move-right t]
+ ["Move column left" org-columns-move-left t]
+ ["Add column" org-columns-new t]
+ ["Delete column" org-columns-delete t]
+ "--"
+ ["CONTENTS" org-columns-content t]
+ ["OVERVIEW" org-overview t]
+ ["Refresh columns display" org-columns-redo t]
+ "--"
+ ["Open link" org-columns-open-link t]
+ "--"
+ ["Quit" org-columns-quit t]))
+
+(defun org-columns-new-overlay (beg end &optional string face)
+ "Create a new column overlay and add it to the list."
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face (or face 'secondary-selection))
+ (remove-text-properties 0 (length string) '(face nil) string)
+ (org-overlay-display ov string face)
+ (push ov org-columns-overlays)
+ ov))
+
+(defun org-columns-display-here (&optional props dateline)
+ "Overlay the current line with column display."
+ (interactive)
+ (let* ((fmt org-columns-current-fmt-compiled)
+ (beg (point-at-bol))
+ (level-face (save-excursion
+ (beginning-of-line 1)
+ (and (looking-at "\\(\\**\\)\\(\\* \\)")
+ (org-get-level-face 2))))
+ (ref-face (or level-face
+ (and (eq major-mode 'org-agenda-mode)
+ (get-text-property (point-at-bol) 'face))
+ 'default))
+ (color (list :foreground (face-attribute ref-face :foreground)))
+ (face (list color 'org-column ref-face))
+ (face1 (list color 'org-agenda-column-dateline ref-face))
+ (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
+ pom property ass width f string ov column val modval s2 title calc)
+ ;; Check if the entry is in another buffer.
+ (unless props
+ (if (eq major-mode 'org-agenda-mode)
+ (setq pom (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))
+ props (if pom (org-entry-properties pom) nil))
+ (setq props (org-entry-properties nil))))
+ ;; Walk the format
+ (while (setq column (pop fmt))
+ (setq property (car column)
+ title (nth 1 column)
+ ass (if (equal property "ITEM")
+ (cons "ITEM"
+ ;; When in a buffer, get the whole line,
+ ;; we'll clean it later…
+ (if (derived-mode-p 'org-mode)
+ (save-match-data
+ (org-remove-tabs
+ (buffer-substring-no-properties
+ (point-at-bol) (point-at-eol))))
+ ;; In agenda, just get the `txt' property
+ (or (org-get-at-bol 'txt)
+ (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))))
+ (assoc property props))
+ width (or (cdr (assoc property org-columns-current-maxwidths))
+ (nth 2 column)
+ (length property))
+ f (format "%%-%d.%ds | " width width)
+ calc (nth 7 column)
+ val (or (cdr ass) "")
+ modval (cond ((and org-columns-modify-value-for-display-function
+ (functionp
+ org-columns-modify-value-for-display-function))
+ (funcall org-columns-modify-value-for-display-function
+ title val))
+ ((equal property "ITEM")
+ (org-columns-cleanup-item
+ val org-columns-current-fmt-compiled
+ (or org-complex-heading-regexp cphr)))
+ ((and calc (functionp calc)
+ (not (string= val ""))
+ (not (get-text-property 0 'org-computed val)))
+ (org-columns-number-to-string
+ (funcall calc (org-columns-string-to-number
+ val (nth 4 column)))
+ (nth 4 column)))))
+ (setq s2 (org-columns-add-ellipses (or modval val) width))
+ (setq string (format f s2))
+ ;; Create the overlay
+ (org-unmodified
+ (setq ov (org-columns-new-overlay
+ beg (setq beg (1+ beg)) string (if dateline face1 face)))
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'org-columns-key property)
+ (overlay-put ov 'org-columns-value (cdr ass))
+ (overlay-put ov 'org-columns-value-modified modval)
+ (overlay-put ov 'org-columns-pom pom)
+ (overlay-put ov 'org-columns-format f)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix ""))
+ (if (or (not (char-after beg))
+ (equal (char-after beg) ?\n))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char beg)
+ (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
+ ;; Make the rest of the line disappear.
+ (org-unmodified
+ (setq ov (org-columns-new-overlay beg (point-at-eol)))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'intangible t)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix "")
+ (push ov org-columns-overlays)
+ (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+ (overlay-put ov 'keymap org-columns-map)
+ (push ov org-columns-overlays)
+ (let ((inhibit-read-only t))
+ (put-text-property (max (point-min) (1- (point-at-bol)))
+ (min (point-max) (1+ (point-at-eol)))
+ 'read-only "Type `e' to edit property")))))
+
+(defun org-columns-add-ellipses (string width)
+ "Truncate STRING with WIDTH characters, with ellipses."
+ (cond
+ ((<= (length string) width) string)
+ ((<= width (length org-columns-ellipses))
+ (substring org-columns-ellipses 0 width))
+ (t (concat (substring string 0 (- width (length org-columns-ellipses)))
+ org-columns-ellipses))))
+
+(defvar org-columns-full-header-line-format nil
+ "The full header line format, will be shifted by horizontal scrolling." )
+(defvar org-previous-header-line-format nil
+ "The header line format before column view was turned on.")
+(defvar org-columns-inhibit-recalculation nil
+ "Inhibit recomputing of columns on column view startup.")
+(defvar org-columns-flyspell-was-active nil
+ "Remember the state of `flyspell-mode' before column view.
+Flyspell-mode can cause problems in columns view, so it is turned off
+for the duration of the command.")
+
+(defvar header-line-format)
+(defvar org-columns-previous-hscroll 0)
+
+(defun org-columns-display-here-title ()
+ "Overlay the newline before the current line with the table title."
+ (interactive)
+ (let ((fmt org-columns-current-fmt-compiled)
+ string (title "")
+ property width f column str widths)
+ (while (setq column (pop fmt))
+ (setq property (car column)
+ str (or (nth 1 column) property)
+ width (or (cdr (assoc property org-columns-current-maxwidths))
+ (nth 2 column)
+ (length str))
+ widths (push width widths)
+ f (format "%%-%d.%ds | " width width)
+ string (format f str)
+ title (concat title string)))
+ (setq title (concat
+ (org-add-props " " nil 'display '(space :align-to 0))
+ ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default))))
+ (org-add-props title nil 'face 'org-column-title)))
+ (org-set-local 'org-previous-header-line-format header-line-format)
+ (org-set-local 'org-columns-current-widths (nreverse widths))
+ (setq org-columns-full-header-line-format title)
+ (setq org-columns-previous-hscroll -1)
+ ; (org-columns-hscoll-title)
+ (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
+
+(defun org-columns-hscoll-title ()
+ "Set the `header-line-format' so that it scrolls along with the table."
+ (sit-for .0001) ; need to force a redisplay to update window-hscroll
+ (when (not (= (window-hscroll) org-columns-previous-hscroll))
+ (setq header-line-format
+ (concat (substring org-columns-full-header-line-format 0 1)
+ (substring org-columns-full-header-line-format
+ (1+ (window-hscroll))))
+ org-columns-previous-hscroll (window-hscroll))
+ (force-mode-line-update)))
+
+(defvar org-colview-initial-truncate-line-value nil
+ "Remember the value of `truncate-lines' across colview.")
+
+(defun org-columns-remove-overlays ()
+ "Remove all currently active column overlays."
+ (interactive)
+ (when (marker-buffer org-columns-begin-marker)
+ (with-current-buffer (marker-buffer org-columns-begin-marker)
+ (when (local-variable-p 'org-previous-header-line-format)
+ (setq header-line-format org-previous-header-line-format)
+ (kill-local-variable 'org-previous-header-line-format)
+ (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
+ (move-marker org-columns-begin-marker nil)
+ (move-marker org-columns-top-level-marker nil)
+ (org-unmodified
+ (mapc 'delete-overlay org-columns-overlays)
+ (setq org-columns-overlays nil)
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(read-only t))))
+ (when org-columns-flyspell-was-active
+ (flyspell-mode 1))
+ (when (local-variable-p 'org-colview-initial-truncate-line-value)
+ (setq truncate-lines org-colview-initial-truncate-line-value)))))
+
+(defun org-columns-cleanup-item (item fmt cphr)
+ "Remove from ITEM what is a column in the format FMT.
+CPHR is the complex heading regexp to use for parsing ITEM."
+ (let (fixitem)
+ (if (not cphr)
+ item
+ (unless (string-match "^\*+ " item)
+ (setq item (concat "* " item) fixitem t))
+ (if (string-match cphr item)
+ (setq item
+ (concat
+ (org-add-props (match-string 1 item) nil
+ 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
+ (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
+ " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
+ (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
+ (add-text-properties
+ 0 (1+ (match-end 1))
+ (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
+ item))
+ (if fixitem (replace-regexp-in-string "^\*+ " "" item) item))))
+
+(defun org-columns-compact-links (s)
+ "Replace [[link][desc]] with [desc] or [link]."
+ (while (string-match org-bracket-link-regexp s)
+ (setq s (replace-match
+ (concat "[" (match-string (if (match-end 3) 3 1) s) "]")
+ t t s)))
+ s)
+
+(defun org-columns-show-value ()
+ "Show the full value of the property."
+ (interactive)
+ (let ((value (get-char-property (point) 'org-columns-value)))
+ (message "Value is: %s" (or value ""))))
+
+(defvar org-agenda-columns-active) ;; defined in org-agenda.el
+
+(defun org-columns-quit ()
+ "Remove the column overlays and in this way exit column editing."
+ (interactive)
+ (org-unmodified
+ (org-columns-remove-overlays)
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(read-only t))))
+ (when (eq major-mode 'org-agenda-mode)
+ (setq org-agenda-columns-active nil)
+ (message
+ "Modification not yet reflected in Agenda buffer, use `r' to refresh")))
+
+(defun org-columns-check-computed ()
+ "Check if this column value is computed.
+If yes, throw an error indicating that changing it does not make sense."
+ (let ((val (get-char-property (point) 'org-columns-value)))
+ (when (and (stringp val)
+ (get-char-property 0 'org-computed val))
+ (error "This value is computed from the entry's children"))))
+
+(defun org-columns-todo (&optional arg)
+ "Change the TODO state during column view."
+ (interactive "P")
+ (org-columns-edit-value "TODO"))
+
+(defun org-columns-set-tags-or-toggle (&optional arg)
+ "Toggle checkbox at point, or set tags for current headline."
+ (interactive "P")
+ (if (string-match "\\`\\[[ xX-]\\]\\'"
+ (get-char-property (point) 'org-columns-value))
+ (org-columns-next-allowed-value)
+ (org-columns-edit-value "TAGS")))
+
+(defun org-columns-edit-value (&optional key)
+ "Edit the value of the property at point in column view.
+Where possible, use the standard interface for changing this line."
+ (interactive)
+ (org-columns-check-computed)
+ (let* ((col (current-column))
+ (key (or key (get-char-property (point) 'org-columns-key)))
+ (value (get-char-property (point) 'org-columns-value))
+ (bol (point-at-bol)) (eol (point-at-eol))
+ (pom (or (get-text-property bol 'org-hd-marker)
+ (point))) ; keep despite of compiler waring
+ (line-overlays
+ (delq nil (mapcar (lambda (x)
+ (and (eq (overlay-buffer x) (current-buffer))
+ (>= (overlay-start x) bol)
+ (<= (overlay-start x) eol)
+ x))
+ org-columns-overlays)))
+ (org-columns-time (time-to-number-of-days (current-time)))
+ nval eval allowed)
+ (cond
+ ((equal key "CLOCKSUM")
+ (error "This special column cannot be edited"))
+ ((equal key "ITEM")
+ (setq eval '(org-with-point-at pom
+ (org-edit-headline))))
+ ((equal key "TODO")
+ (setq eval '(org-with-point-at
+ pom
+ (call-interactively 'org-todo))))
+ ((equal key "PRIORITY")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-priority))))
+ ((equal key "TAGS")
+ (setq eval '(org-with-point-at pom
+ (let ((org-fast-tag-selection-single-key
+ (if (eq org-fast-tag-selection-single-key 'expert)
+ t org-fast-tag-selection-single-key)))
+ (call-interactively 'org-set-tags)))))
+ ((equal key "DEADLINE")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-deadline))))
+ ((equal key "SCHEDULED")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-schedule))))
+ ((equal key "BEAMER_env")
+ (setq eval '(org-with-point-at pom
+ (call-interactively 'org-beamer-select-environment))))
+ (t
+ (setq allowed (org-property-get-allowed-values pom key 'table))
+ (if allowed
+ (setq nval (org-icompleting-read
+ "Value: " allowed nil
+ (not (get-text-property 0 'org-unrestricted
+ (caar allowed)))))
+ (setq nval (read-string "Edit: " value)))
+ (setq nval (org-trim nval))
+ (when (not (equal nval value))
+ (setq eval '(org-entry-put pom key nval)))))
+ (when eval
+
+ (cond
+ ((equal major-mode 'org-agenda-mode)
+ (org-columns-eval eval)
+ ;; The following let preserves the current format, and makes sure
+ ;; that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties
+ (max (point-min) (1- bol)) eol '(read-only t)))
+ (unwind-protect
+ (progn
+ (setq org-columns-overlays
+ (org-delete-all line-overlays org-columns-overlays))
+ (mapc 'delete-overlay line-overlays)
+ (org-columns-eval eval))
+ (org-columns-display-here)))
+ (org-move-to-column col)
+ (if (and (derived-mode-p 'org-mode)
+ (nth 3 (assoc key org-columns-current-fmt-compiled)))
+ (org-columns-update key)))))))
+
+(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
+ "Edit the current headline, the part without TODO keyword, TAGS."
+ (org-back-to-heading)
+ (when (looking-at org-todo-line-regexp)
+ (let ((pos (point))
+ (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
+ (txt (match-string 3))
+ (post "")
+ txt2)
+ (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt)
+ (setq post (match-string 0 txt)
+ txt (substring txt 0 (match-beginning 0))))
+ (setq txt2 (read-string "Edit: " txt))
+ (when (not (equal txt txt2))
+ (goto-char pos)
+ (insert pre txt2 post)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil t)))))
+
+(defun org-columns-edit-allowed ()
+ "Edit the list of allowed values for the current property."
+ (interactive)
+ (let* ((pom (or (org-get-at-bol 'org-marker)
+ (org-get-at-bol 'org-hd-marker)
+ (point)))
+ (key (get-char-property (point) 'org-columns-key))
+ (key1 (concat key "_ALL"))
+ (allowed (org-entry-get pom key1 t))
+ nval)
+ ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
+ ;; FIXME: Write back to #+PROPERTY setting if that is needed.
+ (setq nval (read-string "Allowed: " allowed))
+ (org-entry-put
+ (cond ((marker-position org-entry-property-inherited-from)
+ org-entry-property-inherited-from)
+ ((marker-position org-columns-top-level-marker)
+ org-columns-top-level-marker)
+ (t pom))
+ key1 nval)))
+
+(defun org-columns-eval (form)
+ (let (hidep)
+ (save-excursion
+ (beginning-of-line 1)
+ ;; `next-line' is needed here, because it skips invisible line.
+ (condition-case nil (org-no-warnings (next-line 1)) (error nil))
+ (setq hidep (org-at-heading-p 1)))
+ (eval form)
+ (and hidep (hide-entry))))
+
+(defun org-columns-previous-allowed-value ()
+ "Switch to the previous allowed value for this column."
+ (interactive)
+ (org-columns-next-allowed-value t))
+
+(defun org-columns-next-allowed-value (&optional previous nth)
+ "Switch to the next allowed value for this column.
+When PREVIOUS is set, go to the previous value. When NTH is
+an integer, select that value."
+ (interactive)
+ (org-columns-check-computed)
+ (let* ((col (current-column))
+ (key (get-char-property (point) 'org-columns-key))
+ (value (get-char-property (point) 'org-columns-value))
+ (bol (point-at-bol)) (eol (point-at-eol))
+ (pom (or (get-text-property bol 'org-hd-marker)
+ (point))) ; keep despite of compiler waring
+ (line-overlays
+ (delq nil (mapcar (lambda (x)
+ (and (eq (overlay-buffer x) (current-buffer))
+ (>= (overlay-start x) bol)
+ (<= (overlay-start x) eol)
+ x))
+ org-columns-overlays)))
+ (allowed (or (org-property-get-allowed-values pom key)
+ (and (memq
+ (nth 4 (assoc key org-columns-current-fmt-compiled))
+ '(checkbox checkbox-n-of-m checkbox-percent))
+ '("[ ]" "[X]"))
+ (org-colview-construct-allowed-dates value)))
+ nval)
+ (when (integerp nth)
+ (setq nth (1- nth))
+ (if (= nth -1) (setq nth 9)))
+ (when (equal key "ITEM")
+ (error "Cannot edit item headline from here"))
+ (unless (or allowed (member key '("SCHEDULED" "DEADLINE")))
+ (error "Allowed values for this property have not been defined"))
+ (if (member key '("SCHEDULED" "DEADLINE"))
+ (setq nval (if previous 'earlier 'later))
+ (if previous (setq allowed (reverse allowed)))
+ (cond
+ (nth
+ (setq nval (nth nth allowed))
+ (if (not nval)
+ (error "There are only %d allowed values for property `%s'"
+ (length allowed) key)))
+ ((member value allowed)
+ (setq nval (or (car (cdr (member value allowed)))
+ (car allowed)))
+ (if (equal nval value)
+ (error "Only one allowed value for this property")))
+ (t (setq nval (car allowed)))))
+ (cond
+ ((equal major-mode 'org-agenda-mode)
+ (org-columns-eval '(org-entry-put pom key nval))
+ ;; The following let preserves the current format, and makes sure
+ ;; that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (remove-text-properties (1- bol) eol '(read-only t))
+ (unwind-protect
+ (progn
+ (setq org-columns-overlays
+ (org-delete-all line-overlays org-columns-overlays))
+ (mapc 'delete-overlay line-overlays)
+ (org-columns-eval '(org-entry-put pom key nval)))
+ (org-columns-display-here)))
+ (org-move-to-column col)
+ (and (nth 3 (assoc key org-columns-current-fmt-compiled))
+ (org-columns-update key))))))
+
+(defun org-colview-construct-allowed-dates (s)
+ "Construct a list of three dates around the date in S.
+This respects the format of the time stamp in S, active or non-active,
+and also including time or not. S must be just a time stamp, no text
+around it."
+ (when (and s (string-match (concat "^" org-ts-regexp3 "$") s))
+ (let* ((time (org-parse-time-string s 'nodefaults))
+ (active (equal (string-to-char s) ?<))
+ (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats))
+ time-before time-after)
+ (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (setf (car time) (or (car time) 0))
+ (setf (nth 1 time) (or (nth 1 time) 0))
+ (setf (nth 2 time) (or (nth 2 time) 0))
+ (setq time-before (copy-sequence time))
+ (setq time-after (copy-sequence time))
+ (setf (nth 3 time-before) (1- (nth 3 time)))
+ (setf (nth 3 time-after) (1+ (nth 3 time)))
+ (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
+ (list time-before time time-after)))))
+
+(defun org-verify-version (task)
+ (cond
+ ((eq task 'columns)
+ (if (or (featurep 'xemacs)
+ (< emacs-major-version 22))
+ (error "Emacs 22 is required for the columns feature")))))
+
+(defun org-columns-open-link (&optional arg)
+ (interactive "P")
+ (let ((value (get-char-property (point) 'org-columns-value)))
+ (org-open-link-from-string value arg)))
+
+(defun org-columns-get-format-and-top-level ()
+ (let ((fmt (org-columns-get-format)))
+ (org-columns-goto-top-level)
+ fmt))
+
+(defun org-columns-get-format (&optional fmt-string)
+ (interactive)
+ (let (fmt-as-property fmt)
+ (when (condition-case nil (org-back-to-heading) (error nil))
+ (setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
+ (setq fmt (or fmt-string fmt-as-property org-columns-default-format))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (org-columns-compile-format fmt)
+ fmt))
+
+(defun org-columns-goto-top-level ()
+ (when (condition-case nil (org-back-to-heading) (error nil))
+ (org-entry-get nil "COLUMNS" t))
+ (if (marker-position org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker org-entry-property-inherited-from)
+ (move-marker org-columns-top-level-marker (point))))
+
+(defun org-columns (&optional columns-fmt-string)
+ "Turn on column view on an org-mode file.
+When COLUMNS-FMT-STRING is non-nil, use it as the column format."
+ (interactive)
+ (org-verify-version 'columns)
+ (org-columns-remove-overlays)
+ (move-marker org-columns-begin-marker (point))
+ (let ((org-columns-time (time-to-number-of-days (current-time)))
+ beg end fmt cache maxwidths)
+ (org-columns-goto-top-level)
+ (setq fmt (org-columns-get-format columns-fmt-string))
+ (save-excursion
+ (goto-char org-columns-top-level-marker)
+ (setq beg (point))
+ (unless org-columns-inhibit-recalculation
+ (org-columns-compute-all))
+ (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
+ (point-max)))
+ ;; Get and cache the properties
+ (goto-char beg)
+ (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (org-clock-sum))))
+ (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (org-clock-sum-today))))
+ (while (re-search-forward org-outline-regexp-bol end t)
+ (if (and org-columns-skip-archived-trees
+ (looking-at (concat ".*:" org-archive-tag ":")))
+ (org-end-of-subtree t)
+ (push (cons (org-current-line) (org-entry-properties)) cache)))
+ (when cache
+ (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
+ (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-columns-display-here-title)
+ (when (org-set-local 'org-columns-flyspell-was-active
+ (org-bound-and-true-p flyspell-mode))
+ (flyspell-mode 0))
+ (unless (local-variable-p 'org-colview-initial-truncate-line-value)
+ (org-set-local 'org-colview-initial-truncate-line-value
+ truncate-lines))
+ (setq truncate-lines t)
+ (mapc (lambda (x)
+ (org-goto-line (car x))
+ (org-columns-display-here (cdr x)))
+ cache)))))
+
+(eval-when-compile (defvar org-columns-time))
+
+(defvar org-columns-compile-map
+ '(("none" none +)
+ (":" add_times +)
+ ("+" add_numbers +)
+ ("$" currency +)
+ ("X" checkbox +)
+ ("X/" checkbox-n-of-m +)
+ ("X%" checkbox-percent +)
+ ("max" max_numbers max)
+ ("min" min_numbers min)
+ ("mean" mean_numbers
+ (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+ (":max" max_times max)
+ (":min" min_times min)
+ (":mean" mean_times
+ (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+ ("@min" min_age min (lambda (x) (- org-columns-time x)))
+ ("@max" max_age max (lambda (x) (- org-columns-time x)))
+ ("@mean" mean_age
+ (lambda (&rest x) (/ (apply '+ x) (float (length x))))
+ (lambda (x) (- org-columns-time x)))
+ ("est+" estimate org-estimate-combine))
+ "Operator <-> format,function,calc map.
+Used to compile/uncompile columns format and completing read in
+interactive function `org-columns-new'.
+
+operator string used in #+COLUMNS definition describing the
+ summary type
+format symbol describing summary type selected interactively in
+ `org-columns-new' and internally in
+ `org-columns-number-to-string' and
+ `org-columns-string-to-number'
+function called with a list of values as argument to calculate
+ the summary value
+calc function called on every element before summarizing. This is
+ optional and should only be specified if needed")
+
+(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
+ "Insert a new column, to the left of the current column."
+ (interactive)
+ (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
+ cell)
+ (setq prop (org-icompleting-read
+ "Property: " (mapcar 'list (org-buffer-property-keys t nil t))
+ nil nil prop))
+ (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
+ (setq width (read-string "Column width: " (if width (number-to-string width))))
+ (if (string-match "\\S-" width)
+ (setq width (string-to-number width))
+ (setq width nil))
+ (setq fmt (org-icompleting-read
+ "Summary [none]: "
+ (mapcar (lambda (x) (list (symbol-name (cadr x))))
+ org-columns-compile-map)
+ nil t))
+ (setq fmt (intern fmt)
+ fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
+ (if (eq fmt 'none) (setq fmt nil))
+ (if editp
+ (progn
+ (setcar editp prop)
+ (setcdr editp (list title width nil fmt nil fun)))
+ (setq cell (nthcdr (1- (current-column))
+ org-columns-current-fmt-compiled))
+ (setcdr cell (cons (list prop title width nil fmt nil
+ (car fun) (cadr fun))
+ (cdr cell))))
+ (org-columns-store-format)
+ (org-columns-redo)))
+
+(defun org-columns-delete ()
+ "Delete the column at point from columns view."
+ (interactive)
+ (let* ((n (current-column))
+ (title (nth 1 (nth n org-columns-current-fmt-compiled))))
+ (when (y-or-n-p
+ (format "Are you sure you want to remove column \"%s\"? " title))
+ (setq org-columns-current-fmt-compiled
+ (delq (nth n org-columns-current-fmt-compiled)
+ org-columns-current-fmt-compiled))
+ (org-columns-store-format)
+ (org-columns-redo)
+ (if (>= (current-column) (length org-columns-current-fmt-compiled))
+ (backward-char 1)))))
+
+(defun org-columns-edit-attributes ()
+ "Edit the attributes of the current column."
+ (interactive)
+ (let* ((n (current-column))
+ (info (nth n org-columns-current-fmt-compiled)))
+ (apply 'org-columns-new info)))
+
+(defun org-columns-widen (arg)
+ "Make the column wider by ARG characters."
+ (interactive "p")
+ (let* ((n (current-column))
+ (entry (nth n org-columns-current-fmt-compiled))
+ (width (or (nth 2 entry)
+ (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (setq width (max 1 (+ width arg)))
+ (setcar (nthcdr 2 entry) width)
+ (org-columns-store-format)
+ (org-columns-redo)))
+
+(defun org-columns-narrow (arg)
+ "Make the column narrower by ARG characters."
+ (interactive "p")
+ (org-columns-widen (- arg)))
+
+(defun org-columns-move-right ()
+ "Swap this column with the one to the right."
+ (interactive)
+ (let* ((n (current-column))
+ (cell (nthcdr n org-columns-current-fmt-compiled))
+ e)
+ (when (>= n (1- (length org-columns-current-fmt-compiled)))
+ (error "Cannot shift this column further to the right"))
+ (setq e (car cell))
+ (setcar cell (car (cdr cell)))
+ (setcdr cell (cons e (cdr (cdr cell))))
+ (org-columns-store-format)
+ (org-columns-redo)
+ (forward-char 1)))
+
+(defun org-columns-move-left ()
+ "Swap this column with the one to the left."
+ (interactive)
+ (let* ((n (current-column)))
+ (when (= n 0)
+ (error "Cannot shift this column further to the left"))
+ (backward-char 1)
+ (org-columns-move-right)
+ (backward-char 1)))
+
+(defun org-columns-store-format ()
+ "Store the text version of the current columns format in appropriate place.
+This is either in the COLUMNS property of the node starting the current column
+display, or in the #+COLUMNS line of the current buffer."
+ (let (fmt (cnt 0))
+ (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (if (marker-position org-columns-top-level-marker)
+ (save-excursion
+ (goto-char org-columns-top-level-marker)
+ (if (and (org-at-heading-p)
+ (org-entry-get nil "COLUMNS"))
+ (org-entry-put nil "COLUMNS" fmt)
+ (goto-char (point-min))
+ ;; Overwrite all #+COLUMNS lines....
+ (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
+ (setq cnt (1+ cnt))
+ (replace-match (concat "#+COLUMNS: " fmt) t t))
+ (unless (> cnt 0)
+ (goto-char (point-min))
+ (or (org-at-heading-p t) (outline-next-heading))
+ (let ((inhibit-read-only t))
+ (insert-before-markers "#+COLUMNS: " fmt "\n")))
+ (org-set-local 'org-columns-default-format fmt))))))
+
+(defvar org-agenda-overriding-columns-format nil
+ "When set, overrides any other format definition for the agenda.
+Don't set this, this is meant for dynamic scoping.")
+
+(defun org-columns-get-autowidth-alist (s cache)
+ "Derive the maximum column widths from the format and the cache."
+ (let ((start 0) rtn)
+ (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start)
+ (push (cons (match-string 1 s) 1) rtn)
+ (setq start (match-end 0)))
+ (mapc (lambda (x)
+ (setcdr x (apply 'max
+ (mapcar
+ (lambda (y)
+ (length (or (cdr (assoc (car x) (cdr y))) " ")))
+ cache))))
+ rtn)
+ rtn))
+
+(defun org-columns-compute-all ()
+ "Compute all columns that have operators defined."
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (let ((columns org-columns-current-fmt-compiled)
+ (org-columns-time (time-to-number-of-days (current-time)))
+ col)
+ (while (setq col (pop columns))
+ (when (nth 3 col)
+ (save-excursion
+ (org-columns-compute (car col)))))))
+
+(defun org-columns-update (property)
+ "Recompute PROPERTY, and update the columns display for it."
+ (org-columns-compute property)
+ (let (fmt val pos)
+ (save-excursion
+ (mapc (lambda (ov)
+ (when (equal (overlay-get ov 'org-columns-key) property)
+ (setq pos (overlay-start ov))
+ (goto-char pos)
+ (when (setq val (cdr (assoc property
+ (get-text-property
+ (point-at-bol) 'org-summaries))))
+ (setq fmt (overlay-get ov 'org-columns-format))
+ (overlay-put ov 'org-columns-value val)
+ (overlay-put ov 'display (format fmt val)))))
+ org-columns-overlays))))
+
+(defvar org-inlinetask-min-level
+ (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
+(defun org-columns-compute (property)
+ "Sum the values of property PROPERTY hierarchically, for the entire buffer."
+ (interactive)
+ (let* ((re org-outline-regexp-bol)
+ (lmax 30) ; Does anyone use deeper levels???
+ (lvals (make-vector lmax nil))
+ (lflag (make-vector lmax nil))
+ (level 0)
+ (ass (assoc property org-columns-current-fmt-compiled))
+ (format (nth 4 ass))
+ (printf (nth 5 ass))
+ (fun (nth 6 ass))
+ (calc (or (nth 7 ass) 'identity))
+ (beg org-columns-top-level-marker)
+ (inminlevel org-inlinetask-min-level)
+ (last-level org-inlinetask-min-level)
+ val valflag flag end sumpos sum-alist sum str str1 useval)
+ (save-excursion
+ ;; Find the region to compute
+ (goto-char beg)
+ (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
+ (goto-char end)
+ ;; Walk the tree from the back and do the computations
+ (while (re-search-backward re beg t)
+ (setq sumpos (match-beginning 0)
+ last-level (if (not (or (zerop level) (eq level inminlevel)))
+ level last-level)
+ level (org-outline-level)
+ val (org-entry-get nil property)
+ valflag (and val (string-match "\\S-" val)))
+ (cond
+ ((< level last-level)
+ ;; put the sum of lower levels here as a property
+ (setq sum (+ (if (and (/= last-level inminlevel)
+ (aref lvals last-level))
+ (apply fun (aref lvals last-level)) 0)
+ (if (aref lvals inminlevel)
+ (apply fun (aref lvals inminlevel)) 0))
+ flag (or (aref lflag last-level) ; any valid entries from children?
+ (aref lflag inminlevel)) ; or inline tasks?
+ str (org-columns-number-to-string sum format printf)
+ str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
+ useval (if flag str1 (if valflag val ""))
+ sum-alist (get-text-property sumpos 'org-summaries))
+ (if (assoc property sum-alist)
+ (setcdr (assoc property sum-alist) useval)
+ (push (cons property useval) sum-alist)
+ (org-unmodified
+ (add-text-properties sumpos (1+ sumpos)
+ (list 'org-summaries sum-alist))))
+ (when (and val (not (equal val (if flag str val))))
+ (org-entry-put nil property (if flag str val)))
+ ;; add current to current level accumulator
+ (when (or flag valflag)
+ (push (if flag
+ sum
+ (funcall calc (org-columns-string-to-number
+ (if flag str val) format)))
+ (aref lvals level))
+ (aset lflag level t))
+ ;; clear accumulators for deeper levels
+ (loop for l from (1+ level) to (1- lmax) do
+ (aset lvals l nil)
+ (aset lflag l nil)))
+ ((>= level last-level)
+ ;; add what we have here to the accumulator for this level
+ (when valflag
+ (push (funcall calc (org-columns-string-to-number val format))
+ (aref lvals level))
+ (aset lflag level t)))
+ (t (error "This should not happen")))))))
+
+(defun org-columns-redo ()
+ "Construct the column display again."
+ (interactive)
+ (message "Recomputing columns...")
+ (let ((line (org-current-line))
+ (col (current-column)))
+ (save-excursion
+ (if (marker-position org-columns-begin-marker)
+ (goto-char org-columns-begin-marker))
+ (org-columns-remove-overlays)
+ (if (derived-mode-p 'org-mode)
+ (call-interactively 'org-columns)
+ (org-agenda-redo)
+ (call-interactively 'org-agenda-columns)))
+ (org-goto-line line)
+ (move-to-column col))
+ (message "Recomputing columns...done"))
+
+(defun org-columns-not-in-agenda ()
+ (if (eq major-mode 'org-agenda-mode)
+ (error "This command is only allowed in Org-mode buffers")))
+
+(defun org-string-to-number (s)
+ "Convert string to number, and interpret hh:mm:ss."
+ (if (not (string-match ":" s))
+ (string-to-number s)
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum)))
+
+(defun org-columns-number-to-string (n fmt &optional printf)
+ "Convert a computed column number to a string value, according to FMT."
+ (cond
+ ((memq fmt '(estimate)) (org-estimate-print n printf))
+ ((not (numberp n)) "")
+ ((memq fmt '(add_times max_times min_times mean_times))
+ (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
+ (format org-time-clocksum-format h m)))
+ ((eq fmt 'checkbox)
+ (cond ((= n (floor n)) "[X]")
+ ((> n 1.) "[-]")
+ (t "[ ]")))
+ ((memq fmt '(checkbox-n-of-m checkbox-percent))
+ (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1))))))
+ (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent))))
+ (printf (format printf n))
+ ((eq fmt 'currency)
+ (format "%.2f" n))
+ ((memq fmt '(min_age max_age mean_age))
+ (org-format-time-period n))
+ (t (number-to-string n))))
+
+(defun org-nofm-to-completion (n m &optional percent)
+ (if (not percent)
+ (format "[%d/%d]" n m)
+ (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))
+
+
+(defun org-columns-string-to-number (s fmt)
+ "Convert a column value to a number that can be used for column computing."
+ (if s
+ (cond
+ ((memq fmt '(min_age max_age mean_age))
+ (cond ((string= s "") org-columns-time)
+ ((string-match
+ "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+ s)
+ (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+ (string-to-number (match-string 2 s))))
+ (string-to-number (match-string 3 s))))
+ (string-to-number (match-string 4 s))))
+ (t (time-to-number-of-days (apply 'encode-time
+ (org-parse-time-string s t))))))
+ ((string-match ":" s)
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum))
+ ((string-match (concat "\\([0-9.]+\\) *\\("
+ (regexp-opt (mapcar 'car org-effort-durations))
+ "\\)") s)
+ (setq s (concat "0:" (org-duration-string-to-minutes s t)))
+ (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+ (while l
+ (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+ sum))
+ ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
+ (if (equal s "[X]") 1. 0.000001))
+ ((memq fmt '(estimate)) (org-string-to-estimate s))
+ (t (string-to-number s)))))
+
+(defun org-columns-uncompile-format (cfmt)
+ "Turn the compiled columns format back into a string representation."
+ (let ((rtn "") e s prop title op op-match width fmt printf fun calc)
+ (while (setq e (pop cfmt))
+ (setq prop (car e)
+ title (nth 1 e)
+ width (nth 2 e)
+ op (nth 3 e)
+ fmt (nth 4 e)
+ printf (nth 5 e)
+ fun (nth 6 e)
+ calc (nth 7 e))
+ (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map))
+ (setq op (car op-match)))
+ (if (and op printf) (setq op (concat op ";" printf)))
+ (if (equal title prop) (setq title nil))
+ (setq s (concat "%" (if width (number-to-string width))
+ prop
+ (if title (concat "(" title ")"))
+ (if op (concat "{" op "}"))))
+ (setq rtn (concat rtn " " s)))
+ (org-trim rtn)))
+
+(defun org-columns-compile-format (fmt)
+ "Turn a column format string into an alist of specifications.
+The alist has one entry for each column in the format. The elements of
+that list are:
+property the property
+title the title field for the columns
+width the column width in characters, can be nil for automatic
+operator the operator if any
+format the output format for computed results, derived from operator
+printf a printf format for computed values
+fun the lisp function to compute summary values, derived from operator
+calc function to get values from base elements"
+ (let ((start 0) width prop title op op-match f printf fun calc)
+ (setq org-columns-current-fmt-compiled nil)
+ (while (string-match
+ (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
+ fmt start)
+ (setq start (match-end 0)
+ width (match-string 1 fmt)
+ prop (match-string 2 fmt)
+ title (or (match-string 3 fmt) prop)
+ op (match-string 4 fmt)
+ f nil
+ printf nil
+ fun '+
+ calc nil)
+ (if width (setq width (string-to-number width)))
+ (when (and op (string-match ";" op))
+ (setq printf (substring op (match-end 0))
+ op (substring op 0 (match-beginning 0))))
+ (when (setq op-match (assoc op org-columns-compile-map))
+ (setq f (cadr op-match)
+ fun (caddr op-match)
+ calc (cadddr op-match)))
+ (push (list prop title width op f printf fun calc)
+ org-columns-current-fmt-compiled))
+ (setq org-columns-current-fmt-compiled
+ (nreverse org-columns-current-fmt-compiled))))
+
+
+;;; Dynamic block for Column view
+
+(defvar org-heading-regexp) ; defined in org.el
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
+ "Get the column view of the current buffer or subtree.
+The first optional argument MAXLEVEL sets the level limit. A
+second optional argument SKIP-EMPTY-ROWS tells whether to skip
+empty rows, an empty row being one where all the column view
+specifiers except ITEM are empty. This function returns a list
+containing the title row and all other rows. Each row is a list
+of fields."
+ (save-excursion
+ (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
+ (re-comment (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (re-archive (concat ".*:" org-archive-tag ":"))
+ (n (length title)) row tbl)
+ (goto-char (point-min))
+ (while (re-search-forward org-heading-regexp nil t)
+ (catch 'next
+ (when (and (or (null maxlevel)
+ (>= maxlevel
+ (if org-odd-levels-only
+ (/ (1+ (length (match-string 1))) 2)
+ (length (match-string 1)))))
+ (get-char-property (match-beginning 0) 'org-columns-key))
+ (when (save-excursion
+ (goto-char (point-at-bol))
+ (or (looking-at re-comment)
+ (looking-at re-archive)))
+ (org-end-of-subtree t)
+ (throw 'next t))
+ (setq row nil)
+ (loop for i from 0 to (1- n) do
+ (push
+ (org-quote-vert
+ (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
+ (get-char-property (+ (match-beginning 0) i) 'org-columns-value)
+ ""))
+ row))
+ (setq row (nreverse row))
+ (unless (and skip-empty-rows
+ (eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
+ (push row tbl)))))
+ (append (list title 'hline) (nreverse tbl)))))
+
+(defun org-dblock-write:columnview (params)
+ "Write the column view table.
+PARAMS is a property list of parameters:
+
+:width enforce same column widths with <N> specifiers.
+:id the :ID: property of the entry where the columns view
+ should be built. When the symbol `local', call locally.
+ When `global' call column view with the cursor at the beginning
+ of the buffer (usually this means that the whole buffer switches
+ to column view). When \"file:path/to/file.org\", invoke column
+ view at the start of that file. Otherwise, the ID is located
+ using `org-id-find'.
+:hlines When t, insert a hline before each item. When a number, insert
+ a hline before each level <= that number.
+:vlines When t, make each column a colgroup to enforce vertical lines.
+:maxlevel When set to a number, don't capture headlines below this level.
+:skip-empty-rows
+ When t, skip rows where all specifiers other than ITEM are empty.
+:format When non-nil, specify the column view format to use."
+ (let ((pos (move-marker (make-marker) (point)))
+ (hlines (plist-get params :hlines))
+ (vlines (plist-get params :vlines))
+ (maxlevel (plist-get params :maxlevel))
+ (content-lines (org-split-string (plist-get params :content) "\n"))
+ (skip-empty-rows (plist-get params :skip-empty-rows))
+ (columns-fmt (plist-get params :format))
+ (case-fold-search t)
+ tbl id idpos nfields tmp recalc line
+ id-as-string view-file view-pos)
+ (when (setq id (plist-get params :id))
+ (setq id-as-string (cond ((numberp id) (number-to-string id))
+ ((symbolp id) (symbol-name id))
+ ((stringp id) id)
+ (t "")))
+ (cond ((not id) nil)
+ ((eq id 'global) (setq view-pos (point-min)))
+ ((eq id 'local))
+ ((string-match "^file:\\(.*\\)" id-as-string)
+ (setq view-file (match-string 1 id-as-string)
+ view-pos 1)
+ (unless (file-exists-p view-file)
+ (error "No such file: \"%s\"" id-as-string)))
+ ((setq idpos (org-find-entry-with-id id))
+ (setq view-pos idpos))
+ ((setq idpos (org-id-find id))
+ (setq view-file (car idpos))
+ (setq view-pos (cdr idpos)))
+ (t (error "Cannot find entry with :ID: %s" id))))
+ (with-current-buffer (if view-file
+ (get-file-buffer view-file)
+ (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (or view-pos (point)))
+ (org-columns columns-fmt)
+ (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
+ (setq nfields (length (car tbl)))
+ (org-columns-quit))))
+ (goto-char pos)
+ (move-marker pos nil)
+ (when tbl
+ (when (plist-get params :hlines)
+ (setq tmp nil)
+ (while tbl
+ (if (eq (car tbl) 'hline)
+ (push (pop tbl) tmp)
+ (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
+ (if (and (not (eq (car tmp) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines)
+ (<= (- (match-end 1) (match-beginning 1))
+ hlines))))
+ (push 'hline tmp)))
+ (push (pop tbl) tmp)))
+ (setq tbl (nreverse tmp)))
+ (when vlines
+ (setq tbl (mapcar (lambda (x)
+ (if (eq 'hline x) x (cons "" x)))
+ tbl))
+ (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
+ (setq pos (point))
+ (when content-lines
+ (while (string-match "^#" (car content-lines))
+ (insert (pop content-lines) "\n")))
+ (insert (org-listtable-to-string tbl))
+ (when (plist-get params :width)
+ (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
+ org-columns-current-widths "|")))
+ (while (setq line (pop content-lines))
+ (when (string-match "^#" line)
+ (insert "\n" line)
+ (when (string-match "^[ \t]*#\\+tblfm" line)
+ (setq recalc t))))
+ (if recalc
+ (progn (goto-char pos) (org-table-recalculate 'all))
+ (goto-char pos)
+ (org-table-align)))))
+
+(defun org-listtable-to-string (tbl)
+ "Convert a listtable TBL to a string that contains the Org-mode table.
+The table still need to be aligned. The resulting string has no leading
+and tailing newline characters."
+ (mapconcat
+ (lambda (x)
+ (cond
+ ((listp x)
+ (concat "|" (mapconcat 'identity x "|") "|"))
+ ((eq x 'hline) "|-|")
+ (t (error "Garbage in listtable: %s" x))))
+ tbl "\n"))
+
+(defun org-insert-columns-dblock ()
+ "Create a dynamic block capturing a column view table."
+ (interactive)
+ (let ((defaults '(:name "columnview" :hlines 1))
+ (id (org-icompleting-read
+ "Capture columns (local, global, entry with :ID: property) [local]: "
+ (append '(("global") ("local"))
+ (mapcar 'list (org-property-values "ID"))))))
+ (if (equal id "") (setq id 'local))
+ (if (equal id "global") (setq id 'global))
+ (setq defaults (append defaults (list :id id)))
+ (org-create-dblock defaults)
+ (org-update-dblock)))
+
+;;; Column view in the agenda
+
+(defvar org-agenda-view-columns-initially nil
+ "When set, switch to columns view immediately after creating the agenda.")
+
+(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
+(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
+(defvar org-agenda-columns-add-appointments-to-effort-sum); as well
+
+(defun org-agenda-columns ()
+ "Turn on or update column view in the agenda."
+ (interactive)
+ (org-verify-version 'columns)
+ (org-columns-remove-overlays)
+ (move-marker org-columns-begin-marker (point))
+ (let ((org-columns-time (time-to-number-of-days (current-time)))
+ cache maxwidths m p a d fmt)
+ (cond
+ ((and (boundp 'org-agenda-overriding-columns-format)
+ org-agenda-overriding-columns-format)
+ (setq fmt org-agenda-overriding-columns-format))
+ ((setq m (org-get-at-bol 'org-hd-marker))
+ (setq fmt (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format))))
+ ((and (boundp 'org-columns-current-fmt)
+ (local-variable-p 'org-columns-current-fmt)
+ org-columns-current-fmt)
+ (setq fmt org-columns-current-fmt))
+ ((setq m (next-single-property-change (point-min) 'org-hd-marker))
+ (setq m (get-text-property m 'org-hd-marker))
+ (setq fmt (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format)))))
+ (setq fmt (or fmt org-columns-default-format))
+ (org-set-local 'org-columns-current-fmt fmt)
+ (org-columns-compile-format fmt)
+ (when org-agenda-columns-compute-summary-properties
+ (org-agenda-colview-compute org-columns-current-fmt-compiled))
+ (save-excursion
+ ;; Get and cache the properties
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (setq m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker)))
+ (setq p (org-entry-properties m))
+
+ (when (or (not (setq a (assoc org-effort-property p)))
+ (not (string-match "\\S-" (or (cdr a) ""))))
+ ;; OK, the property is not defined. Use appointment duration?
+ (when (and org-agenda-columns-add-appointments-to-effort-sum
+ (setq d (get-text-property (point) 'duration)))
+ (setq d (org-minutes-to-hh:mm-string d))
+ (put-text-property 0 (length d) 'face 'org-warning d)
+ (push (cons org-effort-property d) p)))
+ (push (cons (org-current-line) p) cache))
+ (beginning-of-line 2))
+ (when cache
+ (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
+ (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-columns-display-here-title)
+ (when (org-set-local 'org-columns-flyspell-was-active
+ (org-bound-and-true-p flyspell-mode))
+ (flyspell-mode 0))
+ (mapc (lambda (x)
+ (org-goto-line (car x))
+ (org-columns-display-here (cdr x)))
+ cache)
+ (when org-agenda-columns-show-summaries
+ (org-agenda-colview-summarize cache))))))
+
+(defun org-agenda-colview-summarize (cache)
+ "Summarize the summarizable columns in column view in the agenda.
+This will add overlays to the date lines, to show the summary for each day."
+ (let* ((fmt (mapcar (lambda (x)
+ (if (string-match "CLOCKSUM.*" (car x))
+ (list (match-string 0 (car x))
+ (nth 1 x) (nth 2 x) ":" 'add_times
+ nil '+ nil)
+ x))
+ org-columns-current-fmt-compiled))
+ line c c1 stype calc sumfunc props lsum entries prop v title)
+ (catch 'exit
+ (when (delq nil (mapcar 'cadr fmt))
+ ;; OK, at least one summation column, it makes sense to try this
+ (goto-char (point-max))
+ (while t
+ (when (or (get-text-property (point) 'org-date-line)
+ (eq (get-text-property (point) 'face)
+ 'org-agenda-structure))
+ ;; OK, this is a date line that should be used
+ (setq line (org-current-line))
+ (setq entries nil c cache cache nil)
+ (while (setq c1 (pop c))
+ (if (> (car c1) line)
+ (push c1 entries)
+ (push c1 cache)))
+ ;; now ENTRIES are the ones we want to use, CACHE is the rest
+ ;; Compute the summaries for the properties we want,
+ ;; set nil properties for the rest.
+ (when (setq entries (mapcar 'cdr entries))
+ (setq props
+ (mapcar
+ (lambda (f)
+ (setq prop (car f)
+ title (nth 1 f)
+ stype (nth 4 f)
+ sumfunc (nth 6 f)
+ calc (or (nth 7 f) 'identity))
+ (cond
+ ((equal prop "ITEM")
+ (cons prop (buffer-substring (point-at-bol)
+ (point-at-eol))))
+ ((not stype) (cons prop ""))
+ (t ;; do the summary
+ (setq lsum nil)
+ (dolist (x entries)
+ (setq v (cdr (assoc prop x)))
+ (if v
+ (push
+ (funcall
+ (if (not (get-text-property 0 'org-computed v))
+ calc
+ 'identity)
+ (org-columns-string-to-number
+ v stype))
+ lsum)))
+ (setq lsum (remove nil lsum))
+ (setq lsum
+ (cond ((> (length lsum) 1)
+ (org-columns-number-to-string
+ (apply sumfunc lsum) stype))
+ ((eq (length lsum) 1)
+ (org-columns-number-to-string
+ (car lsum) stype))
+ (t "")))
+ (put-text-property 0 (length lsum) 'face 'bold lsum)
+ (unless (eq calc 'identity)
+ (put-text-property 0 (length lsum) 'org-computed t lsum))
+ (cons prop lsum))))
+ fmt))
+ (org-columns-display-here props 'dateline)
+ (org-set-local 'org-agenda-columns-active t)))
+ (if (bobp) (throw 'exit t))
+ (beginning-of-line 0))))))
+
+(defun org-agenda-colview-compute (fmt)
+ "Compute the relevant columns in the contributing source buffers."
+ (let ((files org-agenda-contributing-files)
+ (org-columns-begin-marker (make-marker))
+ (org-columns-top-level-marker (make-marker))
+ f fm a b)
+ (while (setq f (pop files))
+ (setq b (find-buffer-visiting f))
+ (with-current-buffer (or (buffer-base-buffer b) b)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(org-summaries t)))
+ (goto-char (point-min))
+ (org-columns-get-format-and-top-level)
+ (while (setq fm (pop fmt))
+ (cond ((equal (car fm) "CLOCKSUM")
+ (org-clock-sum))
+ ((equal (car fm) "CLOCKSUM_T")
+ (org-clock-sum-today))
+ ((and (nth 4 fm)
+ (setq a (assoc (car fm)
+ org-columns-current-fmt-compiled))
+ (equal (nth 4 a) (nth 4 fm)))
+ (org-columns-compute (car fm)))))))))))
+
+(defun org-format-time-period (interval)
+ "Convert time in fractional days to days/hours/minutes/seconds."
+ (if (numberp interval)
+ (let* ((days (floor interval))
+ (frac-hours (* 24 (- interval days)))
+ (hours (floor frac-hours))
+ (minutes (floor (* 60 (- frac-hours hours))))
+ (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
+ (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
+ ""))
+
+(defun org-estimate-mean-and-var (v)
+ "Return the mean and variance of an estimate."
+ (let* ((low (float (car v)))
+ (high (float (cadr v)))
+ (mean (/ (+ low high) 2.0))
+ (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0)))
+ (list mean var)))
+
+(defun org-estimate-combine (&rest el)
+ "Combine a list of estimates, using mean and variance.
+The mean and variance of the result will be the sum of the means
+and variances (respectively) of the individual estimates."
+ (let ((mean 0)
+ (var 0))
+ (mapc (lambda (e)
+ (let ((stats (org-estimate-mean-and-var e)))
+ (setq mean (+ mean (car stats)))
+ (setq var (+ var (cadr stats)))))
+ el)
+ (let ((stdev (sqrt var)))
+ (list (- mean stdev) (+ mean stdev)))))
+
+(defun org-estimate-print (e &optional fmt)
+ "Prepare a string representation of an estimate.
+This formats these numbers as two numbers with a \"-\" between them."
+ (if (null fmt) (set 'fmt "%.0f"))
+ (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))
+
+(defun org-string-to-estimate (s)
+ "Convert a string to an estimate.
+The string should be two numbers joined with a \"-\"."
+ (if (string-match "\\(.*\\)-\\(.*\\)" s)
+ (list (string-to-number (match-string 1 s))
+ (string-to-number(match-string 2 s)))
+ (list (string-to-number s) (string-to-number s))))
+
+(provide 'org-colview)
+
+;;; org-colview.el ends here
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
new file mode 100644
index 0000000..7604284
--- /dev/null
+++ b/lisp/org-compat.el
@@ -0,0 +1,465 @@
+;;; org-compat.el --- Compatibility code for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains code needed for compatibility with XEmacs and older
+;; versions of GNU Emacs.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'org-macs)
+
+(declare-function w32-focus-frame "term/w32-win" (frame))
+
+;; The following constant is for backward compatibility. We do not use
+;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs)
+;; at compilation time and can therefore optimize code better.
+(defconst org-xemacs-p (featurep 'xemacs))
+(defconst org-format-transports-properties-p
+ (let ((x "a"))
+ (add-text-properties 0 1 '(test t) x)
+ (get-text-property 0 'test (format "%s" x)))
+ "Does format transport text properties?")
+
+(defun org-compatible-face (inherits specs)
+ "Make a compatible face specification.
+If INHERITS is an existing face and if the Emacs version supports it,
+just inherit the face. If INHERITS is set and the Emacs version does
+not support it, copy the face specification from the inheritance face.
+If INHERITS is not given and SPECS is, use SPECS to define the face.
+XEmacs and Emacs 21 do not know about the `min-colors' attribute.
+For them we convert a (min-colors 8) entry to a `tty' entry and move it
+to the top of the list. The `min-colors' attribute will be removed from
+any other entries, and any resulting duplicates will be removed entirely."
+ (when (and inherits (facep inherits) (not specs))
+ (setq specs (or specs
+ (get inherits 'saved-face)
+ (get inherits 'face-defface-spec))))
+ (cond
+ ((and inherits (facep inherits)
+ (not (featurep 'xemacs))
+ (>= emacs-major-version 22)
+ ;; do not inherit outline faces before Emacs 23
+ (or (>= emacs-major-version 23)
+ (not (string-match "\\`outline-[0-9]+"
+ (symbol-name inherits)))))
+ (list (list t :inherit inherits)))
+ ((or (featurep 'xemacs) (< emacs-major-version 22))
+ ;; These do not understand the `min-colors' attribute.
+ (let (r e a)
+ (while (setq e (pop specs))
+ (cond
+ ((memq (car e) '(t default)) (push e r))
+ ((setq a (member '(min-colors 8) (car e)))
+ (nconc r (list (cons (cons '(type tty) (delq (car a) (car e)))
+ (cdr e)))))
+ ((setq a (assq 'min-colors (car e)))
+ (setq e (cons (delq a (car e)) (cdr e)))
+ (or (assoc (car e) r) (push e r)))
+ (t (or (assoc (car e) r) (push e r)))))
+ (nreverse r)))
+ (t specs)))
+(put 'org-compatible-face 'lisp-indent-function 1)
+
+(defun org-version-check (version feature level)
+ (let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
+ (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
+ (rmaj (or (nth 0 v1) 99))
+ (rmin (or (nth 1 v1) 99))
+ (rbld (or (nth 2 v1) 99))
+ (maj (or (nth 0 v2) 0))
+ (min (or (nth 1 v2) 0))
+ (bld (or (nth 2 v2) 0)))
+ (if (or (< maj rmaj)
+ (and (= maj rmaj)
+ (< min rmin))
+ (and (= maj rmaj)
+ (= min rmin)
+ (< bld rbld)))
+ (if (eq level :predicate)
+ ;; just return if we have the version
+ nil
+ (let ((msg (format "Emacs %s or greater is recommended for %s"
+ version feature)))
+ (display-warning 'org msg level)
+ t))
+ t)))
+
+
+;;;; Emacs/XEmacs compatibility
+
+;; Keys
+(defconst org-xemacs-key-equivalents
+ '(([mouse-1] . [button1])
+ ([mouse-2] . [button2])
+ ([mouse-3] . [button3])
+ ([C-mouse-4] . [(control mouse-4)])
+ ([C-mouse-5] . [(control mouse-5)]))
+ "Translation alist for a couple of keys.")
+
+;; Overlay compatibility functions
+(defun org-detach-overlay (ovl)
+ (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl)))
+(defun org-overlay-display (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (if (featurep 'xemacs)
+ (let ((gl (make-glyph text)))
+ (and face (set-glyph-face gl face))
+ (set-extent-property ovl 'invisible t)
+ (set-extent-property ovl 'end-glyph gl))
+ (overlay-put ovl 'display text)
+ (if face (overlay-put ovl 'face face))
+ (if evap (overlay-put ovl 'evaporate t))))
+(defun org-overlay-before-string (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (if (featurep 'xemacs)
+ (let ((gl (make-glyph text)))
+ (and face (set-glyph-face gl face))
+ (set-extent-property ovl 'begin-glyph gl))
+ (if face (org-add-props text nil 'face face))
+ (overlay-put ovl 'before-string text)
+ (if evap (overlay-put ovl 'evaporate t))))
+(defun org-find-overlays (prop &optional pos delete)
+ "Find all overlays specifying PROP at POS or point.
+If DELETE is non-nil, delete all those overlays."
+ (let ((overlays (overlays-at (or pos (point))))
+ ov found)
+ (while (setq ov (pop overlays))
+ (if (overlay-get ov prop)
+ (if delete (delete-overlay ov) (push ov found))))
+ found))
+
+(defun org-get-x-clipboard (value)
+ "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21."
+ (if (eq window-system 'x)
+ (let ((x (org-get-x-clipboard-compat value)))
+ (if x (org-no-properties x)))))
+
+(defsubst org-decompose-region (beg end)
+ "Decompose from BEG to END."
+ (if (featurep 'xemacs)
+ (let ((modified-p (buffer-modified-p))
+ (buffer-read-only nil))
+ (remove-text-properties beg end '(composition nil))
+ (set-buffer-modified-p modified-p))
+ (decompose-region beg end)))
+
+;; Miscellaneous functions
+
+(defun org-add-hook (hook function &optional append local)
+ "Add-hook, compatible with both Emacsen."
+ (if (and local (featurep 'xemacs))
+ (add-local-hook hook function append)
+ (add-hook hook function append local)))
+
+(defun org-add-props (string plist &rest props)
+ "Add text properties to entire string, from beginning to end.
+PLIST may be a list of properties, PROPS are individual properties and values
+that will be added to PLIST. Returns the string that was modified."
+ (add-text-properties
+ 0 (length string) (if props (append plist props) plist) string)
+ string)
+(put 'org-add-props 'lisp-indent-function 2)
+
+(defun org-fit-window-to-buffer (&optional window max-height min-height
+ shrink-only)
+ "Fit WINDOW to the buffer, but only if it is not a side-by-side window.
+WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
+passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
+`shrink-window-if-larger-than-buffer' instead, the height limit is
+ignored in this case."
+ (cond ((if (fboundp 'window-full-width-p)
+ (not (window-full-width-p window))
+ (> (frame-width) (window-width window)))
+ ;; do nothing if another window would suffer
+ )
+ ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
+ (fit-window-to-buffer window max-height min-height))
+ ((fboundp 'shrink-window-if-larger-than-buffer)
+ (shrink-window-if-larger-than-buffer window)))
+ (or window (selected-window)))
+
+(defun org-number-sequence (from &optional to inc)
+ "Call `number-sequence or emulate it."
+ (if (fboundp 'number-sequence)
+ (number-sequence from to inc)
+ (if (or (not to) (= from to))
+ (list from)
+ (or inc (setq inc 1))
+ (when (zerop inc) (error "The increment can not be zero"))
+ (let (seq (n 0) (next from))
+ (if (> inc 0)
+ (while (<= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc))))
+ (while (>= next to)
+ (setq seq (cons next seq)
+ n (1+ n)
+ next (+ from (* n inc)))))
+ (nreverse seq)))))
+
+;; Region compatibility
+
+(defvar org-ignore-region nil
+ "To temporarily disable the active region.")
+
+(defun org-region-active-p ()
+ "Is `transient-mark-mode' on and the region active?
+Works on both Emacs and XEmacs."
+ (if org-ignore-region
+ nil
+ (if (featurep 'xemacs)
+ (and zmacs-regions (region-active-p))
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ (and transient-mark-mode mark-active))))) ; Emacs 22 and before
+
+(defun org-cursor-to-region-beginning ()
+ (when (and (org-region-active-p)
+ (> (point) (region-beginning)))
+ (exchange-point-and-mark)))
+
+;; Emacs 22 misses `activate-mark'
+(if (fboundp 'activate-mark)
+ (defalias 'org-activate-mark 'activate-mark)
+ (defun org-activate-mark ()
+ (when (mark t)
+ (setq mark-active t)
+ (when (and (boundp 'transient-mark-mode)
+ (not transient-mark-mode))
+ (setq transient-mark-mode 'lambda))
+ (when (boundp 'zmacs-regions)
+ (setq zmacs-regions t)))))
+
+
+;; Invisibility compatibility
+
+(defun org-remove-from-invisibility-spec (arg)
+ "Remove elements from `buffer-invisibility-spec'."
+ (if (fboundp 'remove-from-invisibility-spec)
+ (remove-from-invisibility-spec arg)
+ (if (consp buffer-invisibility-spec)
+ (setq buffer-invisibility-spec
+ (delete arg buffer-invisibility-spec)))))
+
+(defun org-in-invisibility-spec-p (arg)
+ "Is ARG a member of `buffer-invisibility-spec'?"
+ (if (consp buffer-invisibility-spec)
+ (member arg buffer-invisibility-spec)
+ nil))
+
+(defmacro org-xemacs-without-invisibility (&rest body)
+ "Turn off extents with invisibility while executing BODY."
+ `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol)
+ 'all-extents-closed-open 'invisible))
+ ext-inv-specs)
+ (dolist (ext ext-inv)
+ (when (extent-property ext 'invisible)
+ (add-to-list 'ext-inv-specs (list ext (extent-property
+ ext 'invisible)))
+ (set-extent-property ext 'invisible nil)))
+ ,@body
+ (dolist (ext-inv-spec ext-inv-specs)
+ (set-extent-property (car ext-inv-spec) 'invisible
+ (cadr ext-inv-spec)))))
+(def-edebug-spec org-xemacs-without-invisibility (body))
+
+(defun org-indent-to-column (column &optional minimum buffer)
+ "Work around a bug with extents with invisibility in XEmacs."
+ (if (featurep 'xemacs)
+ (org-xemacs-without-invisibility (indent-to-column column minimum buffer))
+ (indent-to-column column minimum)))
+
+(defun org-indent-line-to (column)
+ "Work around a bug with extents with invisibility in XEmacs."
+ (if (featurep 'xemacs)
+ (org-xemacs-without-invisibility (indent-line-to column))
+ (indent-line-to column)))
+
+(defun org-move-to-column (column &optional force buffer)
+ (if (featurep 'xemacs)
+ (org-xemacs-without-invisibility (move-to-column column force buffer))
+ (move-to-column column force)))
+
+(defun org-get-x-clipboard-compat (value)
+ "Get the clipboard value on XEmacs or Emacs 21."
+ (cond ((featurep 'xemacs)
+ (org-no-warnings (get-selection-no-error value)))
+ ((fboundp 'x-get-selection)
+ (condition-case nil
+ (or (x-get-selection value 'UTF8_STRING)
+ (x-get-selection value 'COMPOUND_TEXT)
+ (x-get-selection value 'STRING)
+ (x-get-selection value 'TEXT))
+ (error nil)))))
+
+(defun org-propertize (string &rest properties)
+ (if (featurep 'xemacs)
+ (progn
+ (add-text-properties 0 (length string) properties string)
+ string)
+ (apply 'propertize string properties)))
+
+(defmacro org-find-library-dir (library)
+ `(file-name-directory (locate-library ,library)))
+
+(defun org-count-lines (s)
+ "How many lines in string S?"
+ (let ((start 0) (n 1))
+ (while (string-match "\n" s start)
+ (setq start (match-end 0) n (1+ n)))
+ (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
+ (setq n (1- n)))
+ n))
+
+(defun org-kill-new (string &rest args)
+ (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
+ string)
+ (apply 'kill-new string args))
+
+(defun org-select-frame-set-input-focus (frame)
+ "Select FRAME, raise it, and set input focus, if possible."
+ (cond ((featurep 'xemacs)
+ (if (fboundp 'select-frame-set-input-focus)
+ (select-frame-set-input-focus frame)
+ (raise-frame frame)
+ (select-frame frame)
+ (focus-frame frame)))
+ ;; `select-frame-set-input-focus' defined in Emacs 21 will not
+ ;; set the input focus.
+ ((>= emacs-major-version 22)
+ (select-frame-set-input-focus frame))
+ (t
+ (raise-frame frame)
+ (select-frame frame)
+ (cond ((memq window-system '(x ns mac))
+ (x-focus-frame frame))
+ ((eq window-system 'w32)
+ (w32-focus-frame frame)))
+ (when focus-follows-mouse
+ (set-mouse-position frame (1- (frame-width frame)) 0)))))
+
+(defun org-float-time (&optional time)
+ "Convert time value TIME to a floating point number.
+TIME defaults to the current time."
+ (if (featurep 'xemacs)
+ (time-to-seconds (or time (current-time)))
+ (float-time time)))
+
+(if (fboundp 'string-match-p)
+ (defalias 'org-string-match-p 'string-match-p)
+ (defun org-string-match-p (regexp string &optional start)
+ (save-match-data
+ (funcall 'string-match regexp string start))))
+
+(if (fboundp 'looking-at-p)
+ (defalias 'org-looking-at-p 'looking-at-p)
+ (defun org-looking-at-p (&rest args)
+ (save-match-data
+ (apply 'looking-at args))))
+
+ ; XEmacs does not have `looking-back'.
+(if (fboundp 'looking-back)
+ (defalias 'org-looking-back 'looking-back)
+ (defun org-looking-back (regexp &optional limit greedy)
+ "Return non-nil if text before point matches regular expression REGEXP.
+Like `looking-at' except matches before point, and is slower.
+LIMIT if non-nil speeds up the search by specifying a minimum
+starting position, to avoid checking matches that would start
+before LIMIT.
+
+If GREEDY is non-nil, extend the match backwards as far as
+possible, stopping when a single additional previous character
+cannot be part of a match for REGEXP. When the match is
+extended, its starting position is allowed to occur before
+LIMIT."
+ (let ((start (point))
+ (pos
+ (save-excursion
+ (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
+ (point)))))
+ (if (and greedy pos)
+ (save-restriction
+ (narrow-to-region (point-min) start)
+ (while (and (> pos (point-min))
+ (save-excursion
+ (goto-char pos)
+ (backward-char 1)
+ (looking-at (concat "\\(?:" regexp "\\)\\'"))))
+ (setq pos (1- pos)))
+ (save-excursion
+ (goto-char pos)
+ (looking-at (concat "\\(?:" regexp "\\)\\'")))))
+ (not (null pos)))))
+
+(defun org-floor* (x &optional y)
+ "Return a list of the floor of X and the fractional part of X.
+With two arguments, return floor and remainder of their quotient."
+ (let ((q (floor x y)))
+ (list q (- x (if y (* y q) q)))))
+
+;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1.
+(defun org-pop-to-buffer-same-window
+ (&optional buffer-or-name norecord label)
+ "Pop to buffer specified by BUFFER-OR-NAME in the selected window."
+ (if (fboundp 'pop-to-buffer-same-window)
+ (funcall
+ 'pop-to-buffer-same-window buffer-or-name norecord)
+ (funcall 'switch-to-buffer buffer-or-name norecord)))
+
+;; `condition-case-unless-debug' has been introduced in Emacs 24.1
+;; `condition-case-no-debug' has been introduced in Emacs 23.1
+(defalias 'org-condition-case-unless-debug
+ (or (and (fboundp 'condition-case-unless-debug)
+ 'condition-case-unless-debug)
+ (and (fboundp 'condition-case-no-debug)
+ 'condition-case-no-debug)
+ 'condition-case))
+
+;;;###autoload
+(defmacro org-check-version ()
+ "Try very hard to provide sensible version strings."
+ (let* ((org-dir (org-find-library-dir "org"))
+ (org-version.el (concat org-dir "org-version.el"))
+ (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
+ (if (require 'org-version org-version.el 'noerror)
+ '(progn
+ (autoload 'org-release "org-version.el")
+ (autoload 'org-git-version "org-version.el"))
+ (if (require 'org-fixup org-fixup.el 'noerror)
+ '(org-fixup)
+ ;; provide fallback definitions and complain
+ (warn "Could not define org version correctly. Check installation!")
+ '(progn
+ (defun org-release () "N/A")
+ (defun org-git-version () "N/A !!check installation!!"))))))
+
+(provide 'org-compat)
+
+;;; org-compat.el ends here
diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el
new file mode 100644
index 0000000..a187d2f
--- /dev/null
+++ b/lisp/org-crypt.el
@@ -0,0 +1,273 @@
+;;; org-crypt.el --- Public key encryption for org-mode entries
+
+;; Copyright (C) 2007, 2009-2012 Free Software Foundation, Inc.
+
+;; Emacs Lisp Archive Entry
+;; Filename: org-crypt.el
+;; Keywords: org-mode
+;; Author: John Wiegley <johnw@gnu.org>
+;; Maintainer: Peter Jones <pjones@pmade.com>
+;; Description: Adds public key encryption to org-mode buffers
+;; URL: http://www.newartisans.com/software/emacs.html
+;; Compatibility: Emacs22
+
+;; 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:
+
+;; Right now this is just a set of functions to play with. It depends
+;; on the epg library. Here's how you would use it:
+;;
+;; 1. To mark an entry for encryption, tag the heading with "crypt".
+;; You can change the tag to any complex tag matching string by
+;; setting the `org-crypt-tag-matcher' variable.
+;;
+;; 2. Set the encryption key to use in the `org-crypt-key' variable,
+;; or use `M-x org-set-property' to set the property CRYPTKEY to
+;; any address in your public keyring. The text of the entry (but
+;; not its properties or headline) will be encrypted for this user.
+;; For them to read it, the corresponding secret key must be
+;; located in the secret key ring of the account where you try to
+;; decrypt it. This makes it possible to leave secure notes that
+;; only the intended recipient can read in a shared-org-mode-files
+;; scenario.
+;; If the key is not set, org-crypt will default to symmetric encryption.
+;;
+;; 3. To later decrypt an entry, use `org-decrypt-entries' or
+;; `org-decrypt-entry'. It might be useful to bind this to a key,
+;; like C-c C-/. I hope that in the future, C-c C-r can be might
+;; overloaded to also decrypt an entry if it's encrypted, since
+;; that fits nicely with the meaning of "reveal".
+;;
+;; 4. To automatically encrypt all necessary entries when saving a
+;; file, call `org-crypt-use-before-save-magic' after loading
+;; org-crypt.el.
+
+;;; Thanks:
+
+;; - Carsten Dominik
+;; - Vitaly Ostanin
+
+(require 'org)
+
+;;; Code:
+
+(declare-function epg-decrypt-string "epg" (context cipher))
+(declare-function epg-list-keys "epg" (context &optional name mode))
+(declare-function epg-make-context "epg"
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm digest-algorithm
+ compress-algorithm))
+(declare-function epg-encrypt-string "epg"
+ (context plain recipients &optional sign always-trust))
+
+(defgroup org-crypt nil
+ "Org Crypt."
+ :tag "Org Crypt"
+ :group 'org)
+
+(defcustom org-crypt-tag-matcher "crypt"
+ "The tag matcher used to find headings whose contents should be encrypted.
+
+See the \"Match syntax\" section of the org manual for more details."
+ :type 'string
+ :group 'org-crypt)
+
+(defcustom org-crypt-key ""
+ "The default key to use when encrypting the contents of a heading.
+
+This setting can also be overridden in the CRYPTKEY property."
+ :type 'string
+ :group 'org-crypt)
+
+(defcustom org-crypt-disable-auto-save 'ask
+ "What org-decrypt should do if `auto-save-mode' is enabled.
+
+t : Disable auto-save-mode for the current buffer
+ prior to decrypting an entry.
+
+nil : Leave auto-save-mode enabled.
+ This may cause data to be written to disk unencrypted!
+
+'ask : Ask user whether or not to disable auto-save-mode
+ for the current buffer.
+
+'encrypt : Leave auto-save-mode enabled for the current buffer,
+ but automatically re-encrypt all decrypted entries
+ *before* auto-saving.
+ NOTE: This only works for entries which have a tag
+ that matches `org-crypt-tag-matcher'."
+ :group 'org-crypt
+ :version "24.1"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask)
+ (const :tag "Encrypt" encrypt)))
+
+(defun org-crypt-check-auto-save ()
+ "Check whether auto-save-mode is enabled for the current buffer.
+
+`auto-save-mode' may cause leakage when decrypting entries, so
+check whether it's enabled, and decide what to do about it.
+
+See `org-crypt-disable-auto-save'."
+ (when buffer-auto-save-file-name
+ (cond
+ ((or
+ (eq org-crypt-disable-auto-save t)
+ (and
+ (eq org-crypt-disable-auto-save 'ask)
+ (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
+ (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer))))
+ ; The argument to auto-save-mode has to be "-1", since
+ ; giving a "nil" argument toggles instead of disabling.
+ (auto-save-mode -1))
+ ((eq org-crypt-disable-auto-save nil)
+ (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
+ ((eq org-crypt-disable-auto-save 'encrypt)
+ (message "org-decrypt: Enabling re-encryption on auto-save.")
+ (add-hook 'auto-save-hook
+ (lambda ()
+ (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
+ (org-encrypt-entries))
+ nil t))
+ (t nil))))
+
+(defun org-crypt-key-for-heading ()
+ "Return the encryption key for the current heading."
+ (save-excursion
+ (org-back-to-heading t)
+ (or (org-entry-get nil "CRYPTKEY" 'selective)
+ org-crypt-key
+ (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)
+ (message "No crypt key set, using symmetric encryption."))))
+
+(defun org-encrypt-string (str crypt-key)
+ "Return STR encrypted with CRYPT-KEY."
+ ;; Text and key have to be identical, otherwise we re-crypt.
+ (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
+ (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
+ (get-text-property 0 'org-crypt-text str)
+ (let ((epg-context (epg-make-context nil t t)))
+ (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))))
+
+(defun org-encrypt-entry ()
+ "Encrypt the content of the current headline."
+ (interactive)
+ (require 'epg)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((start-heading (point)))
+ (forward-line)
+ (when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
+ (let ((folded (outline-invisible-p))
+ (epg-context (epg-make-context nil t t))
+ (crypt-key (org-crypt-key-for-heading))
+ (beg (point))
+ end encrypted-text)
+ (goto-char start-heading)
+ (org-end-of-subtree t t)
+ (org-back-over-empty-lines)
+ (setq end (point)
+ encrypted-text
+ (org-encrypt-string (buffer-substring beg end) crypt-key))
+ (delete-region beg end)
+ (insert encrypted-text)
+ (when folded
+ (goto-char start-heading)
+ (hide-subtree))
+ nil)))))
+
+(defun org-decrypt-entry ()
+ "Decrypt the content of the current headline."
+ (interactive)
+ (require 'epg)
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((heading-point (point))
+ (heading-was-invisible-p
+ (save-excursion
+ (outline-end-of-heading)
+ (outline-invisible-p))))
+ (forward-line)
+ (when (looking-at "-----BEGIN PGP MESSAGE-----")
+ (org-crypt-check-auto-save)
+ (let* ((end (save-excursion
+ (search-forward "-----END PGP MESSAGE-----")
+ (forward-line)
+ (point)))
+ (epg-context (epg-make-context nil t t))
+ (encrypted-text (buffer-substring-no-properties (point) end))
+ (decrypted-text
+ (decode-coding-string
+ (epg-decrypt-string
+ epg-context
+ encrypted-text)
+ 'utf-8)))
+ ;; Delete region starting just before point, because the
+ ;; outline property starts at the \n of the heading.
+ (delete-region (1- (point)) end)
+ ;; Store a checksum of the decrypted and the encrypted
+ ;; text value. This allow to reuse the same encrypted text
+ ;; if the text does not change, and therefore avoid a
+ ;; re-encryption process.
+ (insert "\n" (propertize decrypted-text
+ 'org-crypt-checksum (sha1 decrypted-text)
+ 'org-crypt-key (org-crypt-key-for-heading)
+ 'org-crypt-text encrypted-text))
+ (when heading-was-invisible-p
+ (goto-char heading-point)
+ (org-flag-subtree t))
+ nil))))))
+
+(defun org-encrypt-entries ()
+ "Encrypt all top-level entries in the current buffer."
+ (interactive)
+ (let (todo-only)
+ (org-scan-tags
+ 'org-encrypt-entry
+ (cdr (org-make-tags-matcher org-crypt-tag-matcher))
+ todo-only)))
+
+(defun org-decrypt-entries ()
+ "Decrypt all entries in the current buffer."
+ (interactive)
+ (let (todo-only)
+ (org-scan-tags
+ 'org-decrypt-entry
+ (cdr (org-make-tags-matcher org-crypt-tag-matcher))
+ todo-only)))
+
+(defun org-at-encrypted-entry-p ()
+ "Is the current entry encrypted?"
+ (unless (org-before-first-heading-p)
+ (save-excursion
+ (org-back-to-heading t)
+ (search-forward "-----BEGIN PGP MESSAGE-----"
+ (save-excursion (org-end-of-subtree t)) t))))
+
+(defun org-crypt-use-before-save-magic ()
+ "Add a hook to automatically encrypt entries before a file is saved to disk."
+ (add-hook
+ 'org-mode-hook
+ (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
+
+(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
+
+(provide 'org-crypt)
+
+;;; org-crypt.el ends here
diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el
new file mode 100644
index 0000000..a951cf9
--- /dev/null
+++ b/lisp/org-ctags.el
@@ -0,0 +1,544 @@
+;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+
+;; Author: Paul Sexton <eeeickythump@gmail.com>
+
+
+;; Keywords: org, wp
+;;
+;; 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/>.
+
+;;
+;; Synopsis
+;; ========
+;;
+;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
+;; destinations in org-mode files as any text between <<double angled
+;; brackets>>. This allows the tags-generation program `exuberant ctags' to
+;; parse these files and create tag tables that record where these
+;; destinations are found. Plain [[links]] in org mode files which do not have
+;; <<matching destinations>> within the same file will then be interpreted as
+;; links to these 'tagged' destinations, allowing seamless navigation between
+;; multiple org-mode files. Topics can be created in any org mode file and
+;; will always be found by plain links from other files. Other file types
+;; recognized by ctags (source code files, latex files, etc) will also be
+;; available as destinations for plain links, and similarly, org-mode links
+;; will be available as tags from source files. Finally, the function
+;; `org-ctags-find-tag-interactive' lets you choose any known tag, using
+;; autocompletion, and quickly jump to it.
+;;
+;; Installation
+;; ============
+;;
+;; Install org mode
+;; Ensure org-ctags.el is somewhere in your emacs load path.
+;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/"
+;; Edit your .emacs file (see next section) and load emacs.
+
+;; To put in your init file (.emacs):
+;; ==================================
+;;
+;; Assuming you already have org mode installed and set up:
+;;
+;; (setq org-ctags-path-to-ctags "/path/to/ctags/executable")
+;; (add-hook 'org-mode-hook
+;; (lambda ()
+;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive)))
+;;
+;; By default, with org-ctags loaded, org will first try and visit the tag
+;; with the same name as the link; then, if unsuccessful, ask the user if
+;; he/she wants to rebuild the 'TAGS' database and try again; then ask if
+;; the user wishes to append 'tag' as a new toplevel heading at the end of
+;; the buffer; and finally, defer to org's default behaviour which is to
+;; search the entire text of the current buffer for 'tag'.
+;;
+;; This behaviour can be modified by changing the value of
+;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my
+;; .emacs, which describes the same behaviour as the above paragraph with
+;; one difference:
+;;
+;; (setq org-ctags-open-link-functions
+;; '(org-ctags-find-tag
+;; org-ctags-ask-rebuild-tags-file-then-find-tag
+;; org-ctags-ask-append-topic
+;; org-ctags-fail-silently)) ; <-- prevents org default behaviour
+;;
+;;
+;; Usage
+;; =====
+;;
+;; When you click on a link "[[foo]]" and org cannot find a matching "<<foo>>"
+;; in the current buffer, the tags facility will take over. The file TAGS in
+;; the active directory is examined to see if the tags facility knows about
+;; "<<foo>>" in any other files. If it does, the matching file will be opened
+;; and the cursor will jump to the position of "<<foo>>" in that file.
+;;
+;; User-visible functions:
+;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit
+;; it. With autocompletion. Bound to ctrl-O in the above setup.
+;; - All the etags functions should work. These include:
+;;
+;; M-. `find-tag' -- finds the tag at point
+;;
+;; C-M-. find-tag based on regular expression
+;;
+;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT
+;; of ALL the files referenced in the TAGS file. A quick way to
+;; search through an entire 'project'.
+;;
+;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'.
+;; You may need to bind this key yourself with (eg)
+;; (global-set-key (kbd "<M-kp-multiply>") 'pop-tag-mark)
+;;
+;; (see etags chapter in Emacs manual for more)
+;;
+;;
+;; Keeping the TAGS file up to date
+;; ================================
+;;
+;; Tags mode has no way of knowing that you have created new tags by typing in
+;; your org-mode buffer. New tags make it into the TAGS file in 3 ways:
+;;
+;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file.
+;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in
+;; your `org-open-link-functions' list, as is done in the setup
+;; above. This will cause the TAGS file to be rebuilt whenever a link
+;; cannot be found. This may be slow with large file collections however.
+;; 3. You run the following from the command line (all 1 line):
+;;
+;; ctags --langdef=orgmode --langmap=orgmode:.org
+;; --regex-orgmode="/<<([^>]+)>>/\1/d,definition/"
+;; -f /your/path/TAGS -e -R /your/path/*.org
+;;
+;; If you are paranoid, you might want to run (org-ctags-create-tags
+;; "/path/to/org/files") at startup, by including the following toplevel form
+;; in .emacs. However this can cause a pause of several seconds if ctags has
+;; to scan lots of files.
+;;
+;; (progn
+;; (message "-- rebuilding tags tables...")
+;; (mapc 'org-create-tags tags-table-list))
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'org)
+
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+
+(defgroup org-ctags nil
+ "Options concerning use of ctags within org mode."
+ :tag "Org-Ctags"
+ :group 'org-link)
+
+(defvar org-ctags-enabled-p t
+ "Activate ctags support in org mode?")
+
+(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/"
+ "Regexp expression used by ctags external program.
+The regexp matches tag destinations in org-mode files.
+Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
+See the ctags documentation for more information.")
+
+(defcustom org-ctags-path-to-ctags
+ (case system-type
+ (windows-nt "ctags.exe")
+ (darwin "ctags-exuberant")
+ (t "ctags-exuberant"))
+ "Full path to the ctags executable file."
+ :group 'org-ctags
+ :version "24.1"
+ :type 'file)
+
+(defcustom org-ctags-open-link-functions
+ '(org-ctags-find-tag
+ org-ctags-ask-rebuild-tags-file-then-find-tag
+ org-ctags-ask-append-topic)
+ "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active."
+ :group 'org-ctags
+ :version "24.1"
+ :type 'hook
+ :options '(org-ctags-find-tag
+ org-ctags-ask-rebuild-tags-file-then-find-tag
+ org-ctags-rebuild-tags-file-then-find-tag
+ org-ctags-ask-append-topic
+ org-ctags-append-topic
+ org-ctags-ask-visit-buffer-or-file
+ org-ctags-visit-buffer-or-file
+ org-ctags-fail-silently))
+
+
+(defvar org-ctags-tag-list nil
+ "List of all tags in the active TAGS file.
+Created as a local variable in each buffer.")
+
+(defcustom org-ctags-new-topic-template
+ "* <<%t>>\n\n\n\n\n\n"
+ "Text to insert when creating a new org file via opening a hyperlink.
+The following patterns are replaced in the string:
+ `%t' - replaced with the capitalized title of the hyperlink"
+ :group 'org-ctags
+ :version "24.1"
+ :type 'string)
+
+
+(add-hook 'org-mode-hook
+ (lambda ()
+ (when (and org-ctags-enabled-p
+ (buffer-file-name))
+ ;; Make sure this file's directory is added to default
+ ;; directories in which to search for tags.
+ (let ((tags-filename
+ (expand-file-name
+ (concat (file-name-directory (buffer-file-name))
+ "/TAGS"))))
+ (when (file-exists-p tags-filename)
+ (visit-tags-table tags-filename))))))
+
+
+(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile)
+ (when (and org-ctags-enabled-p tags-file-name)
+ (set (make-local-variable 'org-ctags-tag-list)
+ (org-ctags-all-tags-in-current-tags-table))))
+
+
+(defun org-ctags-enable ()
+ (put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point)
+ (setq org-ctags-enabled-p t)
+ (dolist (fn org-ctags-open-link-functions)
+ (add-hook 'org-open-link-functions fn t)))
+
+
+;;; General utility functions. ===============================================
+;; These work outside org-ctags mode.
+
+(defun org-ctags-get-filename-for-tag (tag)
+ "TAG is a string. Search the active TAGS file for a matching tag.
+If the tag is found, return a list containing the filename, line number, and
+buffer position where the tag is found."
+ (interactive "sTag: ")
+ (unless tags-file-name
+ (call-interactively (visit-tags-table)))
+ (save-excursion
+ (visit-tags-table-buffer 'same)
+ (when tags-file-name
+ (with-current-buffer (get-file-buffer tags-file-name)
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward (format "^.*%s\\([0-9]+\\),\\([0-9]+\\)$"
+ (regexp-quote tag)) nil t)
+ (let ((line (string-to-number (match-string 1)))
+ (pos (string-to-number (match-string 2))))
+ (cond
+ ((re-search-backward " \n\\(.*\\),[0-9]+\n")
+ (list (match-string 1) line pos))
+ (t ; can't find a file name preceding the matched
+ ; tag??
+ (error "Malformed TAGS file: %s" (buffer-name))))))
+ (t ; tag not found
+ nil))))))
+
+
+(defun org-ctags-all-tags-in-current-tags-table ()
+ "Read all tags defined in the active TAGS file, into a list of strings.
+Return the list."
+ (interactive)
+ (let ((taglist nil))
+ (unless tags-file-name
+ (call-interactively (visit-tags-table)))
+ (save-excursion
+ (visit-tags-table-buffer 'same)
+ (with-current-buffer (get-file-buffer tags-file-name)
+ (goto-char (point-min))
+ (while (re-search-forward "^.*\\(.*\\)\\([0-9]+\\),\\([0-9]+\\)$"
+ nil t)
+ (push (substring-no-properties (match-string 1)) taglist)))
+ taglist)))
+
+
+(defun org-ctags-string-search-and-replace (search replace string)
+ "Replace all instances of SEARCH with REPLACE in STRING."
+ (replace-regexp-in-string (regexp-quote search) replace string t t))
+
+
+(defun y-or-n-minibuffer (prompt)
+ (let ((use-dialog-box nil))
+ (y-or-n-p prompt)))
+
+
+;;; Internal functions =======================================================
+
+
+(defun org-ctags-open-file (name &optional title)
+ "Visit or create a file called `NAME.org', and insert a new topic.
+The new topic will be titled NAME (or TITLE if supplied)."
+ (interactive "sFile name: ")
+ (let ((filename (substitute-in-file-name (expand-file-name name))))
+ (condition-case v
+ (progn
+ (org-open-file name t)
+ (message "Opened file OK")
+ (goto-char (point-max))
+ (insert (org-ctags-string-search-and-replace
+ "%t" (capitalize (or title name))
+ org-ctags-new-topic-template))
+ (message "Inserted new file text OK")
+ (org-mode-restart))
+ (error (error "Error %S in org-ctags-open-file" v)))))
+
+
+;;;; Misc interoperability with etags system =================================
+
+
+(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag
+ activate compile)
+ "Before trying to find a tag, save our current position on org mark ring."
+ (save-excursion
+ (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
+ (org-mark-ring-push))))
+
+
+
+(defun org-ctags-find-tag-at-point ()
+ "Determine default tag to search for, based on text at point.
+If there is no plausible default, return nil."
+ (let (from to bound)
+ (when (or (ignore-errors
+ ;; Look for hyperlink around `point'.
+ (save-excursion
+ (search-backward "[[") (setq from (+ 2 (point))))
+ (save-excursion
+ (goto-char from)
+ (search-forward "]") (setq to (- (point) 1)))
+ (and (> to from) (>= (point) from) (<= (point) to)))
+ (progn
+ ;; Look at text around `point'.
+ (save-excursion
+ (skip-syntax-backward "w_") (setq from (point)))
+ (save-excursion
+ (skip-syntax-forward "w_") (setq to (point)))
+ (> to from))
+ ;; Look between `line-beginning-position' and `point'.
+ (save-excursion
+ (and (setq bound (line-beginning-position))
+ (skip-syntax-backward "^w_" bound)
+ (> (setq to (point)) bound)
+ (skip-syntax-backward "w_")
+ (setq from (point))))
+ ;; Look between `point' and `line-end-position'.
+ (save-excursion
+ (and (setq bound (line-end-position))
+ (skip-syntax-forward "^w_" bound)
+ (< (setq from (point)) bound)
+ (skip-syntax-forward "w_")
+ (setq to (point)))))
+ (buffer-substring-no-properties from to))))
+
+
+;;; Functions for use with 'org-open-link-functions' hook =================
+
+
+(defun org-ctags-find-tag (name)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Look for a tag called `NAME' in the current TAGS table. If it is found,
+visit the file and location where the tag is found."
+ (interactive "sTag: ")
+ (let ((old-buf (current-buffer))
+ (old-pnt (point-marker))
+ (old-mark (copy-marker (mark-marker))))
+ (condition-case nil
+ (progn (find-tag name)
+ t)
+ (error
+ ;; only restore old location if find-tag raises error
+ (set-buffer old-buf)
+ (goto-char old-pnt)
+ (set-marker (mark-marker) old-mark)
+ nil))))
+
+
+(defun org-ctags-visit-buffer-or-file (name &optional create)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Visit buffer named `NAME.org'. If there is no such buffer, visit the file
+with the same name if it exists. If the file does not exist, then behavior
+depends on the value of CREATE.
+
+If CREATE is nil (default), then return nil. Do not create a new file.
+If CREATE is t, create the new file and visit it.
+If CREATE is the symbol `ask', then ask the user if they wish to create
+the new file."
+ (interactive)
+ (let ((filename (concat (substitute-in-file-name
+ (expand-file-name name))
+ ".org")))
+ (cond
+ ((get-buffer (concat name ".org"))
+ ;; Buffer is already open
+ (org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
+ ((file-exists-p filename)
+ ;; File exists but is not open --> open it
+ (message "Opening existing org file `%S'..."
+ filename)
+ (org-open-file filename t))
+ ((or (eql create t)
+ (and (eql create 'ask)
+ (y-or-n-p (format "File `%s.org' not found; create?" name))))
+ (org-ctags-open-file filename name))
+ (t ;; File does not exist, and we don't want to create it.
+ nil))))
+
+
+(defun org-ctags-ask-visit-buffer-or-file (name)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Wrapper for org-ctags-visit-buffer-or-file, which ensures the user is
+asked before creating a new file."
+ (org-ctags-visit-buffer-or-file name 'ask))
+
+
+(defun org-ctags-append-topic (name &optional narrowp)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Append a new toplevel heading to the end of the current buffer. The
+heading contains NAME surrounded by <<angular brackets>>, thus making
+the heading a destination for the tag `NAME'."
+ (interactive "sTopic: ")
+ (widen)
+ (goto-char (point-max))
+ (newline 2)
+ (message "Adding topic in buffer %s" (buffer-name))
+ (insert (org-ctags-string-search-and-replace
+ "%t" (capitalize name) org-ctags-new-topic-template))
+ (backward-char 4)
+ (org-update-radio-target-regexp)
+ (end-of-line)
+ (forward-line 2)
+ (when narrowp
+ ;;(org-tree-to-indirect-buffer 1) ;; opens new frame
+ (org-narrow-to-subtree))
+ t)
+
+
+(defun org-ctags-ask-append-topic (name &optional narrowp)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Wrapper for org-ctags-append-topic, which first asks the user if they want
+to append a new topic."
+ (if (y-or-n-p (format "Topic `%s' not found; append to end of buffer?"
+ name))
+ (org-ctags-append-topic name narrowp)
+ nil))
+
+
+(defun org-ctags-rebuild-tags-file-then-find-tag (name)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first,
+to rebuild (update) the TAGS file."
+ (unless tags-file-name
+ (call-interactively (visit-tags-table)))
+ (when (buffer-file-name)
+ (org-ctags-create-tags))
+ (org-ctags-find-tag name))
+
+
+(defun org-ctags-ask-rebuild-tags-file-then-find-tag (name)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
+ (if (and (buffer-file-name)
+ (y-or-n-p
+ (format
+ "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
+ name
+ (file-name-directory (buffer-file-name)))))
+ (org-ctags-rebuild-tags-file-then-find-tag name)
+ nil))
+
+
+(defun org-ctags-fail-silently (name)
+ "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
+Put as the last function in the list if you want to prevent org's default
+behavior of free text search."
+ t)
+
+
+;;; User-visible functions ===================================================
+
+
+(defun org-ctags-create-tags (&optional directory-name)
+ "(Re)create tags file in the directory of the active buffer.
+The file will contain tag definitions for all the files in the
+directory and its subdirectories which are recognized by ctags.
+This will include files ending in `.org' as well as most other
+source files (.C, .H, .EL, .LISP, etc). All the resulting tags
+end up in one file, called TAGS, located in the directory. This
+function may take several seconds to finish if the directory or
+its subdirectories contain large numbers of taggable files."
+ (interactive)
+ (assert (buffer-file-name))
+ (let ((dir-name (or directory-name
+ (file-name-directory (buffer-file-name))))
+ (exitcode nil))
+ (save-excursion
+ (setq exitcode
+ (shell-command
+ (format (concat "%s --langdef=orgmode --langmap=orgmode:.org "
+ "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"")
+ org-ctags-path-to-ctags
+ org-ctags-tag-regexp
+ (expand-file-name (concat dir-name "/TAGS"))
+ (expand-file-name (concat dir-name "/*")))))
+ (cond
+ ((eql 0 exitcode)
+ (set (make-local-variable 'org-ctags-tag-list)
+ (org-ctags-all-tags-in-current-tags-table)))
+ (t
+ ;; This seems to behave differently on Linux, so just ignore
+ ;; error codes for now
+ ;;(error "Calling ctags executable resulted in error code: %s"
+ ;; exitcode)
+ nil)))))
+
+
+(defvar org-ctags-find-tag-history nil
+ "History of tags visited by org-ctags-find-tag-interactive.")
+
+(defun org-ctags-find-tag-interactive ()
+ "Prompt for the name of a tag, with autocompletion, then visit the named tag.
+Uses `ido-mode' if available.
+If the user enters a string that does not match an existing tag, create
+a new topic."
+ (interactive)
+ (let* ((completing-read-fn (if (fboundp 'ido-completing-read)
+ 'ido-completing-read
+ 'completing-read))
+ (tag (funcall completing-read-fn "Topic: " org-ctags-tag-list
+ nil 'confirm nil 'org-ctags-find-tag-history)))
+ (when tag
+ (cond
+ ((member tag org-ctags-tag-list)
+ ;; Existing tag
+ (push tag org-ctags-find-tag-history)
+ (find-tag tag))
+ (t
+ ;; New tag
+ (run-hook-with-args-until-success
+ 'org-open-link-functions tag))))))
+
+
+(org-ctags-enable)
+
+(provide 'org-ctags)
+
+;;; org-ctags.el ends here
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
new file mode 100644
index 0000000..4ff8e7d
--- /dev/null
+++ b/lisp/org-datetree.el
@@ -0,0 +1,210 @@
+;;; org-datetree.el --- Create date entries in a tree
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains code to create entries in a tree where the top-level
+;; nodes represent years, the level 2 nodes represent the months, and the
+;; level 1 entries days.
+
+;;; Code:
+
+(require 'org)
+
+(defvar org-datetree-base-level 1
+ "The level at which years should be placed in the date tree.
+This is normally one, but if the buffer has an entry with a DATE_TREE
+property (any value), the date tree will become a subtree under that entry,
+so the base level will be properly adjusted.")
+
+(defcustom org-datetree-add-timestamp nil
+ "When non-nil, add a time stamp when create a datetree entry."
+ :group 'org-capture
+ :version "24.3"
+ :type '(choice
+ (const :tag "Do not add a time stamp" nil)
+ (const :tag "Add an inactive time stamp" inactive)
+ (const :tag "Add an active time stamp" active)))
+
+;;;###autoload
+(defun org-datetree-find-date-create (date &optional keep-restriction)
+ "Find or create an entry for DATE.
+If KEEP-RESTRICTION is non-nil, do not widen the buffer.
+When it is nil, the buffer will be widened to make sure an existing date
+tree can be found."
+ (let ((year (nth 2 date))
+ (month (car date))
+ (day (nth 1 date)))
+ (org-set-local 'org-datetree-base-level 1)
+ (or keep-restriction (widen))
+ (goto-char (point-min))
+ (save-restriction
+ (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t)
+ (org-back-to-heading t)
+ (org-set-local 'org-datetree-base-level
+ (org-get-valid-level (funcall outline-level) 1))
+ (org-narrow-to-subtree))
+ (goto-char (point-min))
+ (org-datetree-find-year-create year)
+ (org-datetree-find-month-create year month)
+ (org-datetree-find-day-create year month day)
+ (goto-char (prog1 (point) (widen))))))
+
+(defun org-datetree-find-year-create (year)
+ (let ((re "^\\*+[ \t]+\\([12][0-9][0-9][0-9]\\)\\s-*$")
+ match)
+ (goto-char (point-min))
+ (while (and (setq match (re-search-forward re nil t))
+ (goto-char (match-beginning 1))
+ (< (string-to-number (match-string 1)) year)))
+ (cond
+ ((not match)
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (org-datetree-insert-line year))
+ ((= (string-to-number (match-string 1)) year)
+ (goto-char (point-at-bol)))
+ (t
+ (beginning-of-line 1)
+ (org-datetree-insert-line year)))))
+
+(defun org-datetree-find-month-create (year month)
+ (org-narrow-to-subtree)
+ (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
+ match)
+ (goto-char (point-min))
+ (while (and (setq match (re-search-forward re nil t))
+ (goto-char (match-beginning 1))
+ (< (string-to-number (match-string 1)) month)))
+ (cond
+ ((not match)
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (org-datetree-insert-line year month))
+ ((= (string-to-number (match-string 1)) month)
+ (goto-char (point-at-bol)))
+ (t
+ (beginning-of-line 1)
+ (org-datetree-insert-line year month)))))
+
+(defun org-datetree-find-day-create (year month day)
+ (org-narrow-to-subtree)
+ (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
+ match)
+ (goto-char (point-min))
+ (while (and (setq match (re-search-forward re nil t))
+ (goto-char (match-beginning 1))
+ (< (string-to-number (match-string 1)) day)))
+ (cond
+ ((not match)
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (org-datetree-insert-line year month day))
+ ((= (string-to-number (match-string 1)) day)
+ (goto-char (point-at-bol)))
+ (t
+ (beginning-of-line 1)
+ (org-datetree-insert-line year month day)))))
+
+(defun org-datetree-insert-line (year &optional month day)
+ (let ((pos (point)) ts-type)
+ (skip-chars-backward " \t\n")
+ (delete-region (point) pos)
+ (insert "\n" (make-string org-datetree-base-level ?*) " \n")
+ (backward-char 1)
+ (if month (org-do-demote))
+ (if day (org-do-demote))
+ (insert (format "%d" year))
+ (when month
+ (insert (format "-%02d" month))
+ (if day
+ (insert (format "-%02d %s"
+ day (format-time-string
+ "%A" (encode-time 0 0 0 day month year))))
+ (insert (format " %s"
+ (format-time-string
+ "%B" (encode-time 0 0 0 1 month year))))))
+ (when (and day (setq ts-type org-datetree-add-timestamp))
+ (insert "\n")
+ (org-indent-line)
+ (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type))
+ (beginning-of-line 1)))
+
+(defun org-datetree-file-entry-under (txt date)
+ "Insert a node TXT into the date tree under DATE."
+ (org-datetree-find-date-create date)
+ (let ((level (org-get-valid-level (funcall outline-level) 1)))
+ (org-end-of-subtree t t)
+ (org-back-over-empty-lines)
+ (org-paste-subtree level txt)))
+
+(defun org-datetree-cleanup ()
+ "Make sure all entries in the current tree are under the correct date.
+It may be useful to restrict the buffer to the applicable portion
+before running this command, even though the command tries to be smart."
+ (interactive)
+ (goto-char (point-min))
+ (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
+ (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
+ dct ts tmp date year month day pos hdl-pos)
+ (while (re-search-forward org-ts-regexp nil t)
+ (catch 'next
+ (setq ts (match-string 0))
+ (setq tmp (buffer-substring
+ (max (point-at-bol) (- (match-beginning 0)
+ org-ds-keyword-length))
+ (match-beginning 0)))
+ (if (or (string-match "-\\'" tmp)
+ (string-match dre tmp)
+ (string-match sre tmp))
+ (throw 'next nil))
+ (setq dct (decode-time (org-time-string-to-time (match-string 0)))
+ date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
+ year (nth 2 date)
+ month (car date)
+ day (nth 1 date)
+ pos (point))
+ (org-back-to-heading t)
+ (setq hdl-pos (point))
+ (unless (org-up-heading-safe)
+ ;; No parent, we are not in a date tree
+ (goto-char pos)
+ (throw 'next nil))
+ (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
+ ;; Parent looks wrong, we are not in a date tree
+ (goto-char pos)
+ (throw 'next nil))
+ (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
+ ;; At correct date already, do nothing
+ (progn (goto-char pos) (throw 'next nil)))
+ ;; OK, we need to refile this entry
+ (goto-char hdl-pos)
+ (org-cut-subtree)
+ (save-excursion
+ (save-restriction
+ (org-datetree-file-entry-under (current-kill 0) date)))))))
+
+(provide 'org-datetree)
+
+;;; org-datetree.el ends here
diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el
new file mode 100644
index 0000000..22cc5a7
--- /dev/null
+++ b/lisp/org-docbook.el
@@ -0,0 +1,1454 @@
+;;; org-docbook.el --- DocBook exporter for org-mode
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;
+;; Emacs Lisp Archive Entry
+;; Filename: org-docbook.el
+;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
+;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
+;; Keywords: org, wp, docbook
+;; Description: Converts an org-mode buffer into DocBook
+;; URL:
+
+;; 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 library implements a DocBook exporter for org-mode. The basic
+;; idea and design is very similar to what `org-export-as-html' has.
+;; Code prototype was also started with `org-export-as-html'.
+;;
+;; Put this file into your load-path and the following line into your
+;; ~/.emacs:
+;;
+;; (require 'org-docbook)
+;;
+;; The interactive functions are similar to those of the HTML and LaTeX
+;; exporters:
+;;
+;; M-x `org-export-as-docbook'
+;; M-x `org-export-as-docbook-pdf'
+;; M-x `org-export-as-docbook-pdf-and-open'
+;; M-x `org-export-as-docbook-batch'
+;; M-x `org-export-as-docbook-to-buffer'
+;; M-x `org-export-region-as-docbook'
+;; M-x `org-replace-region-by-docbook'
+;;
+;; Note that, in order to generate PDF files using the DocBook XML files
+;; created by DocBook exporter, the following two variables have to be
+;; set based on what DocBook tools you use for XSLT processor and XSL-FO
+;; processor:
+;;
+;; org-export-docbook-xslt-proc-command
+;; org-export-docbook-xsl-fo-proc-command
+;;
+;; Check the document of these two variables to see examples of how they
+;; can be set.
+;;
+;; If the Org file to be exported contains special characters written in
+;; TeX-like syntax, like \alpha and \beta, you need to include the right
+;; entity file(s) in the DOCTYPE declaration for the DocBook XML file.
+;; This is required to make the DocBook XML file valid. The DOCTYPE
+;; declaration string can be set using the following variable:
+;;
+;; org-export-docbook-doctype
+;;
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'footnote)
+(require 'org)
+(require 'org-exp)
+(require 'org-html)
+(require 'format-spec)
+
+;;; Variables:
+
+(defvar org-docbook-para-open nil)
+(defvar org-export-docbook-inline-images t)
+(defvar org-export-docbook-link-org-files-as-docbook nil)
+
+(declare-function org-id-find-id-file "org-id" (id))
+
+;;; User variables:
+
+(defgroup org-export-docbook nil
+ "Options for exporting Org-mode files to DocBook."
+ :tag "Org Export DocBook"
+ :group 'org-export)
+
+(defcustom org-export-docbook-extension ".xml"
+ "Extension of DocBook XML files."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-header "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
+ "Header of DocBook XML files."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-doctype nil
+ "DOCTYPE declaration string for DocBook XML files.
+This can be used to include entities that are needed to handle
+special characters in Org files.
+
+For example, if the Org file to be exported contains XHTML
+entities, you can set this variable to:
+
+\"<!DOCTYPE article [
+<!ENTITY % xhtml1-symbol PUBLIC
+\"-//W3C//ENTITIES Symbol for HTML//EN//XML\"
+\"http://www.w3.org/2003/entities/2007/xhtml1-symbol.ent\"
+>
+%xhtml1-symbol;
+]>
+\"
+
+If you want to process DocBook documents without an Internet
+connection, it is suggested that you download the required entity
+file(s) and use system identifier(s) (external files) in the
+DOCTYPE declaration."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-article-header "<article xmlns=\"http://docbook.org/ns/docbook\"
+ xmlns:xlink=\"http://www.w3.org/1999/xlink\" version=\"5.0\" xml:lang=\"en\">"
+ "Article header of DocBook XML files."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-section-id-prefix "sec-"
+ "Prefix of section IDs used during exporting.
+This can be set before exporting to avoid same set of section IDs
+being used again and again, which can be a problem when multiple
+people work on the same document."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-footnote-id-prefix "fn-"
+ "The prefix of footnote IDs used during exporting.
+Like `org-export-docbook-section-id-prefix', this variable can help
+avoid same set of footnote IDs being used multiple times."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-footnote-separator "<superscript>, </superscript>"
+ "Text used to separate footnotes."
+ :group 'org-export-docbook
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-docbook-emphasis-alist
+ `(("*" "<emphasis role=\"bold\">" "</emphasis>")
+ ("/" "<emphasis>" "</emphasis>")
+ ("_" "<emphasis role=\"underline\">" "</emphasis>")
+ ("=" "<code>" "</code>")
+ ("~" "<literal>" "</literal>")
+ ("+" "<emphasis role=\"strikethrough\">" "</emphasis>"))
+ "A list of DocBook expressions to convert emphasis fontifiers.
+Each element of the list is a list of three elements.
+The first element is the character used as a marker for fontification.
+The second element is a format string to wrap fontified text with.
+The third element decides whether to protect converted text from other
+conversions."
+ :group 'org-export-docbook
+ :type 'alist)
+
+(defcustom org-export-docbook-default-image-attributes
+ `(("align" . "\"center\"")
+ ("valign". "\"middle\""))
+ "Alist of default DocBook image attributes.
+These attributes will be inserted into element <imagedata> by
+default, but users can override them using `#+ATTR_DocBook:'."
+ :group 'org-export-docbook
+ :type 'alist)
+
+(defcustom org-export-docbook-inline-image-extensions
+ '("jpeg" "jpg" "png" "gif" "svg")
+ "Extensions of image files that can be inlined into DocBook."
+ :group 'org-export-docbook
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-docbook-coding-system nil
+ "Coding system for DocBook XML files."
+ :group 'org-export-docbook
+ :type 'coding-system)
+
+(defcustom org-export-docbook-xslt-stylesheet nil
+ "File name of the XSLT stylesheet used by DocBook exporter.
+This XSLT stylesheet is used by
+`org-export-docbook-xslt-proc-command' to generate the Formatting
+Object (FO) files. You can use either `fo/docbook.xsl' that
+comes with DocBook, or any customization layer you may have."
+ :group 'org-export-docbook
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-docbook-xslt-proc-command nil
+ "Format of XSLT processor command used by DocBook exporter.
+This command is used to process a DocBook XML file to generate
+the Formatting Object (FO) file.
+
+The value of this variable should be a format control string that
+includes three arguments: `%i', `%o', and `%s'. During exporting
+time, `%i' is replaced by the input DocBook XML file name, `%o'
+is replaced by the output FO file name, and `%s' is replaced by
+`org-export-docbook-xslt-stylesheet' (or the #+XSLT option if it
+is specified in the Org file).
+
+For example, if you use Saxon as the XSLT processor, you may want
+to set the variable to
+
+ \"java com.icl.saxon.StyleSheet -o %o %i %s\"
+
+If you use Xalan, you can set it to
+
+ \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\"
+
+For xsltproc, the following string should work:
+
+ \"xsltproc --output %o %s %i\"
+
+You can include additional stylesheet parameters in this command.
+Just make sure that they meet the syntax requirement of each
+processor."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-xsl-fo-proc-command nil
+ "Format of XSL-FO processor command used by DocBook exporter.
+This command is used to process a Formatting Object (FO) file to
+generate the PDF file.
+
+The value of this variable should be a format control string that
+includes two arguments: `%i' and `%o'. During exporting time,
+`%i' is replaced by the input FO file name, and `%o' is replaced
+by the output PDF file name.
+
+For example, if you use FOP as the XSL-FO processor, you can set
+the variable to
+
+ \"fop %i %o\""
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-keywords-markup "<literal>%s</literal>"
+ "A printf format string to be applied to keywords by DocBook exporter."
+ :group 'org-export-docbook
+ :type 'string)
+
+(defcustom org-export-docbook-timestamp-markup "<emphasis>%s</emphasis>"
+ "A printf format string to be applied to time stamps by DocBook exporter."
+ :group 'org-export-docbook
+ :type 'string)
+
+;;; Hooks
+
+(defvar org-export-docbook-final-hook nil
+ "Hook run at the end of DocBook export, in the new buffer.")
+
+;;; Autoload functions:
+
+;;;###autoload
+(defun org-export-as-docbook-batch ()
+ "Call `org-export-as-docbook' in batch style.
+This function can be used in batch processing.
+
+For example:
+
+$ emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --visit=MyOrgFile.org --funcall org-export-as-docbook-batch"
+ (org-export-as-docbook 'hidden))
+
+;;;###autoload
+(defun org-export-as-docbook-to-buffer ()
+ "Call `org-export-as-docbook' with output to a temporary buffer.
+No file is created."
+ (interactive)
+ (org-export-as-docbook nil nil "*Org DocBook Export*")
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window "*Org DocBook Export*")))
+
+;;;###autoload
+(defun org-replace-region-by-docbook (beg end)
+ "Replace the region from BEG to END with its DocBook export.
+It assumes the region has `org-mode' syntax, and then convert it to
+DocBook. This can be used in any buffer. For example, you could
+write an itemized list in `org-mode' syntax in an DocBook buffer and
+then use this command to convert it."
+ (interactive "r")
+ (let (reg docbook buf)
+ (save-window-excursion
+ (if (derived-mode-p 'org-mode)
+ (setq docbook (org-export-region-as-docbook
+ beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq docbook (org-export-region-as-docbook
+ (point-min) (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert docbook)))
+
+;;;###autoload
+(defun org-export-region-as-docbook (beg end &optional body-only buffer)
+ "Convert region from BEG to END in `org-mode' buffer to DocBook.
+If prefix arg BODY-ONLY is set, omit file header and footer and
+only produce the region of converted text, useful for
+cut-and-paste operations. If BUFFER is a buffer or a string,
+use/create that buffer as a target of the converted DocBook. If
+BUFFER is the symbol `string', return the produced DocBook as a
+string and leave not buffer behind. For example, a Lisp program
+could call this function in the following way:
+
+ (setq docbook (org-export-region-as-docbook beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "r\nP")
+ (when (org-called-interactively-p 'any)
+ (setq buffer "*Org DocBook Export*"))
+ (let ((transient-mark-mode t)
+ (zmacs-regions t)
+ rtn)
+ (goto-char end)
+ (set-mark (point)) ;; To activate the region
+ (goto-char beg)
+ (setq rtn (org-export-as-docbook
+ nil nil
+ buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+;;;###autoload
+(defun org-export-as-docbook-pdf (&optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export as DocBook XML file, and generate PDF file."
+ (interactive "P")
+ (if (or (not org-export-docbook-xslt-proc-command)
+ (not (string-match "%[ios].+%[ios].+%[ios]" org-export-docbook-xslt-proc-command)))
+ (error "XSLT processor command is not set correctly"))
+ (if (or (not org-export-docbook-xsl-fo-proc-command)
+ (not (string-match "%[io].+%[io]" org-export-docbook-xsl-fo-proc-command)))
+ (error "XSL-FO processor command is not set correctly"))
+ (message "Exporting to PDF...")
+ (let* ((wconfig (current-window-configuration))
+ (opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (docbook-buf (org-export-as-docbook hidden ext-plist
+ to-buffer body-only pub-dir))
+ (filename (buffer-file-name docbook-buf))
+ (base (file-name-sans-extension filename))
+ (fofile (concat base ".fo"))
+ (pdffile (concat base ".pdf")))
+ (and (file-exists-p pdffile) (delete-file pdffile))
+ (message "Processing DocBook XML file...")
+ (shell-command (format-spec org-export-docbook-xslt-proc-command
+ (format-spec-make
+ ?i (shell-quote-argument filename)
+ ?o (shell-quote-argument fofile)
+ ?s (shell-quote-argument
+ (or (plist-get opt-plist :xslt)
+ org-export-docbook-xslt-stylesheet)))))
+ (shell-command (format-spec org-export-docbook-xsl-fo-proc-command
+ (format-spec-make
+ ?i (shell-quote-argument fofile)
+ ?o (shell-quote-argument pdffile))))
+ (message "Processing DocBook file...done")
+ (if (not (file-exists-p pdffile))
+ (error "PDF file was not produced")
+ (set-window-configuration wconfig)
+ (message "Exporting to PDF...done")
+ pdffile)))
+
+;;;###autoload
+(defun org-export-as-docbook-pdf-and-open ()
+ "Export as DocBook XML file, generate PDF file, and open it."
+ (interactive)
+ (let ((pdffile (org-export-as-docbook-pdf)))
+ (if pdffile
+ (org-open-file pdffile)
+ (error "PDF file was not produced"))))
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+
+;;;###autoload
+(defun org-export-as-docbook (&optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the current buffer as a DocBook file.
+If there is an active region, export only the region. When
+HIDDEN is obsolete and does nothing. EXT-PLIST is a
+property list with external parameters overriding org-mode's
+default settings, but still inferior to file-local settings.
+When TO-BUFFER is non-nil, create a buffer with that name and
+export to that buffer. If TO-BUFFER is the symbol `string',
+don't leave any buffer behind but just return the resulting HTML
+as a string. When BODY-ONLY is set, don't produce the file
+header and footer, simply return the content of the document (all
+top-level sections). When PUB-DIR is set, use this as the
+publishing directory."
+ (interactive "P")
+ (run-hooks 'org-export-first-hook)
+
+ ;; Make sure we have a file name when we need it.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (message "Exporting...")
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (setq-default org-deadline-line-regexp org-deadline-line-regexp)
+ (setq-default org-done-keywords org-done-keywords)
+ (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
+ (let* ((opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (link-validate (plist-get opt-plist :link-validation-function))
+ valid
+ (odd org-odd-levels-only)
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-export-directory :docbook opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (level 0) (line "") (origline "") txt todo
+ (filename (if to-buffer nil
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory buffer-file-name)))
+ org-export-docbook-extension)
+ (file-name-as-directory
+ (or pub-dir (org-export-directory :docbook opt-plist))))))
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string)
+ (get-buffer-create "*Org DocBook Export*"))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect filename)))
+ ;; org-levels-open is a global variable
+ (org-levels-open (make-vector org-level-max nil))
+ (date (plist-get opt-plist :date))
+ (author (or (plist-get opt-plist :author)
+ user-full-name))
+ (email (plist-get opt-plist :email))
+ firstname othername surname
+ (title (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED"))
+ ;; We will use HTML table formatter to export tables to DocBook
+ ;; format, so need to set html-table-tag here.
+ (html-table-tag (plist-get opt-plist :html-table-tag))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (inquote nil)
+ (infixed nil)
+ (inverse nil)
+ (llt org-plain-list-ordered-item-terminator)
+ (email (plist-get opt-plist :email))
+ (language (plist-get opt-plist :language))
+ (lang-words nil)
+ cnt
+ (start 0)
+ (coding-system (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system))
+ (coding-system-for-write (or org-export-docbook-coding-system
+ coding-system))
+ (save-buffer-coding-system (or org-export-docbook-coding-system
+ coding-system))
+ (charset (and coding-system-for-write
+ (fboundp 'coding-system-get)
+ (coding-system-get coding-system-for-write
+ 'mime-charset)))
+ (region
+ (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (lines
+ (org-split-string
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend 'docbook
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :add-text
+ (plist-get opt-plist :text)
+ :LaTeX-fragments
+ (plist-get opt-plist :LaTeX-fragments))
+ "[\r\n]"))
+ ;; Use literal output to show check boxes.
+ (checkbox-start
+ (nth 1 (assoc "=" org-export-docbook-emphasis-alist)))
+ (checkbox-end
+ (nth 2 (assoc "=" org-export-docbook-emphasis-alist)))
+ table-open type
+ table-buffer table-orig-buffer
+ ind item-type starter
+ rpl path attr caption label desc descp desc1 desc2 link
+ fnc item-tag item-number
+ footref-seen footnote-list
+ id-file
+ )
+
+ ;; Fine detailed info about author name.
+ (if (string-match "\\([^ ]+\\) \\(.+ \\)?\\([^ ]+\\)" author)
+ (progn
+ (setq firstname (match-string 1 author)
+ othername (or (match-string 2 author) "")
+ surname (match-string 3 author))))
+
+ ;; Get all footnote text.
+ (setq footnote-list
+ (org-export-docbook-get-footnotes lines))
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (setq org-min-level (org-get-min-level lines level-offset))
+ (setq org-last-level org-min-level)
+ (org-init-section-numbers)
+
+ ;; Get and save the date.
+ (cond
+ ((and date (string-match "%" date))
+ (setq date (format-time-string date)))
+ (date)
+ (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
+
+ ;; Get the language-dependent settings
+ (setq lang-words (or (assoc language org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+
+ ;; Switch to the output buffer. Use fundamental-mode for now. We
+ ;; could turn on nXML mode later and do some indentation.
+ (set-buffer buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ ;; The main body...
+ (let ((case-fold-search nil)
+ (org-odd-levels-only odd))
+
+ ;; Create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+
+ ;; Insert DocBook file header, title, and author info.
+ (unless body-only
+ (insert org-export-docbook-header)
+ (if org-export-docbook-doctype
+ (insert org-export-docbook-doctype))
+ (insert "<!-- Date: " date " -->\n")
+ (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
+ (org-version) emacs-major-version))
+ (insert org-export-docbook-article-header)
+ (insert (format
+ "\n <title>%s</title>
+ <info>
+ <author>
+ <personname>
+ <firstname>%s</firstname> <othername>%s</othername> <surname>%s</surname>
+ </personname>
+ %s
+ </author>
+ </info>\n"
+ (org-docbook-expand title)
+ firstname othername surname
+ (if (and org-export-email-info
+ email (string-match "\\S-" email))
+ (concat "<email>" email "</email>") "")
+ )))
+
+ (org-init-section-numbers)
+
+ (org-export-docbook-open-para)
+
+ ;; Loop over all the lines...
+ (while (setq line (pop lines) origline line)
+ (catch 'nextline
+
+ ;; End of quote section?
+ (when (and inquote (string-match org-outline-regexp-bol line))
+ (insert "]]></programlisting>\n")
+ (org-export-docbook-open-para)
+ (setq inquote nil))
+ ;; Inside a quote section?
+ (when inquote
+ (insert (org-docbook-protect line) "\n")
+ (throw 'nextline nil))
+
+ ;; Fixed-width, verbatim lines (examples)
+ (when (and org-export-with-fixed-width
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
+ (when (not infixed)
+ (setq infixed t)
+ (org-export-docbook-close-para-maybe)
+ (insert "<programlisting><![CDATA["))
+ (insert (match-string 3 line) "\n")
+ (when (or (not lines)
+ (not (string-match "^[ \t]*\\(:.*\\)"
+ (car lines))))
+ (setq infixed nil)
+ (insert "]]></programlisting>\n")
+ (org-export-docbook-open-para))
+ (throw 'nextline nil))
+
+ ;; Protected HTML
+ (when (get-text-property 0 'org-protected line)
+ (let (par (ind (get-text-property 0 'original-indentation line)))
+ (when (re-search-backward
+ "\\(<para>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
+ (setq par (match-string 1))
+ (replace-match "\\2\n"))
+ (insert line "\n")
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-protected (car lines))))
+ (insert (pop lines) "\n"))
+ (and par (insert "<para>\n")))
+ (throw 'nextline nil))
+
+ ;; Start of block quotes and verses
+ (when (or (equal "ORG-BLOCKQUOTE-START" line)
+ (and (equal "ORG-VERSE-START" line)
+ (setq inverse t)))
+ (org-export-docbook-close-para-maybe)
+ (insert "<blockquote>")
+ ;; Check whether attribution for this blockquote exists.
+ (let (tmp1
+ attribution
+ (end (if inverse "ORG-VERSE-END" "ORG-BLOCKQUOTE-END"))
+ (quote-lines nil))
+ (while (and (setq tmp1 (pop lines))
+ (not (equal end tmp1)))
+ (push tmp1 quote-lines))
+ (push tmp1 lines) ; Put back quote end mark
+ ;; Check the last line in the quote to see if it contains
+ ;; the attribution.
+ (setq tmp1 (pop quote-lines))
+ (if (string-match "\\(^.*\\)\\(--[ \t]+\\)\\(.+\\)$" tmp1)
+ (progn
+ (setq attribution (match-string 3 tmp1))
+ (when (save-match-data
+ (string-match "[^ \t]" (match-string 1 tmp1)))
+ (push (match-string 1 tmp1) lines)))
+ (push tmp1 lines))
+ (while (setq tmp1 (pop quote-lines))
+ (push tmp1 lines))
+ (when attribution
+ (insert "<attribution>" attribution "</attribution>")))
+ ;; Insert <literallayout> for verse.
+ (if inverse
+ (insert "\n<literallayout>")
+ (org-export-docbook-open-para))
+ (throw 'nextline nil))
+
+ ;; End of block quotes
+ (when (equal "ORG-BLOCKQUOTE-END" line)
+ (org-export-docbook-close-para-maybe)
+ (insert "</blockquote>\n")
+ (org-export-docbook-open-para)
+ (throw 'nextline nil))
+
+ ;; End of verses
+ (when (equal "ORG-VERSE-END" line)
+ (insert "</literallayout>\n</blockquote>\n")
+ (org-export-docbook-open-para)
+ (setq inverse nil)
+ (throw 'nextline nil))
+
+ ;; Text centering. Element <para role="centered"> does not
+ ;; seem to work with FOP, so for now we use <informaltable> to
+ ;; center the text, which can contain multiple paragraphs.
+ (when (equal "ORG-CENTER-START" line)
+ (org-export-docbook-close-para-maybe)
+ (insert "<informaltable frame=\"none\" colsep=\"0\" rowsep=\"0\">\n"
+ "<tgroup align=\"center\" cols=\"1\">\n"
+ "<tbody><row><entry>\n")
+ (org-export-docbook-open-para)
+ (throw 'nextline nil))
+
+ (when (equal "ORG-CENTER-END" line)
+ (org-export-docbook-close-para-maybe)
+ (insert "</entry></row></tbody>\n"
+ "</tgroup>\n</informaltable>\n")
+ (org-export-docbook-open-para)
+ (throw 'nextline nil))
+
+ ;; Make targets to anchors. Note that currently FOP does not
+ ;; seem to support <anchor> tags when generating PDF output,
+ ;; but this can be used in DocBook --> HTML conversion.
+ (setq start 0)
+ (while (string-match
+ "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
+ (cond
+ ((get-text-property (match-beginning 1) 'org-protected line)
+ (setq start (match-end 1)))
+ ((match-end 2)
+ (setq line (replace-match
+ (format "@<anchor xml:id=\"%s\"/>"
+ (org-solidify-link-text (match-string 1 line)))
+ t t line)))
+ (t
+ (setq line (replace-match
+ (format "@<anchor xml:id=\"%s\"/>"
+ (org-solidify-link-text (match-string 1 line)))
+ t t line)))))
+
+ ;; Put time stamps and related keywords into special mark-up
+ ;; elements.
+ (setq line (org-export-docbook-handle-time-stamps line))
+
+ ;; Replace "&", "<" and ">" by "&amp;", "&lt;" and "&gt;".
+ ;; Handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>").
+ ;; Also handle sub_superscripts and check boxes.
+ (or (string-match org-table-hline-regexp line)
+ (setq line (org-docbook-expand line)))
+
+ ;; Format the links
+ (setq start 0)
+ (while (string-match org-bracket-link-analytic-regexp++ line start)
+ (setq start (match-beginning 0))
+ (setq path (save-match-data (org-link-unescape
+ (match-string 3 line))))
+ (setq type (cond
+ ((match-end 2) (match-string 2 line))
+ ((save-match-data
+ (or (file-name-absolute-p path)
+ (string-match "^\\.\\.?/" path)))
+ "file")
+ (t "internal")))
+ (setq path (org-extract-attributes (org-link-unescape path)))
+ (setq attr (get-text-property 0 'org-attributes path)
+ caption (get-text-property 0 'org-caption path)
+ label (get-text-property 0 'org-label path))
+ (setq desc1 (if (match-end 5) (match-string 5 line))
+ desc2 (if (match-end 2) (concat type ":" path) path)
+ descp (and desc1 (not (equal desc1 desc2)))
+ desc (or desc1 desc2))
+ ;; Make an image out of the description if that is so wanted
+ (when (and descp (org-file-image-p
+ desc org-export-docbook-inline-image-extensions))
+ (save-match-data
+ (if (string-match "^file:" desc)
+ (setq desc (substring desc (match-end 0))))))
+ ;; FIXME: do we need to unescape here somewhere?
+ (cond
+ ((equal type "internal")
+ (setq rpl (format "<link linkend=\"%s\">%s</link>"
+ (org-solidify-link-text
+ (save-match-data (org-link-unescape path)) nil)
+ (org-export-docbook-format-desc desc))))
+ ((and (equal type "id")
+ (setq id-file (org-id-find-id-file path)))
+ ;; This is an id: link to another file (if it was the same file,
+ ;; it would have become an internal link...)
+ (save-match-data
+ (setq id-file (file-relative-name
+ id-file (file-name-directory org-current-export-file)))
+ (setq id-file (concat (file-name-sans-extension id-file)
+ org-export-docbook-extension))
+ (setq rpl (format "<link xlink:href=\"%s#%s\">%s</link>"
+ id-file path (org-export-docbook-format-desc desc)))))
+ ((member type '("http" "https"))
+ ;; Standard URL, just check if we need to inline an image
+ (if (and (or (eq t org-export-docbook-inline-images)
+ (and org-export-docbook-inline-images (not descp)))
+ (org-file-image-p
+ path org-export-docbook-inline-image-extensions))
+ (setq rpl (org-export-docbook-format-image
+ (concat type ":" path)))
+ (setq link (concat type ":" path))
+ (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
+ (org-export-html-format-href link)
+ (org-export-docbook-format-desc desc)))
+ ))
+ ((member type '("ftp" "mailto" "news"))
+ ;; Standard URL
+ (setq link (concat type ":" path))
+ (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
+ (org-export-html-format-href link)
+ (org-export-docbook-format-desc desc))))
+ ((string= type "coderef")
+ (setq rpl (format (org-export-get-coderef-format path (and descp desc))
+ (cdr (assoc path org-export-code-refs)))))
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for format the link
+ (setq rpl
+ (save-match-data
+ (funcall fnc (org-link-unescape path) desc1 'html))))
+
+ ((string= type "file")
+ ;; FILE link
+ (let* ((filename path)
+ (abs-p (file-name-absolute-p filename))
+ thefile file-is-image-p search)
+ (save-match-data
+ (if (string-match "::\\(.*\\)" filename)
+ (setq search (match-string 1 filename)
+ filename (replace-match "" t nil filename)))
+ (setq valid
+ (if (functionp link-validate)
+ (funcall link-validate filename current-dir)
+ t))
+ (setq file-is-image-p
+ (org-file-image-p
+ filename org-export-docbook-inline-image-extensions))
+ (setq thefile (if abs-p (expand-file-name filename) filename))
+ ;; Carry over the properties (expand-file-name will
+ ;; discard the properties of filename)
+ (add-text-properties 0 (1- (length thefile))
+ (list 'org-caption caption
+ 'org-attributes attr
+ 'org-label label)
+ thefile)
+ (when (and org-export-docbook-link-org-files-as-docbook
+ (string-match "\\.org$" thefile))
+ (setq thefile (concat (substring thefile 0
+ (match-beginning 0))
+ org-export-docbook-extension))
+ (if (and search
+ ;; make sure this is can be used as target search
+ (not (string-match "^[0-9]*$" search))
+ (not (string-match "^\\*" search))
+ (not (string-match "^/.*/$" search)))
+ (setq thefile (concat thefile "#"
+ (org-solidify-link-text
+ (org-link-unescape search)))))
+ (when (string-match "^file:" desc)
+ (setq desc (replace-match "" t t desc))
+ (if (string-match "\\.org$" desc)
+ (setq desc (replace-match "" t t desc))))))
+ (setq rpl (if (and file-is-image-p
+ (or (eq t org-export-docbook-inline-images)
+ (and org-export-docbook-inline-images
+ (not descp))))
+ (progn
+ (message "image %s %s" thefile org-docbook-para-open)
+ (org-export-docbook-format-image thefile))
+ (format "<link xlink:href=\"%s\">%s</link>"
+ thefile (org-export-docbook-format-desc desc))))
+ (if (not valid) (setq rpl desc))))
+
+ (t
+ ;; Just publish the path, as default
+ (setq rpl (concat "&lt;" type ":"
+ (save-match-data (org-link-unescape path))
+ "&gt;"))))
+ (setq line (replace-match rpl t t line)
+ start (+ start (length rpl))))
+
+ ;; TODO items: can we do something better?!
+ (if (and (string-match org-todo-line-regexp line)
+ (match-beginning 2))
+ (setq line
+ (concat (substring line 0 (match-beginning 2))
+ "[" (match-string 2 line) "]"
+ (substring line (match-end 2)))))
+
+ ;; Does this contain a reference to a footnote?
+ (when org-export-with-footnotes
+ (setq start 0)
+ (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
+ ;; Discard protected matches not clearly identified as
+ ;; footnote markers.
+ (if (or (get-text-property (match-beginning 2) 'org-protected line)
+ (not (get-text-property (match-beginning 2) 'org-footnote line)))
+ (setq start (match-end 2))
+ (let* ((num (match-string 2 line))
+ (footnote-def (assoc num footnote-list)))
+ (if (assoc num footref-seen)
+ (setq line (replace-match
+ (format "%s<footnoteref linkend=\"%s%s\"/>"
+ (match-string 1 line)
+ org-export-docbook-footnote-id-prefix num)
+ t t line))
+ (setq line (replace-match
+ (concat
+ (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>"
+ (match-string 1 line)
+ org-export-docbook-footnote-id-prefix
+ num
+ (if footnote-def
+ (save-match-data
+ (org-docbook-expand (cdr footnote-def)))
+ (format "FOOTNOTE DEFINITION NOT FOUND: %s" num)))
+ ;; If another footnote is following the
+ ;; current one, add a separator.
+ (if (save-match-data
+ (string-match "\\`\\[[0-9]+\\]"
+ (substring line (match-end 0))))
+ org-export-docbook-footnote-separator
+ ""))
+ t t line))
+ (push (cons num 1) footref-seen))))))
+
+ (cond
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
+ ;; This is a headline
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (org-export-docbook-level-start level txt)
+ ;; QUOTES
+ (when (string-match quote-re line)
+ (org-export-docbook-close-para-maybe)
+ (insert "<programlisting><![CDATA[")
+ (setq inquote t)))
+
+ ;; Tables: since version 4.3 of DocBook DTD, HTML tables are
+ ;; supported. We can use existing HTML table exporter code
+ ;; here.
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ (if (not table-open)
+ ;; New table starts
+ (setq table-open t
+ table-buffer nil
+ table-orig-buffer nil))
+ ;; Accumulate lines
+ (setq table-buffer (cons line table-buffer)
+ table-orig-buffer (cons origline table-orig-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer)
+ table-orig-buffer (nreverse table-orig-buffer))
+ (org-export-docbook-close-para-maybe)
+ (insert (org-export-docbook-finalize-table
+ (org-format-table-html table-buffer table-orig-buffer
+ 'no-css)))))
+
+ ;; Normal lines
+ (t
+ ;; This line either is list item or end a list.
+ (when (when (get-text-property 0 'list-item line)
+ (setq line (org-export-docbook-list-line
+ line
+ (get-text-property 0 'list-item line)
+ (get-text-property 0 'list-struct line)
+ (get-text-property 0 'list-prevs line)))))
+
+ ;; Empty lines start a new paragraph. If hand-formatted lists
+ ;; are not fully interpreted, lines starting with "-", "+", "*"
+ ;; also start a new paragraph.
+ (if (and (string-match "^ [-+*]-\\|^[ \t]*$" line)
+ (not inverse))
+ (org-export-docbook-open-para))
+
+ ;; Is this the start of a footnote?
+ (when org-export-with-footnotes
+ (when (and (boundp 'footnote-section-tag-regexp)
+ (string-match (concat "^" footnote-section-tag-regexp)
+ line))
+ ;; ignore this line
+ (throw 'nextline nil))
+ ;; These footnote lines have been read and saved before,
+ ;; ignore them at this time.
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
+ (org-export-docbook-close-para-maybe)
+ (throw 'nextline nil)))
+
+ ;; FIXME: It might be a good idea to add an option to
+ ;; support line break processing instruction <?linebreak?>.
+ ;; Org-mode supports line break "\\" in HTML exporter, and
+ ;; some DocBook users may also want to force line breaks
+ ;; even though DocBook only supports that in
+ ;; <literallayout>.
+
+ (insert line "\n")))))
+
+ ;; Properly close all local lists and other lists
+ (when inquote
+ (insert "]]></programlisting>\n")
+ (org-export-docbook-open-para))
+
+ ;; Close all open sections.
+ (org-export-docbook-level-start 1 nil)
+
+ (unless (plist-get opt-plist :buffer-will-be-killed)
+ (normal-mode)
+ (if (eq major-mode (default-value 'major-mode))
+ (nxml-mode)))
+
+ ;; Remove empty paragraphs. Replace them with a newline.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
+ (when (not (get-text-property (match-beginning 1) 'org-protected))
+ (replace-match "\n")
+ (backward-char 1)))
+ ;; Fill empty sections with <para></para>. This is to make sure
+ ;; that the DocBook document generated is valid and well-formed.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "</title>\\([ \r\n\t]*\\)</section>" nil t)
+ (when (not (get-text-property (match-beginning 0) 'org-protected))
+ (replace-match "\n<para></para>\n" nil nil nil 1)))
+ ;; Insert the last closing tag.
+ (goto-char (point-max))
+ (unless body-only
+ (insert "</article>"))
+ (run-hooks 'org-export-docbook-final-hook)
+ (or to-buffer (save-buffer))
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring "DocBook")
+ (message "Exporting... done"))
+ (if (eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer)))
+ (current-buffer)))))
+
+(defun org-export-docbook-open-para ()
+ "Insert <para>, but first close previous paragraph if any."
+ (org-export-docbook-close-para-maybe)
+ (insert "\n<para>")
+ (setq org-docbook-para-open t))
+
+(defun org-export-docbook-close-para-maybe ()
+ "Close DocBook paragraph if there is one open."
+ (when org-docbook-para-open
+ (insert "</para>\n")
+ (setq org-docbook-para-open nil)))
+
+(defun org-export-docbook-close-li (&optional type)
+ "Close list if necessary."
+ (org-export-docbook-close-para-maybe)
+ (if (equal type "d")
+ (insert "</listitem></varlistentry>\n")
+ (insert "</listitem>\n")))
+
+(defun org-export-docbook-level-start (level title)
+ "Insert a new level in DocBook export.
+When TITLE is nil, just close all open levels."
+ (org-export-docbook-close-para-maybe)
+ (let* ((target (and title (org-get-text-property-any 0 'target title)))
+ (l org-level-max)
+ section-number)
+ (while (>= l level)
+ (if (aref org-levels-open (1- l))
+ (progn
+ (insert "</section>\n")
+ (aset org-levels-open (1- l) nil)))
+ (setq l (1- l)))
+ (when title
+ ;; If title is nil, this means this function is called to close
+ ;; all levels, so the rest is done only if title is given.
+ ;;
+ ;; Format tags: put them into a superscript like format.
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq title
+ (replace-match
+ (if org-export-with-tags
+ (save-match-data
+ (concat
+ "<superscript>"
+ (match-string 1 title)
+ "</superscript>"))
+ "")
+ t t title)))
+ (aset org-levels-open (1- level) t)
+ (setq section-number (org-section-number level))
+ (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>"
+ org-export-docbook-section-id-prefix
+ (replace-regexp-in-string "\\." "_" section-number)
+ title))
+ (org-export-docbook-open-para))))
+
+(defun org-docbook-expand (string)
+ "Prepare STRING for DocBook export.
+Applies all active conversions. If there are links in the
+string, don't modify these."
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-docbook-do-expand s) res)
+ (push l res))
+ (push (org-docbook-do-expand string) res)
+ (apply 'concat (nreverse res))))
+
+(defun org-docbook-do-expand (s)
+ "Apply all active conversions to translate special ASCII to DocBook."
+ (setq s (org-html-protect s))
+ (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
+ (setq s (replace-match "<\\1>" t nil s)))
+ (if org-export-with-emphasize
+ (setq s (org-export-docbook-convert-emphasize s)))
+ (if org-export-with-special-strings
+ (setq s (org-export-docbook-convert-special-strings s)))
+ (if org-export-with-sub-superscripts
+ (setq s (org-export-docbook-convert-sub-super s)))
+ (if org-export-with-TeX-macros
+ (let ((start 0) wd rep)
+ (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
+ s start))
+ (if (get-text-property (match-beginning 0) 'org-protected s)
+ (setq start (match-end 0))
+ (setq wd (match-string 1 s))
+ (if (setq rep (org-entity-get-representation wd 'html))
+ (setq s (replace-match rep t t s))
+ (setq start (+ start (length wd))))))))
+ s)
+
+(defun org-export-docbook-format-desc (desc)
+ "Make sure DESC is valid as a description in a link."
+ (save-match-data
+ (org-docbook-do-expand desc)))
+
+(defun org-export-docbook-convert-emphasize (string)
+ "Apply emphasis for DocBook exporting."
+ (let ((s 0) rpl)
+ (while (string-match org-emph-re string s)
+ (if (not (equal
+ (substring string (match-beginning 3) (1+ (match-beginning 3)))
+ (substring string (match-beginning 4) (1+ (match-beginning 4)))))
+ (setq s (match-beginning 0)
+ rpl
+ (concat
+ (match-string 1 string)
+ (nth 1 (assoc (match-string 3 string)
+ org-export-docbook-emphasis-alist))
+ (match-string 4 string)
+ (nth 2 (assoc (match-string 3 string)
+ org-export-docbook-emphasis-alist))
+ (match-string 5 string))
+ string (replace-match rpl t t string)
+ s (+ s (- (length rpl) 2)))
+ (setq s (1+ s))))
+ string))
+
+(defun org-docbook-protect (string)
+ (org-html-protect string))
+
+;; For now, simply return string as it is.
+(defun org-export-docbook-convert-special-strings (string)
+ "Convert special characters in STRING to DocBook."
+ string)
+
+(defun org-export-docbook-get-footnotes (lines)
+ "Given a list of LINES, return a list of alist footnotes."
+ (let ((list nil) line)
+ (while (setq line (pop lines))
+ (if (string-match "^[ \t]*\\[\\([0-9]+\\)\\] \\(.+\\)" line)
+ (push (cons (match-string 1 line) (match-string 2 line))
+ list)))
+ list))
+
+(defun org-export-docbook-format-image (src)
+ "Create image element in DocBook."
+ (save-match-data
+ (let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (attr (or (org-find-text-property-in-string 'org-attributes src)
+ ""))
+ (label (org-find-text-property-in-string 'org-label src))
+ (default-attr org-export-docbook-default-image-attributes)
+ tmp)
+ (setq caption (and caption (org-html-do-expand caption)))
+ (while (setq tmp (pop default-attr))
+ (if (not (string-match (concat (car tmp) "=") attr))
+ (setq attr (concat attr " " (car tmp) "=" (cdr tmp)))))
+ (format "<mediaobject%s>
+<imageobject>\n<imagedata fileref=\"%s\" %s/>\n</imageobject>
+%s</mediaobject>"
+ (if label (concat " xml:id=\"" label "\"") "")
+ src attr
+ (if caption
+ (concat "<caption>\n<para>"
+ caption
+ "</para>\n</caption>\n")
+ "")
+ ))))
+
+(defun org-export-docbook-preprocess (parameters)
+ "Extra preprocessing work for DocBook export."
+ ;; Merge lines starting with "\par" to one line. Such lines are
+ ;; regarded as the continuation of a long footnote.
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\(\\\\par\\>\\)" nil t)
+ (if (not (get-text-property (match-beginning 1) 'org-protected))
+ (replace-match ""))))
+
+(defun org-export-docbook-finalize-table (table)
+ "Clean up TABLE and turn it into DocBook format.
+This function adds a label to the table if it is available, and
+also changes TABLE to informaltable if caption does not exist.
+TABLE is a string containing the HTML code generated by
+`org-format-table-html' for a table in Org-mode buffer."
+ (let (table-with-label)
+ ;; Get the label if it exists, and move it into the <table> element.
+ (setq table-with-label
+ (if (string-match
+ "^<table \\(\\(.\\|\n\\)+\\)<a name=\"\\(.+\\)\" id=\".+\"></a>\n\\(\\(.\\|\n\\)+\\)</table>"
+ table)
+ (replace-match (concat "<table xml:id=\"" (match-string 3 table) "\" "
+ (match-string 1 table)
+ (match-string 4 table)
+ "</table>")
+ nil t table)
+ table))
+ ;; Change <table> into <informaltable> if caption does not exist.
+ (if (string-match
+ "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>"
+ table-with-label)
+ (replace-match (concat "<informaltable "
+ (match-string 1 table-with-label)
+ (match-string 3 table-with-label)
+ "</informaltable>")
+ nil t table-with-label)
+ table-with-label)))
+
+;; Note: This function is very similar to
+;; org-export-html-convert-sub-super. They can be merged in the future.
+(defun org-export-docbook-convert-sub-super (string)
+ "Convert sub- and superscripts in STRING for DocBook."
+ (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
+ (while (string-match org-match-substring-regexp string s)
+ (cond
+ ((and requireb (match-end 8)) (setq s (match-end 2)))
+ ((get-text-property (match-beginning 2) 'org-protected string)
+ (setq s (match-end 2)))
+ (t
+ (setq s (match-end 1)
+ key (if (string= (match-string 2 string) "_")
+ "subscript"
+ "superscript")
+ c (or (match-string 8 string)
+ (match-string 6 string)
+ (match-string 5 string))
+ string (replace-match
+ (concat (match-string 1 string)
+ "<" key ">" c "</" key ">")
+ t t string)))))
+ (while (string-match "\\\\\\([_^]\\)" string)
+ (setq string (replace-match (match-string 1 string) t t string)))
+ string))
+
+(defun org-export-docbook-protect-tags (string)
+ "Change ``<...>'' in string STRING into ``@<...>''.
+This is normally needed when STRING contains DocBook elements
+that need to be preserved in later phase of DocBook exporting."
+ (let ((start 0))
+ (while (string-match "<\\([^>]*\\)>" string start)
+ (setq string (replace-match
+ "@<\\1>" t nil string)
+ start (match-end 0)))
+ string))
+
+(defun org-export-docbook-handle-time-stamps (line)
+ "Format time stamps in string LINE."
+ (let (replaced
+ (kw-markup (org-export-docbook-protect-tags
+ org-export-docbook-keywords-markup))
+ (ts-markup (org-export-docbook-protect-tags
+ org-export-docbook-timestamp-markup)))
+ (while (string-match org-maybe-keyword-time-regexp line)
+ (setq replaced
+ (concat replaced
+ (substring line 0 (match-beginning 0))
+ (if (match-end 1)
+ (format kw-markup
+ (match-string 1 line)))
+ " "
+ (format ts-markup
+ (substring (org-translate-time
+ (match-string 3 line)) 1 -1)))
+ line (substring line (match-end 0))))
+ (concat replaced line)))
+
+(defun org-export-docbook-list-line (line pos struct prevs)
+ "Insert list syntax in export buffer. Return LINE, maybe modified.
+
+POS is the item position or line position the line had before
+modifications to buffer. STRUCT is the list structure. PREVS is
+the alist of previous items."
+ (let* ((get-type
+ (function
+ ;; Translate type of list containing POS to "ordered",
+ ;; "variable" or "itemized".
+ (lambda (pos struct prevs)
+ (let ((type (org-list-get-list-type pos struct prevs)))
+ (cond
+ ((eq 'ordered type) "ordered")
+ ((eq 'descriptive type) "variable")
+ (t "itemized"))))))
+ (get-closings
+ (function
+ ;; Return list of all items and sublists ending at POS, in
+ ;; reverse order.
+ (lambda (pos)
+ (let (out)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((end (nth 6 e))
+ (item (car e)))
+ (cond
+ ((= end pos) (push item out))
+ ((>= item pos) (throw 'exit nil)))))
+ struct))
+ out)))))
+ ;; First close any previous item, or list, ending at POS.
+ (mapc (lambda (e)
+ (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
+ (first-item (org-list-get-list-begin e struct prevs))
+ (type (funcall get-type first-item struct prevs)))
+ ;; Ending for every item
+ (org-export-docbook-close-para-maybe)
+ (insert (if (equal type "variable")
+ "</listitem></varlistentry>\n"
+ "</listitem>\n"))
+ ;; We're ending last item of the list: end list.
+ (when lastp
+ (insert (format "</%slist>\n" type))
+ (org-export-docbook-open-para))))
+ (funcall get-closings pos))
+ (cond
+ ;; At an item: insert appropriate tags in export buffer.
+ ((assq pos struct)
+ (string-match (concat "[ \t]*\\(\\S-+[ \t]*\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\][ \t]*\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
+ "\\(.*\\)")
+ line)
+ (let* ((checkbox (match-string 3 line))
+ (desc-tag (or (match-string 4 line) "???"))
+ (body (match-string 5 line))
+ (list-beg (org-list-get-list-begin pos struct prevs))
+ (firstp (= list-beg pos))
+ ;; Always refer to first item to determine list type, in
+ ;; case list is ill-formed.
+ (type (funcall get-type list-beg struct prevs))
+ ;; Special variables for ordered lists.
+ (counter (let ((count-tmp (org-list-get-counter pos struct)))
+ (cond
+ ((not count-tmp) nil)
+ ((string-match "[A-Za-z]" count-tmp)
+ (- (string-to-char (upcase count-tmp)) 64))
+ ((string-match "[0-9]+" count-tmp)
+ count-tmp)))))
+ ;; When FIRSTP, a new list or sub-list is starting.
+ (when firstp
+ (org-export-docbook-close-para-maybe)
+ (insert (format "<%slist>\n" type)))
+ (insert (cond
+ ((equal type "variable")
+ (format "<varlistentry><term>%s</term><listitem>" desc-tag))
+ ((and (equal type "ordered") counter)
+ (format "<listitem override=\"%s\">" counter))
+ (t "<listitem>")))
+ ;; For DocBook, we need to open a para right after tag
+ ;; <listitem>.
+ (org-export-docbook-open-para)
+ ;; If line had a checkbox, some additional modification is required.
+ (when checkbox (setq body (concat checkbox " " body)))
+ ;; Return modified line
+ body))
+ ;; At a list ender: normal text follows: need <para>.
+ ((equal "ORG-LIST-END-MARKER" line)
+ (org-export-docbook-open-para)
+ (throw 'nextline nil))
+ ;; Not at an item: return line unchanged (side-effects only).
+ (t line))))
+
+(provide 'org-docbook)
+
+;;; org-docbook.el ends here
diff --git a/lisp/org-docview.el b/lisp/org-docview.el
new file mode 100644
index 0000000..cb49013
--- /dev/null
+++ b/lisp/org-docview.el
@@ -0,0 +1,90 @@
+;;; org-docview.el --- support for links to doc-view-mode buffers
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Jan Böcker <jan.boecker at jboecker dot de>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to open files in doc-view-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;; The links take the form
+;;
+;; docview:<file path>::<page number>
+;;
+;; for example: [[docview:~/.elisp/org/doc/org.pdf::1][Org-Mode Manual]]
+;;
+;; Autocompletion for inserting links is supported; you will be
+;; prompted for a file and a page number.
+;;
+;; If you use org-store-link in a doc-view mode buffer, the stored
+;; link will point to the current page.
+
+;;; Code:
+
+
+(require 'org)
+
+(declare-function doc-view-goto-page "ext:doc-view" (page))
+(declare-function image-mode-window-get "ext:image-mode"
+ (prop &optional winprops))
+
+(autoload 'doc-view-goto-page "doc-view")
+
+(org-add-link-type "docview" 'org-docview-open)
+(add-hook 'org-store-link-functions 'org-docview-store-link)
+
+(defun org-docview-open (link)
+ (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
+ (let* ((path (match-string 1 link))
+ (page (string-to-number (match-string 2 link))))
+ (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1)
+ ;; to ensure org-link-frame-setup is respected
+ (doc-view-goto-page page)
+ )))
+
+(defun org-docview-store-link ()
+ "Store a link to a docview buffer."
+ (when (eq major-mode 'doc-view-mode)
+ ;; This buffer is in doc-view-mode
+ (let* ((path buffer-file-name)
+ (page (image-mode-window-get 'page))
+ (link (concat "docview:" path "::" (number-to-string page)))
+ (description ""))
+ (org-store-link-props
+ :type "docview"
+ :link link
+ :description path))))
+
+(defun org-docview-complete-link ()
+ "Use the existing file name completion for file.
+Links to get the file name, then ask the user for the page number
+and append it."
+ (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link))
+ "::"
+ (read-from-minibuffer "Page:" "1")))
+
+
+(provide 'org-docview)
+
+;;; org-docview.el ends here
diff --git a/lisp/org-element.el b/lisp/org-element.el
new file mode 100644
index 0000000..3d67ae7
--- /dev/null
+++ b/lisp/org-element.el
@@ -0,0 +1,4356 @@
+;;; org-element.el --- Parser And Applications for Org syntax
+
+;; Copyright (C) 2012 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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:
+;;
+;; Org syntax can be divided into three categories: "Greater
+;; elements", "Elements" and "Objects".
+;;
+;; Elements are related to the structure of the document. Indeed, all
+;; elements are a cover for the document: each position within belongs
+;; to at least one element.
+;;
+;; An element always starts and ends at the beginning of a line. With
+;; a few exceptions (namely `babel-call', `clock', `headline', `item',
+;; `keyword', `planning', `property-drawer' and `section' types), it
+;; can also accept a fixed set of keywords as attributes. Those are
+;; called "affiliated keywords" to distinguish them from other
+;; keywords, which are full-fledged elements. Almost all affiliated
+;; keywords are referenced in `org-element-affiliated-keywords'; the
+;; others are export attributes and start with "ATTR_" prefix.
+;;
+;; Element containing other elements (and only elements) are called
+;; greater elements. Concerned types are: `center-block', `drawer',
+;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
+;; `item', `plain-list', `quote-block', `section' and `special-block'.
+;;
+;; Other element types are: `babel-call', `clock', `comment',
+;; `comment-block', `example-block', `export-block', `fixed-width',
+;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
+;; `planning', `property-drawer', `quote-section', `src-block',
+;; `table', `table-row' and `verse-block'. Among them, `paragraph'
+;; and `verse-block' types can contain Org objects and plain text.
+;;
+;; Objects are related to document's contents. Some of them are
+;; recursive. Associated types are of the following: `bold', `code',
+;; `entity', `export-snippet', `footnote-reference',
+;; `inline-babel-call', `inline-src-block', `italic',
+;; `latex-fragment', `line-break', `link', `macro', `radio-target',
+;; `statistics-cookie', `strike-through', `subscript', `superscript',
+;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
+;;
+;; Some elements also have special properties whose value can hold
+;; objects themselves (i.e. an item tag or an headline name). Such
+;; values are called "secondary strings". Any object belongs to
+;; either an element or a secondary string.
+;;
+;; Notwithstanding affiliated keywords, each greater element, element
+;; and object has a fixed set of properties attached to it. Among
+;; them, four are shared by all types: `:begin' and `:end', which
+;; refer to the beginning and ending buffer positions of the
+;; considered element or object, `:post-blank', which holds the number
+;; of blank lines, or white spaces, at its end and `:parent' which
+;; refers to the element or object containing it. Greater elements
+;; and elements containing objects will also have `:contents-begin'
+;; and `:contents-end' properties to delimit contents.
+;;
+;; Lisp-wise, an element or an object can be represented as a list.
+;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
+;; TYPE is a symbol describing the Org element or object.
+;; PROPERTIES is the property list attached to it. See docstring of
+;; appropriate parsing function to get an exhaustive
+;; list.
+;; CONTENTS is a list of elements, objects or raw strings contained
+;; in the current element or object, when applicable.
+;;
+;; An Org buffer is a nested list of such elements and objects, whose
+;; type is `org-data' and properties is nil.
+;;
+;; The first part of this file defines Org syntax, while the second
+;; one provide accessors and setters functions.
+;;
+;; The next part implements a parser and an interpreter for each
+;; element and object type in Org syntax.
+;;
+;; The following part creates a fully recursive buffer parser. It
+;; also provides a tool to map a function to elements or objects
+;; matching some criteria in the parse tree. Functions of interest
+;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
+;; extent, `org-element-parse-secondary-string'.
+;;
+;; The penultimate part is the cradle of an interpreter for the
+;; obtained parse tree: `org-element-interpret-data'.
+;;
+;; The library ends by furnishing `org-element-at-point' function, and
+;; a way to give information about document structure around point
+;; with `org-element-context'.
+
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'org)
+
+
+;;; Definitions And Rules
+;;
+;; Define elements, greater elements and specify recursive objects,
+;; along with the affiliated keywords recognized. Also set up
+;; restrictions on recursive objects combinations.
+;;
+;; These variables really act as a control center for the parsing
+;; process.
+
+(defconst org-element-paragraph-separate
+ (concat "^\\(?:"
+ ;; Headlines, inlinetasks.
+ org-outline-regexp "\\|"
+ ;; Footnote definitions.
+ "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ "[ \t]*\\(?:"
+ ;; Empty lines.
+ "$" "\\|"
+ ;; Tables (any type).
+ "\\(?:|\\|\\+-[-+]\\)" "\\|"
+ ;; Blocks (any type), Babel calls, drawers (any type),
+ ;; fixed-width areas and keywords. Note: this is only an
+ ;; indication and need some thorough check.
+ "[#:]" "\\|"
+ ;; Horizontal rules.
+ "-\\{5,\\}[ \t]*$" "\\|"
+ ;; LaTeX environments.
+ "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
+ ;; Planning and Clock lines.
+ (regexp-opt (list org-scheduled-string
+ org-deadline-string
+ org-closed-string
+ org-clock-string))
+ "\\|"
+ ;; Lists.
+ (let ((term (case org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
+ (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
+ "\\(?:[ \t]\\|$\\)"))
+ "\\)\\)")
+ "Regexp to separate paragraphs in an Org buffer.
+In the case of lines starting with \"#\" and \":\", this regexp
+is not sufficient to know if point is at a paragraph ending. See
+`org-element-paragraph-parser' for more information.")
+
+(defconst org-element-all-elements
+ '(center-block clock comment comment-block drawer dynamic-block example-block
+ export-block fixed-width footnote-definition headline
+ horizontal-rule inlinetask item keyword latex-environment
+ babel-call paragraph plain-list planning property-drawer
+ quote-block quote-section section special-block src-block table
+ table-row verse-block)
+ "Complete list of element types.")
+
+(defconst org-element-greater-elements
+ '(center-block drawer dynamic-block footnote-definition headline inlinetask
+ item plain-list quote-block section special-block table)
+ "List of recursive element types aka Greater Elements.")
+
+(defconst org-element-all-successors
+ '(export-snippet footnote-reference inline-babel-call inline-src-block
+ latex-or-entity line-break link macro radio-target
+ statistics-cookie sub/superscript table-cell target
+ text-markup timestamp)
+ "Complete list of successors.")
+
+(defconst org-element-object-successor-alist
+ '((subscript . sub/superscript) (superscript . sub/superscript)
+ (bold . text-markup) (code . text-markup) (italic . text-markup)
+ (strike-through . text-markup) (underline . text-markup)
+ (verbatim . text-markup) (entity . latex-or-entity)
+ (latex-fragment . latex-or-entity))
+ "Alist of translations between object type and successor name.
+
+Sharing the same successor comes handy when, for example, the
+regexp matching one object can also match the other object.")
+
+(defconst org-element-all-objects
+ '(bold code entity export-snippet footnote-reference inline-babel-call
+ inline-src-block italic line-break latex-fragment link macro
+ radio-target statistics-cookie strike-through subscript superscript
+ table-cell target timestamp underline verbatim)
+ "Complete list of object types.")
+
+(defconst org-element-recursive-objects
+ '(bold italic link macro subscript radio-target strike-through superscript
+ table-cell underline)
+ "List of recursive object types.")
+
+(defconst org-element-block-name-alist
+ '(("CENTER" . org-element-center-block-parser)
+ ("COMMENT" . org-element-comment-block-parser)
+ ("EXAMPLE" . org-element-example-block-parser)
+ ("QUOTE" . org-element-quote-block-parser)
+ ("SRC" . org-element-src-block-parser)
+ ("VERSE" . org-element-verse-block-parser))
+ "Alist between block names and the associated parsing function.
+Names must be uppercase. Any block whose name has no association
+is parsed with `org-element-special-block-parser'.")
+
+(defconst org-element-affiliated-keywords
+ '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
+ "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
+ "List of affiliated keywords as strings.
+By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+are affiliated keywords and need not to be in this list.")
+
+(defconst org-element--affiliated-re
+ (format "[ \t]*#\\+%s:"
+ ;; Regular affiliated keywords.
+ (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
+ (regexp-opt org-element-affiliated-keywords)))
+ "Regexp matching any affiliated keyword.
+
+Keyword name is put in match group 1. Moreover, if keyword
+belongs to `org-element-dual-keywords', put the dual value in
+match group 2.
+
+Don't modify it, set `org-element-affiliated-keywords' instead.")
+
+(defconst org-element-keyword-translation-alist
+ '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
+ ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
+ ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
+ "Alist of usual translations for keywords.
+The key is the old name and the value the new one. The property
+holding their value will be named after the translated name.")
+
+(defconst org-element-multiple-keywords '("HEADER")
+ "List of affiliated keywords that can occur more that once in an element.
+
+Their value will be consed into a list of strings, which will be
+returned as the value of the property.
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.
+
+By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+allow multiple occurrences and need not to be in this list.")
+
+(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
+ "List of keywords whose value can be parsed.
+
+Their value will be stored as a secondary string: a list of
+strings and objects.
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.")
+
+(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
+ "List of keywords which can have a secondary value.
+
+In Org syntax, they can be written with optional square brackets
+before the colons. For example, results keyword can be
+associated to a hash value with the following:
+
+ #+RESULTS[hash-string]: some-source
+
+This list is checked after translations have been applied. See
+`org-element-keyword-translation-alist'.")
+
+(defconst org-element-object-restrictions
+ '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
+ radio-target sub/superscript target text-markup timestamp)
+ (footnote-reference export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break link macro
+ radio-target sub/superscript target text-markup
+ timestamp)
+ (headline inline-babel-call inline-src-block latex-or-entity link macro
+ radio-target statistics-cookie sub/superscript target text-markup
+ timestamp)
+ (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
+ radio-target sub/superscript target text-markup timestamp)
+ (italic export-snippet inline-babel-call inline-src-block latex-or-entity
+ link radio-target sub/superscript target text-markup timestamp)
+ (item export-snippet footnote-reference inline-babel-call latex-or-entity
+ link macro radio-target sub/superscript target text-markup)
+ (keyword latex-or-entity macro sub/superscript text-markup)
+ (link export-snippet inline-babel-call inline-src-block latex-or-entity link
+ sub/superscript text-markup)
+ (macro macro)
+ (paragraph export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break link macro
+ radio-target statistics-cookie sub/superscript target text-markup
+ timestamp)
+ (radio-target export-snippet latex-or-entity sub/superscript)
+ (strike-through export-snippet inline-babel-call inline-src-block
+ latex-or-entity link radio-target sub/superscript target
+ text-markup timestamp)
+ (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
+ sub/superscript target text-markup)
+ (superscript export-snippet inline-babel-call inline-src-block
+ latex-or-entity sub/superscript target text-markup)
+ (table-cell export-snippet latex-or-entity link macro radio-target
+ sub/superscript target text-markup timestamp)
+ (table-row table-cell)
+ (underline export-snippet inline-babel-call inline-src-block latex-or-entity
+ link radio-target sub/superscript target text-markup timestamp)
+ (verse-block footnote-reference inline-babel-call inline-src-block
+ latex-or-entity line-break link macro radio-target
+ sub/superscript target text-markup timestamp))
+ "Alist of objects restrictions.
+
+CAR is an element or object type containing objects and CDR is
+a list of successors that will be called within an element or
+object of such type.
+
+For example, in a `radio-target' object, one can only find
+entities, export snippets, latex-fragments, subscript and
+superscript.
+
+This alist also applies to secondary string. For example, an
+`headline' type element doesn't directly contain objects, but
+still has an entry since one of its properties (`:title') does.")
+
+(defconst org-element-secondary-value-alist
+ '((headline . :title)
+ (inlinetask . :title)
+ (item . :tag)
+ (footnote-reference . :inline-definition))
+ "Alist between element types and location of secondary value.")
+
+
+
+;;; Accessors and Setters
+;;
+;; Provide four accessors: `org-element-type', `org-element-property'
+;; `org-element-contents' and `org-element-restriction'.
+;;
+;; Setter functions allow to modify elements by side effect. There is
+;; `org-element-put-property', `org-element-set-contents',
+;; `org-element-set-element' and `org-element-adopt-element'. Note
+;; that `org-element-set-element' and `org-element-adopt-elements' are
+;; higher level functions since also update `:parent' property.
+
+(defsubst org-element-type (element)
+ "Return type of ELEMENT.
+
+The function returns the type of the element or object provided.
+It can also return the following special value:
+ `plain-text' for a string
+ `org-data' for a complete document
+ nil in any other case."
+ (cond
+ ((not (consp element)) (and (stringp element) 'plain-text))
+ ((symbolp (car element)) (car element))))
+
+(defsubst org-element-property (property element)
+ "Extract the value from the PROPERTY of an ELEMENT."
+ (plist-get (nth 1 element) property))
+
+(defsubst org-element-contents (element)
+ "Extract contents from an ELEMENT."
+ (and (consp element) (nthcdr 2 element)))
+
+(defsubst org-element-restriction (element)
+ "Return restriction associated to ELEMENT.
+ELEMENT can be an element, an object or a symbol representing an
+element or object type."
+ (cdr (assq (if (symbolp element) element (org-element-type element))
+ org-element-object-restrictions)))
+
+(defsubst org-element-put-property (element property value)
+ "In ELEMENT set PROPERTY to VALUE.
+Return modified element."
+ (when (consp element)
+ (setcar (cdr element) (plist-put (nth 1 element) property value)))
+ element)
+
+(defsubst org-element-set-contents (element &rest contents)
+ "Set ELEMENT contents to CONTENTS.
+Return modified element."
+ (cond ((not element) (list contents))
+ ((cdr element) (setcdr (cdr element) contents))
+ (t (nconc element contents))))
+
+(defsubst org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (mapc (lambda (blob) (org-element-put-property blob :parent old))
+ (org-element-contents new))
+ ;; Transfer contents.
+ (apply 'org-element-set-contents old (org-element-contents new))
+ ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
+ ;; with NEW's.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new)))
+
+(defsubst org-element-adopt-elements (parent &rest children)
+ "Append elements to the contents of another element.
+
+PARENT is an element or object. CHILDREN can be elements,
+objects, or a strings.
+
+The function takes care of setting `:parent' property for CHILD.
+Return parent element."
+ (if (not parent) children
+ ;; Link every child to PARENT.
+ (mapc (lambda (child)
+ (unless (stringp child)
+ (org-element-put-property child :parent parent)))
+ children)
+ ;; Add CHILDREN at the end of PARENT contents.
+ (apply 'org-element-set-contents
+ parent
+ (nconc (org-element-contents parent) children))
+ ;; Return modified PARENT element.
+ parent))
+
+
+
+;;; Greater elements
+;;
+;; For each greater element type, we define a parser and an
+;; interpreter.
+;;
+;; A parser returns the element or object as the list described above.
+;; Most of them accepts no argument. Though, exceptions exist. Hence
+;; every element containing a secondary string (see
+;; `org-element-secondary-value-alist') will accept an optional
+;; argument to toggle parsing of that secondary string. Moreover,
+;; `item' parser requires current list's structure as its first
+;; element.
+;;
+;; An interpreter accepts two arguments: the list representation of
+;; the element or object, and its contents. The latter may be nil,
+;; depending on the element or object considered. It returns the
+;; appropriate Org syntax, as a string.
+;;
+;; Parsing functions must follow the naming convention:
+;; org-element-TYPE-parser, where TYPE is greater element's type, as
+;; defined in `org-element-greater-elements'.
+;;
+;; Similarly, interpreting functions must follow the naming
+;; convention: org-element-TYPE-interpreter.
+;;
+;; With the exception of `headline' and `item' types, greater elements
+;; cannot contain other greater elements of their own type.
+;;
+;; Beside implementing a parser and an interpreter, adding a new
+;; greater element requires to tweak `org-element--current-element'.
+;; Moreover, the newly defined type must be added to both
+;; `org-element-all-elements' and `org-element-greater-elements'.
+
+
+;;;; Center Block
+
+(defun org-element-center-block-parser (limit)
+ "Parse a center block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `center-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_CENTER" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (save-excursion (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'center-block
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords))))))))
+
+(defun org-element-center-block-interpreter (center-block contents)
+ "Interpret CENTER-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
+
+
+;;;; Drawer
+
+(defun org-element-drawer-parser (limit)
+ "Parse a drawer.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `drawer' and CDR is a plist containing
+`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at beginning of drawer."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t)))
+ ;; Incomplete drawer: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((drawer-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((case-fold-search t)
+ (name (progn (looking-at org-drawer-regexp)
+ (org-match-string-no-properties 1)))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty drawers have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
+ (point))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :drawer-name name
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-drawer-interpreter (drawer contents)
+ "Interpret DRAWER element as Org syntax.
+CONTENTS is the contents of the element."
+ (format ":%s:\n%s:END:"
+ (org-element-property :drawer-name drawer)
+ contents))
+
+
+;;;; Dynamic Block
+
+(defun org-element-dynamic-block-parser (limit)
+ "Parse a dynamic block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `dynamic-block' and CDR is a plist
+containing `:block-name', `:begin', `:end', `:hiddenp',
+`:contents-begin', `:contents-end', `:arguments' and
+`:post-blank' keywords.
+
+Assume point is at beginning of dynamic block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward org-dblock-end-re limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((name (progn (looking-at org-dblock-start-re)
+ (org-match-string-no-properties 1)))
+ (arguments (org-match-string-no-properties 3))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'dynamic-block
+ (nconc
+ (list :begin begin
+ :end end
+ :block-name name
+ :arguments arguments
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-dynamic-block-interpreter (dynamic-block contents)
+ "Interpret DYNAMIC-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN: %s%s\n%s#+END:"
+ (org-element-property :block-name dynamic-block)
+ (let ((args (org-element-property :arguments dynamic-block)))
+ (and args (concat " " args)))
+ contents))
+
+
+;;;; Footnote Definition
+
+(defun org-element-footnote-definition-parser (limit)
+ "Parse a footnote definition.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `footnote-definition' and CDR is
+a plist containing `:label', `:begin' `:end', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the footnote definition."
+ (save-excursion
+ (let* ((label (progn (looking-at org-footnote-definition-re)
+ (org-match-string-no-properties 1)))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (ending (save-excursion
+ (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^[ \t]*$") limit 'move))
+ (match-beginning 0)
+ (point))))
+ (contents-begin (progn (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (and (/= (point) ending) (point))))
+ (contents-end (and contents-begin ending))
+ (end (progn (goto-char ending)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'footnote-definition
+ (nconc
+ (list :label label
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines ending end))
+ (cadr keywords))))))
+
+(defun org-element-footnote-definition-interpreter (footnote-definition contents)
+ "Interpret FOOTNOTE-DEFINITION element as Org syntax.
+CONTENTS is the contents of the footnote-definition."
+ (concat (format "[%s]" (org-element-property :label footnote-definition))
+ " "
+ contents))
+
+
+;;;; Headline
+
+(defun org-element-headline-parser (limit &optional raw-secondary-p)
+ "Parse an headline.
+
+Return a list whose CAR is `headline' and CDR is a plist
+containing `:raw-value', `:title', `:begin', `:end',
+`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
+`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
+`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
+`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
+keywords.
+
+The plist also contains any property set in the property drawer,
+with its name in lowercase, the underscores replaced with hyphens
+and colons at the beginning (i.e. `:custom-id').
+
+When RAW-SECONDARY-P is non-nil, headline's title will not be
+parsed as a secondary string, but as a plain string instead.
+
+Assume point is at beginning of the headline."
+ (save-excursion
+ (let* ((components (org-heading-components))
+ (level (nth 1 components))
+ (todo (nth 2 components))
+ (todo-type
+ (and todo (if (member todo org-done-keywords) 'done 'todo)))
+ (tags (let ((raw-tags (nth 5 components)))
+ (and raw-tags (org-split-string raw-tags ":"))))
+ (raw-value (or (nth 4 components) ""))
+ (quotedp
+ (let ((case-fold-search nil))
+ (string-match (format "^%s\\( \\|$\\)" org-quote-string)
+ raw-value)))
+ (commentedp
+ (let ((case-fold-search nil))
+ (string-match (format "^%s\\( \\|$\\)" org-comment-string)
+ raw-value)))
+ (archivedp (member org-archive-tag tags))
+ (footnote-section-p (and org-footnote-section
+ (string= org-footnote-section raw-value)))
+ ;; Normalize property names: ":SOME_PROP:" becomes
+ ;; ":some-prop".
+ (standard-props (let (plist)
+ (mapc
+ (lambda (p)
+ (let ((p-name (downcase (car p))))
+ (while (string-match "_" p-name)
+ (setq p-name
+ (replace-match "-" nil nil p-name)))
+ (setq p-name (intern (concat ":" p-name)))
+ (setq plist
+ (plist-put plist p-name (cdr p)))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props (org-entry-properties nil 'special "CLOCK"))
+ (scheduled (cdr (assoc "SCHEDULED" time-props)))
+ (deadline (cdr (assoc "DEADLINE" time-props)))
+ (clock (cdr (assoc "CLOCK" time-props)))
+ (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ (begin (point))
+ (end (save-excursion (goto-char (org-end-of-subtree t t))))
+ (pos-after-head (progn (forward-line) (point)))
+ (contents-begin (save-excursion
+ (skip-chars-forward " \r\t\n" end)
+ (and (/= (point) end) (line-beginning-position))))
+ (hidden (org-invisible-p2))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))))
+ ;; Clean RAW-VALUE from any quote or comment string.
+ (when (or quotedp commentedp)
+ (let ((case-fold-search nil))
+ (setq raw-value
+ (replace-regexp-in-string
+ (concat
+ (regexp-opt (list org-quote-string org-comment-string))
+ "\\(?: \\|$\\)")
+ ""
+ raw-value))))
+ ;; Clean TAGS from archive tag, if any.
+ (when archivedp (setq tags (delete org-archive-tag tags)))
+ (let ((headline
+ (list 'headline
+ (nconc
+ (list :raw-value raw-value
+ :begin begin
+ :end end
+ :pre-blank
+ (if (not contents-begin) 0
+ (count-lines pos-after-head contents-begin))
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :level level
+ :priority (nth 3 components)
+ :tags tags
+ :todo-keyword todo
+ :todo-type todo-type
+ :scheduled scheduled
+ :deadline deadline
+ :timestamp timestamp
+ :clock clock
+ :post-blank (count-lines
+ (if (not contents-end) pos-after-head
+ (goto-char contents-end)
+ (forward-line)
+ (point))
+ end)
+ :footnote-section-p footnote-section-p
+ :archivedp archivedp
+ :commentedp commentedp
+ :quotedp quotedp)
+ standard-props))))
+ (org-element-put-property
+ headline :title
+ (if raw-secondary-p raw-value
+ (org-element-parse-secondary-string
+ raw-value (org-element-restriction 'headline) headline)))))))
+
+(defun org-element-headline-interpreter (headline contents)
+ "Interpret HEADLINE element as Org syntax.
+CONTENTS is the contents of the element."
+ (let* ((level (org-element-property :level headline))
+ (todo (org-element-property :todo-keyword headline))
+ (priority (org-element-property :priority headline))
+ (title (org-element-interpret-data
+ (org-element-property :title headline)))
+ (tags (let ((tag-list (if (org-element-property :archivedp headline)
+ (cons org-archive-tag
+ (org-element-property :tags headline))
+ (org-element-property :tags headline))))
+ (and tag-list
+ (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (commentedp (org-element-property :commentedp headline))
+ (quotedp (org-element-property :quotedp headline))
+ (pre-blank (or (org-element-property :pre-blank headline) 0))
+ (heading (concat (make-string level ?*)
+ (and todo (concat " " todo))
+ (and quotedp (concat " " org-quote-string))
+ (and commentedp (concat " " org-comment-string))
+ (and priority
+ (format " [#%s]" (char-to-string priority)))
+ (cond ((and org-footnote-section
+ (org-element-property
+ :footnote-section-p headline))
+ (concat " " org-footnote-section))
+ (title (concat " " title))))))
+ (concat heading
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length heading) (length tags))) 1)
+ ? )
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length heading)) 1) ? )
+ tags))))
+ (make-string (1+ pre-blank) 10)
+ contents)))
+
+
+;;;; Inlinetask
+
+(defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
+ "Parse an inline task.
+
+Return a list whose CAR is `inlinetask' and CDR is a plist
+containing `:title', `:begin', `:end', `:hiddenp',
+`:contents-begin' and `:contents-end', `:level', `:priority',
+`:raw-value', `:tags', `:todo-keyword', `:todo-type',
+`:scheduled', `:deadline', `:timestamp', `:clock' and
+`:post-blank' keywords.
+
+The plist also contains any property set in the property drawer,
+with its name in lowercase, the underscores replaced with hyphens
+and colons at the beginning (i.e. `:custom-id').
+
+When optional argument RAW-SECONDARY-P is non-nil, inline-task's
+title will not be parsed as a secondary string, but as a plain
+string instead.
+
+Assume point is at beginning of the inline task."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (components (org-heading-components))
+ (todo (nth 2 components))
+ (todo-type (and todo
+ (if (member todo org-done-keywords) 'done 'todo)))
+ (tags (let ((raw-tags (nth 5 components)))
+ (and raw-tags (org-split-string raw-tags ":"))))
+ (raw-value (or (nth 4 components) ""))
+ ;; Normalize property names: ":SOME_PROP:" becomes
+ ;; ":some-prop".
+ (standard-props (let (plist)
+ (mapc
+ (lambda (p)
+ (let ((p-name (downcase (car p))))
+ (while (string-match "_" p-name)
+ (setq p-name
+ (replace-match "-" nil nil p-name)))
+ (setq p-name (intern (concat ":" p-name)))
+ (setq plist
+ (plist-put plist p-name (cdr p)))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props (org-entry-properties nil 'special "CLOCK"))
+ (scheduled (cdr (assoc "SCHEDULED" time-props)))
+ (deadline (cdr (assoc "DEADLINE" time-props)))
+ (clock (cdr (assoc "CLOCK" time-props)))
+ (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ (task-end (save-excursion
+ (end-of-line)
+ (and (re-search-forward "^\\*+ END" limit t)
+ (match-beginning 0))))
+ (contents-begin (progn (forward-line)
+ (and task-end (< (point) task-end) (point))))
+ (hidden (and contents-begin (org-invisible-p2)))
+ (contents-end (and contents-begin task-end))
+ (before-blank (if (not task-end) (point)
+ (goto-char task-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (inlinetask
+ (list 'inlinetask
+ (nconc
+ (list :raw-value raw-value
+ :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :level (nth 1 components)
+ :priority (nth 3 components)
+ :tags tags
+ :todo-keyword todo
+ :todo-type todo-type
+ :scheduled scheduled
+ :deadline deadline
+ :timestamp timestamp
+ :clock clock
+ :post-blank (count-lines before-blank end))
+ standard-props
+ (cadr keywords)))))
+ (org-element-put-property
+ inlinetask :title
+ (if raw-secondary-p raw-value
+ (org-element-parse-secondary-string
+ raw-value
+ (org-element-restriction 'inlinetask)
+ inlinetask))))))
+
+(defun org-element-inlinetask-interpreter (inlinetask contents)
+ "Interpret INLINETASK element as Org syntax.
+CONTENTS is the contents of inlinetask."
+ (let* ((level (org-element-property :level inlinetask))
+ (todo (org-element-property :todo-keyword inlinetask))
+ (priority (org-element-property :priority inlinetask))
+ (title (org-element-interpret-data
+ (org-element-property :title inlinetask)))
+ (tags (let ((tag-list (org-element-property :tags inlinetask)))
+ (and tag-list
+ (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (task (concat (make-string level ?*)
+ (and todo (concat " " todo))
+ (and priority
+ (format " [#%s]" (char-to-string priority)))
+ (and title (concat " " title)))))
+ (concat task
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length task) (length tags))) 1)
+ ? )
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length task)) 1) ? )
+ tags))))
+ ;; Prefer degenerate inlinetasks when there are no
+ ;; contents.
+ (when contents
+ (concat "\n"
+ contents
+ (make-string level ?*) " END")))))
+
+
+;;;; Item
+
+(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+ "Parse an item.
+
+STRUCT is the structure of the plain list.
+
+Return a list whose CAR is `item' and CDR is a plist containing
+`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
+`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
+`:post-blank' keywords.
+
+When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
+any, will not be parsed as a secondary string, but as a plain
+string instead.
+
+Assume point is at the beginning of the item."
+ (save-excursion
+ (beginning-of-line)
+ (looking-at org-list-full-item-re)
+ (let* ((begin (point))
+ (bullet (org-match-string-no-properties 1))
+ (checkbox (let ((box (org-match-string-no-properties 3)))
+ (cond ((equal "[ ]" box) 'off)
+ ((equal "[X]" box) 'on)
+ ((equal "[-]" box) 'trans))))
+ (counter (let ((c (org-match-string-no-properties 2)))
+ (save-match-data
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c)))))))
+ (end (save-excursion (goto-char (org-list-get-item-end begin struct))
+ (unless (bolp) (forward-line))
+ (point)))
+ (contents-begin
+ (progn (goto-char
+ ;; Ignore tags in un-ordered lists: they are just
+ ;; a part of item's body.
+ (if (and (match-beginning 4)
+ (save-match-data (string-match "[.)]" bullet)))
+ (match-beginning 4)
+ (match-end 0)))
+ (skip-chars-forward " \r\t\n" limit)
+ ;; If first line isn't empty, contents really start
+ ;; at the text after item's meta-data.
+ (if (= (point-at-bol) begin) (point) (point-at-bol))))
+ (hidden (progn (forward-line)
+ (and (not (= (point) end)) (org-invisible-p2))))
+ (contents-end (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))
+ (item
+ (list 'item
+ (list :bullet bullet
+ :begin begin
+ :end end
+ ;; CONTENTS-BEGIN and CONTENTS-END may be
+ ;; mixed up in the case of an empty item
+ ;; separated from the next by a blank line.
+ ;; Thus ensure the former is always the
+ ;; smallest.
+ :contents-begin (min contents-begin contents-end)
+ :contents-end (max contents-begin contents-end)
+ :checkbox checkbox
+ :counter counter
+ :hiddenp hidden
+ :structure struct
+ :post-blank (count-lines contents-end end)))))
+ (org-element-put-property
+ item :tag
+ (let ((raw-tag (org-list-get-tag begin struct)))
+ (and raw-tag
+ (if raw-secondary-p raw-tag
+ (org-element-parse-secondary-string
+ raw-tag (org-element-restriction 'item) item))))))))
+
+(defun org-element-item-interpreter (item contents)
+ "Interpret ITEM element as Org syntax.
+CONTENTS is the contents of the element."
+ (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
+ (checkbox (org-element-property :checkbox item))
+ (counter (org-element-property :counter item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag (org-element-interpret-data tag))))
+ ;; Compute indentation.
+ (ind (make-string (length bullet) 32))
+ (item-starts-with-par-p
+ (eq (org-element-type (car (org-element-contents item)))
+ 'paragraph)))
+ ;; Indent contents.
+ (concat
+ bullet
+ (and counter (format "[@%d] " counter))
+ (case checkbox
+ (on "[X] ")
+ (off "[ ] ")
+ (trans "[-] "))
+ (and tag (format "%s :: " tag))
+ (let ((contents (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
+ (if item-starts-with-par-p (org-trim contents)
+ (concat "\n" contents))))))
+
+
+;;;; Plain List
+
+(defun org-element-plain-list-parser (limit &optional structure)
+ "Parse a plain list.
+
+Optional argument STRUCTURE, when non-nil, is the structure of
+the plain list being parsed.
+
+Return a list whose CAR is `plain-list' and CDR is a plist
+containing `:type', `:begin', `:end', `:contents-begin' and
+`:contents-end', `:structure' and `:post-blank' keywords.
+
+Assume point is at the beginning of the list."
+ (save-excursion
+ (let* ((struct (or structure (org-list-struct)))
+ (prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct))
+ (type (org-list-get-list-type (point) struct prevs))
+ (contents-begin (point))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-end
+ (progn (goto-char (org-list-get-list-end (point) struct prevs))
+ (unless (bolp) (forward-line))
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ ;; Return value.
+ (list 'plain-list
+ (nconc
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :structure struct
+ :post-blank (count-lines contents-end end))
+ (cadr keywords))))))
+
+(defun org-element-plain-list-interpreter (plain-list contents)
+ "Interpret PLAIN-LIST element as Org syntax.
+CONTENTS is the contents of the element."
+ (with-temp-buffer
+ (insert contents)
+ (goto-char (point-min))
+ (org-list-repair)
+ (buffer-string)))
+
+
+;;;; Quote Block
+
+(defun org-element-quote-block-parser (limit)
+ "Parse a quote block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `quote-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'quote-block
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-quote-block-interpreter (quote-block contents)
+ "Interpret QUOTE-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
+
+
+;;;; Section
+
+(defun org-element-section-parser (limit)
+ "Parse a section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `section' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `contents-end'
+and `:post-blank' keywords."
+ (save-excursion
+ ;; Beginning of section is the beginning of the first non-blank
+ ;; line after previous headline.
+ (let ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (list 'section
+ (list :begin begin
+ :end end
+ :contents-begin begin
+ :contents-end pos-before-blank
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-section-interpreter (section contents)
+ "Interpret SECTION element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
+
+
+;;;; Special Block
+
+(defun org-element-special-block-parser (limit)
+ "Parse a special block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `special-block' and CDR is a plist
+containing `:type', `:begin', `:end', `:hiddenp',
+`:contents-begin', `:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let* ((case-fold-search t)
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
+ (upcase (match-string-no-properties 1)))))
+ (if (not (save-excursion
+ (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ ;; Empty blocks have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point))))
+ (contents-end (and contents-begin block-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (org-skip-whitespace)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'special-block
+ (nconc
+ (list :type type
+ :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-special-block-interpreter (special-block contents)
+ "Interpret SPECIAL-BLOCK element as Org syntax.
+CONTENTS is the contents of the element."
+ (let ((block-type (org-element-property :type special-block)))
+ (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
+
+
+
+;;; Elements
+;;
+;; For each element, a parser and an interpreter are also defined.
+;; Both follow the same naming convention used for greater elements.
+;;
+;; Also, as for greater elements, adding a new element type is done
+;; through the following steps: implement a parser and an interpreter,
+;; tweak `org-element--current-element' so that it recognizes the new
+;; type and add that new type to `org-element-all-elements'.
+;;
+;; As a special case, when the newly defined type is a block type,
+;; `org-element-block-name-alist' has to be modified accordingly.
+
+
+;;;; Babel Call
+
+(defun org-element-babel-call-parser (limit)
+ "Parse a babel call.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `babel-call' and CDR is a plist
+containing `:begin', `:end', `:info' and `:post-blank' as
+keywords."
+ (save-excursion
+ (let ((case-fold-search t)
+ (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
+ (org-babel-lob-get-info)))
+ (begin (point-at-bol))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'babel-call
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-babel-call-interpreter (babel-call contents)
+ "Interpret BABEL-CALL element as Org syntax.
+CONTENTS is nil."
+ (let* ((babel-info (org-element-property :info babel-call))
+ (main (car babel-info))
+ (post-options (nth 1 babel-info)))
+ (concat "#+CALL: "
+ (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
+ ;; Remove redundant square brackets.
+ (replace-match (match-string 1 main) nil nil main))
+ (and post-options (format "[%s]" post-options)))))
+
+
+;;;; Clock
+
+(defun org-element-clock-parser (limit)
+ "Parse a clock.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `clock' and CDR is a plist containing
+`:status', `:value', `:time', `:begin', `:end' and `:post-blank'
+as keywords."
+ (save-excursion
+ (let* ((case-fold-search nil)
+ (begin (point))
+ (value (progn (search-forward org-clock-string (line-end-position) t)
+ (org-skip-whitespace)
+ (looking-at "\\[.*\\]")
+ (org-match-string-no-properties 0)))
+ (time (and (progn (goto-char (match-end 0))
+ (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ (status (if time 'closed 'running))
+ (post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (unless (eobp) (beginning-of-line))
+ (count-lines before-blank (point))))
+ (end (point)))
+ (list 'clock
+ (list :status status
+ :value value
+ :time time
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-clock-interpreter (clock contents)
+ "Interpret CLOCK element as Org syntax.
+CONTENTS is nil."
+ (concat org-clock-string " "
+ (org-element-property :value clock)
+ (let ((time (org-element-property :time clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":")))))))
+
+
+;;;; Comment
+
+(defun org-element-comment-parser (limit)
+ "Parse a comment.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `comment' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank'
+keywords.
+
+Assume point is at comment beginning."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (value (prog2 (looking-at "[ \t]*# ?")
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))
+ (forward-line)))
+ (com-end
+ ;; Get comments ending.
+ (progn
+ (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
+ ;; Accumulate lines without leading hash and first
+ ;; whitespace.
+ (setq value
+ (concat value
+ "\n"
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))))
+ (forward-line))
+ (point)))
+ (end (progn (goto-char com-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'comment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines com-end end))
+ (cadr keywords))))))
+
+(defun org-element-comment-interpreter (comment contents)
+ "Interpret COMMENT element as Org syntax.
+CONTENTS is nil."
+ (replace-regexp-in-string "^" "# " (org-element-property :value comment)))
+
+
+;;;; Comment Block
+
+(defun org-element-comment-block-parser (limit)
+ "Parse an export block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `comment-block' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:value' and
+`:post-blank' keywords.
+
+Assume point is at comment block beginning."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (value (buffer-substring-no-properties
+ contents-begin contents-end)))
+ (list 'comment-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-comment-block-interpreter (comment-block contents)
+ "Interpret COMMENT-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
+ (org-remove-indentation (org-element-property :value comment-block))))
+
+
+;;;; Example Block
+
+(defun org-element-example-block-parser (limit)
+ "Parse an example block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `example-block' and CDR is a plist
+containing `:begin', `:end', `:number-lines', `:preserve-indent',
+`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
+`:switches', `:value' and `:post-blank' keywords."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((switches
+ (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (org-match-string-no-properties 1)))
+ ;; Switches analysis
+ (number-lines (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (and switches (string-match "-i\\>" switches)))
+ ;; Should labels be retained in (or stripped from) example
+ ;; blocks?
+ (retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches))))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ (use-labels
+ (or (not switches)
+ (and retain-labels (not (string-match "-k\\>" switches)))))
+ (label-fmt (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
+ ;; Standard block parsing.
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (value (buffer-substring-no-properties contents-begin contents-end))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'example-block
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :switches switches
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-example-block-interpreter (example-block contents)
+ "Interpret EXAMPLE-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((switches (org-element-property :switches example-block)))
+ (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
+ (org-remove-indentation
+ (org-element-property :value example-block))
+ "#+END_EXAMPLE")))
+
+
+;;;; Export Block
+
+(defun org-element-export-block-parser (limit)
+ "Parse an export block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `export-block' and CDR is a plist
+containing `:begin', `:end', `:type', `:hiddenp', `:value' and
+`:post-blank' keywords.
+
+Assume point is at export-block beginning."
+ (let* ((case-fold-search t)
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (upcase (org-match-string-no-properties 1)))))
+ (if (not (save-excursion
+ (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (contents-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol))))
+ (value (buffer-substring-no-properties contents-begin
+ contents-end)))
+ (list 'export-block
+ (nconc
+ (list :begin begin
+ :end end
+ :type type
+ :value value
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-export-block-interpreter (export-block contents)
+ "Interpret EXPORT-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((type (org-element-property :type export-block)))
+ (concat (format "#+BEGIN_%s\n" type)
+ (org-element-property :value export-block)
+ (format "#+END_%s" type))))
+
+
+;;;; Fixed-width
+
+(defun org-element-fixed-width-parser (limit)
+ "Parse a fixed-width section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `fixed-width' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the fixed-width area."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ value
+ (end-area
+ (progn
+ (while (and (< (point) limit)
+ (looking-at "[ \t]*:\\( \\|$\\)"))
+ ;; Accumulate text without starting colons.
+ (setq value
+ (concat value
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))
+ "\n"))
+ (forward-line))
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'fixed-width
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines end-area end))
+ (cadr keywords))))))
+
+(defun org-element-fixed-width-interpreter (fixed-width contents)
+ "Interpret FIXED-WIDTH element as Org syntax.
+CONTENTS is nil."
+ (replace-regexp-in-string
+ "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
+
+
+;;;; Horizontal Rule
+
+(defun org-element-horizontal-rule-parser (limit)
+ "Parse an horizontal rule.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `horizontal-rule' and CDR is a plist
+containing `:begin', `:end' and `:post-blank' keywords."
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (post-hr (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'horizontal-rule
+ (nconc
+ (list :begin begin
+ :end end
+ :post-blank (count-lines post-hr end))
+ (cadr keywords))))))
+
+(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
+ "Interpret HORIZONTAL-RULE element as Org syntax.
+CONTENTS is nil."
+ "-----")
+
+
+;;;; Keyword
+
+(defun org-element-keyword-parser (limit)
+ "Parse a keyword at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `keyword' and CDR is a plist
+containing `:key', `:value', `:begin', `:end' and `:post-blank'
+keywords."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (begin (point))
+ (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
+ (upcase (org-match-string-no-properties 1))))
+ (value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'keyword
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-keyword-interpreter (keyword contents)
+ "Interpret KEYWORD element as Org syntax.
+CONTENTS is nil."
+ (format "#+%s: %s"
+ (org-element-property :key keyword)
+ (org-element-property :value keyword)))
+
+
+;;;; Latex Environment
+
+(defun org-element-latex-environment-parser (limit)
+ "Parse a LaTeX environment.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `latex-environment' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank'
+keywords.
+
+Assume point is at the beginning of the latex environment."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (code-begin (point))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
+ (regexp-quote (match-string 1))))
+ (code-end
+ (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t)
+ (forward-line)
+ (point)))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end))
+ (cadr keywords))))))
+
+(defun org-element-latex-environment-interpreter (latex-environment contents)
+ "Interpret LATEX-ENVIRONMENT element as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value latex-environment))
+
+
+;;;; Paragraph
+
+(defun org-element-paragraph-parser (limit)
+ "Parse a paragraph.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `paragraph' and CDR is a plist
+containing `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the paragraph."
+ (save-excursion
+ (let* (;; INNER-PAR-P is non-nil when paragraph is at the
+ ;; beginning of an item or a footnote reference. In that
+ ;; case, we mustn't look for affiliated keywords since they
+ ;; belong to the container.
+ (inner-par-p (not (bolp)))
+ (contents-begin (point))
+ (keywords (unless inner-par-p
+ (org-element--collect-affiliated-keywords)))
+ (begin (if inner-par-p contents-begin (car keywords)))
+ (before-blank
+ (let ((case-fold-search t))
+ (end-of-line)
+ (re-search-forward org-element-paragraph-separate limit 'm)
+ (while (and (/= (point) limit)
+ (cond
+ ;; Skip non-existent or incomplete drawer.
+ ((save-excursion
+ (beginning-of-line)
+ (and (looking-at "[ \t]*:\\S-")
+ (or (not (looking-at org-drawer-regexp))
+ (not (save-excursion
+ (re-search-forward
+ "^[ \t]*:END:" limit t)))))))
+ ;; Stop at comments.
+ ((save-excursion
+ (beginning-of-line)
+ (not (looking-at "[ \t]*#\\S-"))) nil)
+ ;; Skip incomplete dynamic blocks.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+BEGIN: "))
+ (not (save-excursion
+ (re-search-forward
+ "^[ \t]*\\+END:" limit t))))
+ ;; Skip incomplete blocks.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)"))
+ (not (save-excursion
+ (re-search-forward
+ (concat "^[ \t]*#\\+END_"
+ (match-string 1))
+ limit t))))
+ ;; Skip incomplete latex environments.
+ ((save-excursion
+ (beginning-of-line)
+ (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}"))
+ (not (save-excursion
+ (re-search-forward
+ (format "^[ \t]*\\\\end{%s}"
+ (match-string 1))
+ limit t))))
+ ;; Skip ill-formed keywords.
+ ((not (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#\\+\\S-+:"))))))
+ (re-search-forward org-element-paragraph-separate limit 'm))
+ (if (eobp) (point) (goto-char (line-beginning-position)))))
+ (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'paragraph
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end))
+ (cadr keywords))))))
+
+(defun org-element-paragraph-interpreter (paragraph contents)
+ "Interpret PARAGRAPH element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
+
+
+;;;; Planning
+
+(defun org-element-planning-parser (limit)
+ "Parse a planning.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `planning' and CDR is a plist
+containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
+and `:post-blank' keywords."
+ (save-excursion
+ (let* ((case-fold-search nil)
+ (begin (point))
+ (post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (unless (eobp) (beginning-of-line))
+ (count-lines before-blank (point))))
+ (end (point))
+ closed deadline scheduled)
+ (goto-char begin)
+ (while (re-search-forward org-keyword-time-not-clock-regexp
+ (line-end-position) t)
+ (goto-char (match-end 1))
+ (org-skip-whitespace)
+ (let ((time (buffer-substring-no-properties
+ (1+ (point)) (1- (match-end 0))))
+ (keyword (match-string 1)))
+ (cond ((equal keyword org-closed-string) (setq closed time))
+ ((equal keyword org-deadline-string) (setq deadline time))
+ (t (setq scheduled time)))))
+ (list 'planning
+ (list :closed closed
+ :deadline deadline
+ :scheduled scheduled
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-planning-interpreter (planning contents)
+ "Interpret PLANNING element as Org syntax.
+CONTENTS is nil."
+ (mapconcat
+ 'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed (concat org-closed-string " [" closed "]")))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline (concat org-deadline-string " <" deadline ">")))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " <" scheduled ">")))))
+ " "))
+
+
+;;;; Property Drawer
+
+(defun org-element-property-drawer-parser (limit)
+ "Parse a property drawer.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `property-drawer' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end', `:properties' and `:post-blank' keywords.
+
+Assume point is at the beginning of the property drawer."
+ (save-excursion
+ (let ((case-fold-search t)
+ (begin (point))
+ (prop-begin (progn (forward-line) (point)))
+ (hidden (org-invisible-p2))
+ (properties
+ (let (val)
+ (while (not (looking-at "^[ \t]*:END:"))
+ (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
+ (push (cons (org-match-string-no-properties 1)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ val))
+ (forward-line))
+ val))
+ (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
+ (point-at-bol)))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'property-drawer
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :properties properties
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-property-drawer-interpreter (property-drawer contents)
+ "Interpret PROPERTY-DRAWER element as Org syntax.
+CONTENTS is nil."
+ (let ((props (org-element-property :properties property-drawer)))
+ (concat
+ ":PROPERTIES:\n"
+ (mapconcat (lambda (p)
+ (format org-property-format (format ":%s:" (car p)) (cdr p)))
+ (nreverse props) "\n")
+ "\n:END:")))
+
+
+;;;; Quote Section
+
+(defun org-element-quote-section-parser (limit)
+ "Parse a quote section.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `quote-section' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at beginning of the section."
+ (save-excursion
+ (let* ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))
+ (value (buffer-substring-no-properties begin pos-before-blank)))
+ (list 'quote-section
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-quote-section-interpreter (quote-section contents)
+ "Interpret QUOTE-SECTION element as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value quote-section))
+
+
+;;;; Src Block
+
+(defun org-element-src-block-parser (limit)
+ "Parse a src block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `src-block' and CDR is a plist
+containing `:language', `:switches', `:parameters', `:begin',
+`:end', `:hiddenp', `:number-lines', `:retain-labels',
+`:use-labels', `:label-fmt', `:preserve-indent', `:value' and
+`:post-blank' keywords.
+
+Assume point is at the beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ ;; Get beginning position.
+ (begin (car keywords))
+ ;; Get language as a string.
+ (language
+ (progn
+ (looking-at
+ (concat "^[ \t]*#\\+BEGIN_SRC"
+ "\\(?: +\\(\\S-+\\)\\)?"
+ "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
+ "\\(.*\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ ;; Get switches.
+ (switches (org-match-string-no-properties 2))
+ ;; Get parameters.
+ (parameters (org-match-string-no-properties 3))
+ ;; Switches analysis
+ (number-lines (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (and switches (string-match "-i\\>" switches)))
+ (label-fmt (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
+ ;; Should labels be retained in (or stripped from)
+ ;; src blocks?
+ (retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches))))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ (use-labels
+ (or (not switches)
+ (and retain-labels (not (string-match "-k\\>" switches)))))
+ ;; Get visibility status.
+ (hidden (progn (forward-line) (org-invisible-p2)))
+ ;; Retrieve code.
+ (value (buffer-substring-no-properties (point) contents-end))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ ;; Get position after ending blank lines.
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'src-block
+ (nconc
+ (list :language language
+ :switches (and (org-string-nw-p switches)
+ (org-trim switches))
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :begin begin
+ :end end
+ :number-lines number-lines
+ :preserve-indent preserve-indent
+ :retain-labels retain-labels
+ :use-labels use-labels
+ :label-fmt label-fmt
+ :hiddenp hidden
+ :value value
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-src-block-interpreter (src-block contents)
+ "Interpret SRC-BLOCK element as Org syntax.
+CONTENTS is nil."
+ (let ((lang (org-element-property :language src-block))
+ (switches (org-element-property :switches src-block))
+ (params (org-element-property :parameters src-block))
+ (value (let ((val (org-element-property :value src-block)))
+ (cond
+
+ (org-src-preserve-indentation val)
+ ((zerop org-edit-src-content-indentation)
+ (org-remove-indentation val))
+ (t
+ (let ((ind (make-string
+ org-edit-src-content-indentation 32)))
+ (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind
+ (org-remove-indentation val) nil nil 1)))))))
+ (concat (format "#+BEGIN_SRC%s\n"
+ (concat (and lang (concat " " lang))
+ (and switches (concat " " switches))
+ (and params (concat " " params))))
+ value
+ "#+END_SRC")))
+
+
+;;;; Table
+
+(defun org-element-table-parser (limit)
+ "Parse a table at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `table' and CDR is a plist containing
+`:begin', `:end', `:tblfm', `:type', `:contents-begin',
+`:contents-end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the table."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (table-begin (point))
+ (type (if (org-at-table.el-p) 'table.el 'org))
+ (keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (table-end (goto-char (marker-position (org-table-end t))))
+ (tblfm (let (acc)
+ (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
+ (push (org-match-string-no-properties 1) acc)
+ (forward-line))
+ acc))
+ (pos-before-blank (point))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'table
+ (nconc
+ (list :begin begin
+ :end end
+ :type type
+ :tblfm tblfm
+ ;; Only `org' tables have contents. `table.el' tables
+ ;; use a `:value' property to store raw table as
+ ;; a string.
+ :contents-begin (and (eq type 'org) table-begin)
+ :contents-end (and (eq type 'org) table-end)
+ :value (and (eq type 'table.el)
+ (buffer-substring-no-properties
+ table-begin table-end))
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords))))))
+
+(defun org-element-table-interpreter (table contents)
+ "Interpret TABLE element as Org syntax.
+CONTENTS is nil."
+ (if (eq (org-element-property :type table) 'table.el)
+ (org-remove-indentation (org-element-property :value table))
+ (concat (with-temp-buffer (insert contents)
+ (org-table-align)
+ (buffer-string))
+ (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
+ (reverse (org-element-property :tblfm table))
+ "\n"))))
+
+
+;;;; Table Row
+
+(defun org-element-table-row-parser (limit)
+ "Parse table row at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `table-row' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:type' and `:post-blank' keywords."
+ (save-excursion
+ (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
+ (begin (point))
+ ;; A table rule has no contents. In that case, ensure
+ ;; CONTENTS-BEGIN matches CONTENTS-END.
+ (contents-begin (and (eq type 'standard)
+ (search-forward "|")
+ (point)))
+ (contents-end (and (eq type 'standard)
+ (progn
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (point))))
+ (end (progn (forward-line) (point))))
+ (list 'table-row
+ (list :type type
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0)))))
+
+(defun org-element-table-row-interpreter (table-row contents)
+ "Interpret TABLE-ROW element as Org syntax.
+CONTENTS is the contents of the table row."
+ (if (eq (org-element-property :type table-row) 'rule) "|-"
+ (concat "| " contents)))
+
+
+;;;; Verse Block
+
+(defun org-element-verse-block-parser (limit)
+ "Parse a verse block.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `verse-block' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:hiddenp' and `:post-blank' keywords.
+
+Assume point is at beginning of the block."
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*#\\+END_VERSE" limit t)))
+ ;; Incomplete block: parse it as a paragraph.
+ (org-element-paragraph-parser limit)
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (let* ((keywords (org-element--collect-affiliated-keywords))
+ (begin (car keywords))
+ (hidden (progn (forward-line) (org-invisible-p2)))
+ (contents-begin (point))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'verse-block
+ (nconc
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :hiddenp hidden
+ :post-blank (count-lines pos-before-blank end))
+ (cadr keywords)))))))))
+
+(defun org-element-verse-block-interpreter (verse-block contents)
+ "Interpret VERSE-BLOCK element as Org syntax.
+CONTENTS is verse block contents."
+ (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
+
+
+
+;;; Objects
+;;
+;; Unlike to elements, interstices can be found between objects.
+;; That's why, along with the parser, successor functions are provided
+;; for each object. Some objects share the same successor (i.e. `code'
+;; and `verbatim' objects).
+;;
+;; A successor must accept a single argument bounding the search. It
+;; will return either a cons cell whose CAR is the object's type, as
+;; a symbol, and CDR the position of its next occurrence, or nil.
+;;
+;; Successors follow the naming convention:
+;; org-element-NAME-successor, where NAME is the name of the
+;; successor, as defined in `org-element-all-successors'.
+;;
+;; Some object types (i.e. `italic') are recursive. Restrictions on
+;; object types they can contain will be specified in
+;; `org-element-object-restrictions'.
+;;
+;; Adding a new type of object is simple. Implement a successor,
+;; a parser, and an interpreter for it, all following the naming
+;; convention. Register type in `org-element-all-objects' and
+;; successor in `org-element-all-successors'. Maybe tweak
+;; restrictions about it, and that's it.
+
+
+;;;; Bold
+
+(defun org-element-bold-parser ()
+ "Parse bold object at point.
+
+Return a list whose CAR is `bold' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first star marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-bold-interpreter (bold contents)
+ "Interpret BOLD object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "*%s*" contents))
+
+(defun org-element-text-markup-successor (limit)
+ "Search for the next text-markup object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is a symbol among `bold',
+`italic', `underline', `strike-through', `code' and `verbatim'
+and CDR is beginning position."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (when (re-search-forward org-emph-re limit t)
+ (let ((marker (match-string 3)))
+ (cons (cond
+ ((equal marker "*") 'bold)
+ ((equal marker "/") 'italic)
+ ((equal marker "_") 'underline)
+ ((equal marker "+") 'strike-through)
+ ((equal marker "~") 'code)
+ ((equal marker "=") 'verbatim)
+ (t (error "Unknown marker at %d" (match-beginning 3))))
+ (match-beginning 2))))))
+
+
+;;;; Code
+
+(defun org-element-code-parser ()
+ "Parse code object at point.
+
+Return a list whose CAR is `code' and CDR is a plist with
+`:value', `:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the first tilde marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-code-interpreter (code contents)
+ "Interpret CODE object as Org syntax.
+CONTENTS is nil."
+ (format "~%s~" (org-element-property :value code)))
+
+
+;;;; Entity
+
+(defun org-element-entity-parser ()
+ "Parse entity at point.
+
+Return a list whose CAR is `entity' and CDR a plist with
+`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
+`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
+keywords.
+
+Assume point is at the beginning of the entity."
+ (save-excursion
+ (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
+ (let* ((value (org-entity-get (match-string 1)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))
+
+(defun org-element-entity-interpreter (entity contents)
+ "Interpret ENTITY object as Org syntax.
+CONTENTS is nil."
+ (concat "\\"
+ (org-element-property :name entity)
+ (when (org-element-property :use-brackets-p entity) "{}")))
+
+(defun org-element-latex-or-entity-successor (limit)
+ "Search for the next latex-fragment or entity object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `entity' or
+`latex-fragment' and CDR is beginning position."
+ (save-excursion
+ (let ((matchers
+ (remove "begin" (plist-get org-format-latex-options :matchers)))
+ ;; ENTITY-RE matches both LaTeX commands and Org entities.
+ (entity-re
+ "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
+ (when (re-search-forward
+ (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
+ matchers "\\|")
+ "\\|" entity-re)
+ limit t)
+ (goto-char (match-beginning 0))
+ (if (looking-at entity-re)
+ ;; Determine if it's a real entity or a LaTeX command.
+ (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
+ (match-beginning 0))
+ ;; No entity nor command: point is at a LaTeX fragment.
+ ;; Determine its type to get the correct beginning position.
+ (cons 'latex-fragment
+ (catch 'return
+ (mapc (lambda (e)
+ (when (looking-at (nth 1 (assoc e org-latex-regexps)))
+ (throw 'return
+ (match-beginning
+ (nth 2 (assoc e org-latex-regexps))))))
+ matchers)
+ (point))))))))
+
+
+;;;; Export Snippet
+
+(defun org-element-export-snippet-parser ()
+ "Parse export snippet at point.
+
+Return a list whose CAR is `export-snippet' and CDR a plist with
+`:begin', `:end', `:back-end', `:value' and `:post-blank' as
+keywords.
+
+Assume point is at the beginning of the snippet."
+ (save-excursion
+ (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
+ (let* ((begin (match-beginning 0))
+ (back-end (org-match-string-no-properties 1))
+ (value (buffer-substring-no-properties
+ (point)
+ (progn (re-search-forward "@@" nil t) (match-beginning 0))))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'export-snippet
+ (list :back-end back-end
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-export-snippet-interpreter (export-snippet contents)
+ "Interpret EXPORT-SNIPPET object as Org syntax.
+CONTENTS is nil."
+ (format "@@%s:%s@@"
+ (org-element-property :back-end export-snippet)
+ (org-element-property :value export-snippet)))
+
+(defun org-element-export-snippet-successor (limit)
+ "Search for the next export-snippet object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `export-snippet' and CDR
+its beginning position."
+ (save-excursion
+ (let (beg)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (setq beg (match-beginning 0))
+ (search-forward "@@" limit t))
+ (cons 'export-snippet beg)))))
+
+
+;;;; Footnote Reference
+
+(defun org-element-footnote-reference-parser ()
+ "Parse footnote reference at point.
+
+Return a list whose CAR is `footnote-reference' and CDR a plist
+with `:label', `:type', `:inline-definition', `:begin', `:end'
+and `:post-blank' as keywords."
+ (save-excursion
+ (looking-at org-footnote-re)
+ (let* ((begin (point))
+ (label (or (org-match-string-no-properties 2)
+ (org-match-string-no-properties 3)
+ (and (match-string 1)
+ (concat "fn:" (org-match-string-no-properties 1)))))
+ (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (inner-begin (match-end 0))
+ (inner-end
+ (let ((count 1))
+ (forward-char)
+ (while (and (> count 0) (re-search-forward "[][]" nil t))
+ (if (equal (match-string 0) "[") (incf count) (decf count)))
+ (1- (point))))
+ (post-blank (progn (goto-char (1+ inner-end))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (footnote-reference
+ (list 'footnote-reference
+ (list :label label
+ :type type
+ :begin begin
+ :end end
+ :post-blank post-blank))))
+ (org-element-put-property
+ footnote-reference :inline-definition
+ (and (eq type 'inline)
+ (org-element-parse-secondary-string
+ (buffer-substring inner-begin inner-end)
+ (org-element-restriction 'footnote-reference)
+ footnote-reference))))))
+
+(defun org-element-footnote-reference-interpreter (footnote-reference contents)
+ "Interpret FOOTNOTE-REFERENCE object as Org syntax.
+CONTENTS is nil."
+ (let ((label (or (org-element-property :label footnote-reference) "fn:"))
+ (def
+ (let ((inline-def
+ (org-element-property :inline-definition footnote-reference)))
+ (if (not inline-def) ""
+ (concat ":" (org-element-interpret-data inline-def))))))
+ (format "[%s]" (concat label def))))
+
+(defun org-element-footnote-reference-successor (limit)
+ "Search for the next footnote-reference object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `footnote-reference' and
+CDR is beginning position."
+ (save-excursion
+ (catch 'exit
+ (while (re-search-forward org-footnote-re limit t)
+ (save-excursion
+ (let ((beg (match-beginning 0))
+ (count 1))
+ (backward-char)
+ (while (re-search-forward "[][]" limit t)
+ (if (equal (match-string 0) "[") (incf count) (decf count))
+ (when (zerop count)
+ (throw 'exit (cons 'footnote-reference beg))))))))))
+
+
+;;;; Inline Babel Call
+
+(defun org-element-inline-babel-call-parser ()
+ "Parse inline babel call at point.
+
+Return a list whose CAR is `inline-babel-call' and CDR a plist
+with `:begin', `:end', `:info' and `:post-blank' as keywords.
+
+Assume point is at the beginning of the babel call."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (looking-at org-babel-inline-lob-one-liner-regexp)
+ (let ((info (save-match-data (org-babel-lob-get-info)))
+ (begin (match-end 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank post-blank)))))
+
+(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
+ "Interpret INLINE-BABEL-CALL object as Org syntax.
+CONTENTS is nil."
+ (let* ((babel-info (org-element-property :info inline-babel-call))
+ (main-source (car babel-info))
+ (post-options (nth 1 babel-info)))
+ (concat "call_"
+ (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
+ ;; Remove redundant square brackets.
+ (replace-match
+ (match-string 1 main-source) nil nil main-source)
+ main-source)
+ (and post-options (format "[%s]" post-options)))))
+
+(defun org-element-inline-babel-call-successor (limit)
+ "Search for the next inline-babel-call object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `inline-babel-call' and
+CDR is beginning position."
+ (save-excursion
+ ;; Use a simplified version of
+ ;; `org-babel-inline-lob-one-liner-regexp'.
+ (when (re-search-forward
+ "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
+ limit t)
+ (cons 'inline-babel-call (match-beginning 0)))))
+
+
+;;;; Inline Src Block
+
+(defun org-element-inline-src-block-parser ()
+ "Parse inline source block at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `inline-src-block' and CDR a plist
+with `:begin', `:end', `:language', `:value', `:parameters' and
+`:post-blank' as keywords.
+
+Assume point is at the beginning of the inline src block."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (looking-at org-babel-inline-src-block-regexp)
+ (let ((begin (match-beginning 1))
+ (language (org-match-string-no-properties 2))
+ (parameters (org-match-string-no-properties 4))
+ (value (org-match-string-no-properties 5))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-inline-src-block-interpreter (inline-src-block contents)
+ "Interpret INLINE-SRC-BLOCK object as Org syntax.
+CONTENTS is nil."
+ (let ((language (org-element-property :language inline-src-block))
+ (arguments (org-element-property :parameters inline-src-block))
+ (body (org-element-property :value inline-src-block)))
+ (format "src_%s%s{%s}"
+ language
+ (if arguments (format "[%s]" arguments) "")
+ body)))
+
+(defun org-element-inline-src-block-successor (limit)
+ "Search for the next inline-babel-call element.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `inline-babel-call' and
+CDR is beginning position."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (cons 'inline-src-block (match-beginning 1)))))
+
+;;;; Italic
+
+(defun org-element-italic-parser ()
+ "Parse italic object at point.
+
+Return a list whose CAR is `italic' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first slash marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'italic
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-italic-interpreter (italic contents)
+ "Interpret ITALIC object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "/%s/" contents))
+
+
+;;;; Latex Fragment
+
+(defun org-element-latex-fragment-parser ()
+ "Parse latex fragment at point.
+
+Return a list whose CAR is `latex-fragment' and CDR a plist with
+`:value', `:begin', `:end', and `:post-blank' as keywords.
+
+Assume point is at the beginning of the latex fragment."
+ (save-excursion
+ (let* ((begin (point))
+ (substring-match
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
+ (when (or (looking-at latex-regexp)
+ (and (not (bobp))
+ (save-excursion
+ (backward-char)
+ (looking-at latex-regexp))))
+ (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
+ (plist-get org-format-latex-options :matchers))
+ ;; None found: it's a macro.
+ (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
+ 0))
+ (value (match-string-no-properties substring-match))
+ (post-blank (progn (goto-char (match-end substring-match))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'latex-fragment
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-latex-fragment-interpreter (latex-fragment contents)
+ "Interpret LATEX-FRAGMENT object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value latex-fragment))
+
+;;;; Line Break
+
+(defun org-element-line-break-parser ()
+ "Parse line break at point.
+
+Return a list whose CAR is `line-break', and CDR a plist with
+`:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the beginning of the line break."
+ (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
+
+(defun org-element-line-break-interpreter (line-break contents)
+ "Interpret LINE-BREAK object as Org syntax.
+CONTENTS is nil."
+ "\\\\")
+
+(defun org-element-line-break-successor (limit)
+ "Search for the next line-break object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `line-break' and CDR is
+beginning position."
+ (save-excursion
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (goto-char (match-beginning 1)))))
+ ;; A line break can only happen on a non-empty line.
+ (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
+ (cons 'line-break beg)))))
+
+
+;;;; Link
+
+(defun org-element-link-parser ()
+ "Parse link at point.
+
+Return a list whose CAR is `link' and CDR a plist with `:type',
+`:path', `:raw-link', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as keywords.
+
+Assume point is at the beginning of the link."
+ (save-excursion
+ (let ((begin (point))
+ end contents-begin contents-end link-end post-blank path type
+ raw-link link)
+ (cond
+ ;; Type 1: Text targeted from a radio target.
+ ((and org-target-link-regexp (looking-at org-target-link-regexp))
+ (setq type "radio"
+ link-end (match-end 0)
+ path (org-match-string-no-properties 0)))
+ ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
+ ((looking-at org-bracket-link-regexp)
+ (setq contents-begin (match-beginning 3)
+ contents-end (match-end 3)
+ link-end (match-end 0)
+ ;; RAW-LINK is the original link.
+ raw-link (org-match-string-no-properties 1)
+ link (org-translate-link
+ (org-link-expand-abbrev
+ (org-link-unescape raw-link))))
+ ;; Determine TYPE of link and set PATH accordingly.
+ (cond
+ ;; File type.
+ ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
+ (setq type "file" path link))
+ ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
+ ((string-match org-link-re-with-space3 link)
+ (setq type (match-string 1 link) path (match-string 2 link)))
+ ;; Id type: PATH is the id.
+ ((string-match "^id:\\([-a-f0-9]+\\)" link)
+ (setq type "id" path (match-string 1 link)))
+ ;; Code-ref type: PATH is the name of the reference.
+ ((string-match "^(\\(.*\\))$" link)
+ (setq type "coderef" path (match-string 1 link)))
+ ;; Custom-id type: PATH is the name of the custom id.
+ ((= (aref link 0) ?#)
+ (setq type "custom-id" path (substring link 1)))
+ ;; Fuzzy type: Internal link either matches a target, an
+ ;; headline name or nothing. PATH is the target or
+ ;; headline's name.
+ (t (setq type "fuzzy" path link))))
+ ;; Type 3: Plain link, i.e. http://orgmode.org
+ ((looking-at org-plain-link-re)
+ (setq raw-link (org-match-string-no-properties 0)
+ type (org-match-string-no-properties 1)
+ path (org-match-string-no-properties 2)
+ link-end (match-end 0)))
+ ;; Type 4: Angular link, i.e. <http://orgmode.org>
+ ((looking-at org-angle-link-re)
+ (setq raw-link (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2))
+ type (org-match-string-no-properties 1)
+ path (org-match-string-no-properties 2)
+ link-end (match-end 0))))
+ ;; In any case, deduce end point after trailing white space from
+ ;; LINK-END variable.
+ (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
+ end (point))
+ (list 'link
+ (list :type type
+ :path path
+ :raw-link (or raw-link path)
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-link-interpreter (link contents)
+ "Interpret LINK object as Org syntax.
+CONTENTS is the contents of the object, or nil."
+ (let ((type (org-element-property :type link))
+ (raw-link (org-element-property :raw-link link)))
+ (if (string= type "radio") raw-link
+ (format "[[%s]%s]"
+ raw-link
+ (if contents (format "[%s]" contents) "")))))
+
+(defun org-element-link-successor (limit)
+ "Search for the next link object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `link' and CDR is
+beginning position."
+ (save-excursion
+ (let ((link-regexp
+ (if (not org-target-link-regexp) org-any-link-re
+ (concat org-any-link-re "\\|" org-target-link-regexp))))
+ (when (re-search-forward link-regexp limit t)
+ (cons 'link (match-beginning 0))))))
+
+
+;;;; Macro
+
+(defun org-element-macro-parser ()
+ "Parse macro at point.
+
+Return a list whose CAR is `macro' and CDR a plist with `:key',
+`:args', `:begin', `:end', `:value' and `:post-blank' as
+keywords.
+
+Assume point is at the macro."
+ (save-excursion
+ (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
+ (let ((begin (point))
+ (key (downcase (org-match-string-no-properties 1)))
+ (value (org-match-string-no-properties 0))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (args (let ((args (org-match-string-no-properties 3)) args2)
+ (when args
+ (setq args (org-split-string args ","))
+ (while args
+ (while (string-match "\\\\\\'" (car args))
+ ;; Repair bad splits.
+ (setcar (cdr args) (concat (substring (car args) 0 -1)
+ "," (nth 1 args)))
+ (pop args))
+ (push (pop args) args2))
+ (mapcar 'org-trim (nreverse args2))))))
+ (list 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-macro-interpreter (macro contents)
+ "Interpret MACRO object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value macro))
+
+(defun org-element-macro-successor (limit)
+ "Search for the next macro object.
+
+LIMIT bounds the search.
+
+Return value is cons cell whose CAR is `macro' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward
+ "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
+ limit t)
+ (cons 'macro (match-beginning 0)))))
+
+
+;;;; Radio-target
+
+(defun org-element-radio-target-parser ()
+ "Parse radio target at point.
+
+Return a list whose CAR is `radio-target' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end', `:value'
+and `:post-blank' as keywords.
+
+Assume point is at the radio target."
+ (save-excursion
+ (looking-at org-radio-target-regexp)
+ (let ((begin (point))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value)))))
+
+(defun org-element-radio-target-interpreter (target contents)
+ "Interpret TARGET object as Org syntax.
+CONTENTS is the contents of the object."
+ (concat "<<<" contents ">>>"))
+
+(defun org-element-radio-target-successor (limit)
+ "Search for the next radio-target object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `radio-target' and CDR
+is beginning position."
+ (save-excursion
+ (when (re-search-forward org-radio-target-regexp limit t)
+ (cons 'radio-target (match-beginning 0)))))
+
+
+;;;; Statistics Cookie
+
+(defun org-element-statistics-cookie-parser ()
+ "Parse statistics cookie at point.
+
+Return a list whose CAR is `statistics-cookie', and CDR a plist
+with `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the statistics-cookie."
+ (save-excursion
+ (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
+ (let* ((begin (point))
+ (value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'statistics-cookie
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))
+
+(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
+ "Interpret STATISTICS-COOKIE object as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value statistics-cookie))
+
+(defun org-element-statistics-cookie-successor (limit)
+ "Search for the next statistics cookie object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `statistics-cookie' and
+CDR is beginning position."
+ (save-excursion
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (cons 'statistics-cookie (match-beginning 0)))))
+
+
+;;;; Strike-Through
+
+(defun org-element-strike-through-parser ()
+ "Parse strike-through object at point.
+
+Return a list whose CAR is `strike-through' and CDR is a plist
+with `:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first plus sign marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'strike-through
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-strike-through-interpreter (strike-through contents)
+ "Interpret STRIKE-THROUGH object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "+%s+" contents))
+
+
+;;;; Subscript
+
+(defun org-element-subscript-parser ()
+ "Parse subscript at point.
+
+Return a list whose CAR is `subscript' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end',
+`:use-brackets-p' and `:post-blank' as keywords.
+
+Assume point is at the underscore."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
+ t
+ (not (looking-at org-match-substring-regexp))))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 5)
+ (match-beginning 3)))
+ (contents-end (or (match-end 5) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-subscript-interpreter (subscript contents)
+ "Interpret SUBSCRIPT object as Org syntax.
+CONTENTS is the contents of the object."
+ (format
+ (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
+ contents))
+
+(defun org-element-sub/superscript-successor (limit)
+ "Search for the next sub/superscript object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is either `subscript' or
+`superscript' and CDR is beginning position."
+ (save-excursion
+ (when (re-search-forward org-match-substring-regexp limit t)
+ (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
+ (match-beginning 2)))))
+
+
+;;;; Superscript
+
+(defun org-element-superscript-parser ()
+ "Parse superscript at point.
+
+Return a list whose CAR is `superscript' and CDR a plist with
+`:begin', `:end', `:contents-begin', `:contents-end',
+`:use-brackets-p' and `:post-blank' as keywords.
+
+Assume point is at the caret."
+ (save-excursion
+ (unless (bolp) (backward-char))
+ (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
+ (not (looking-at org-match-substring-regexp))))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 5)
+ (match-beginning 3)))
+ (contents-end (or (match-end 5) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-superscript-interpreter (superscript contents)
+ "Interpret SUPERSCRIPT object as Org syntax.
+CONTENTS is the contents of the object."
+ (format
+ (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
+ contents))
+
+
+;;;; Table Cell
+
+(defun org-element-table-cell-parser ()
+ "Parse table cell at point.
+
+Return a list whose CAR is `table-cell' and CDR is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end'
+and `:post-blank' keywords."
+ (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
+ (let* ((begin (match-beginning 0))
+ (end (match-end 0))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1)))
+ (list 'table-cell
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank 0))))
+
+(defun org-element-table-cell-interpreter (table-cell contents)
+ "Interpret TABLE-CELL element as Org syntax.
+CONTENTS is the contents of the cell, or nil."
+ (concat " " contents " |"))
+
+(defun org-element-table-cell-successor (limit)
+ "Search for the next table-cell object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `table-cell' and CDR is
+beginning position."
+ (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
+
+
+;;;; Target
+
+(defun org-element-target-parser ()
+ "Parse target at point.
+
+Return a list whose CAR is `target' and CDR a plist with
+`:begin', `:end', `:value' and `:post-blank' as keywords.
+
+Assume point is at the target."
+ (save-excursion
+ (looking-at org-target-regexp)
+ (let ((begin (point))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))
+
+(defun org-element-target-interpreter (target contents)
+ "Interpret TARGET object as Org syntax.
+CONTENTS is nil."
+ (format "<<%s>>" (org-element-property :value target)))
+
+(defun org-element-target-successor (limit)
+ "Search for the next target object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `target' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward org-target-regexp limit t)
+ (cons 'target (match-beginning 0)))))
+
+
+;;;; Timestamp
+
+(defun org-element-timestamp-parser ()
+ "Parse time stamp at point.
+
+Return a list whose CAR is `timestamp', and CDR a plist with
+`:type', `:begin', `:end', `:value' and `:post-blank' keywords.
+
+Assume point is at the beginning of the timestamp."
+ (save-excursion
+ (let* ((begin (point))
+ (activep (eq (char-after) ?<))
+ (main-value
+ (progn
+ (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
+ (match-string-no-properties 1)))
+ (range-end (match-string-no-properties 3))
+ (type (cond ((match-string 2) 'diary)
+ ((and activep range-end) 'active-range)
+ (activep 'active)
+ (range-end 'inactive-range)
+ (t 'inactive)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'timestamp
+ (list :type type
+ :value main-value
+ :range-end range-end
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-timestamp-interpreter (timestamp contents)
+ "Interpret TIMESTAMP object as Org syntax.
+CONTENTS is nil."
+ (let ((type (org-element-property :type timestamp) ))
+ (concat
+ (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
+ (org-element-property :value timestamp))
+ (let ((range-end (org-element-property :range-end timestamp)))
+ (when range-end
+ (concat "--"
+ (format (if (eq type 'inactive-range) "[%s]" "<%s>")
+ range-end)))))))
+
+(defun org-element-timestamp-successor (limit)
+ "Search for the next timestamp object.
+
+LIMIT bounds the search.
+
+Return value is a cons cell whose CAR is `timestamp' and CDR is
+beginning position."
+ (save-excursion
+ (when (re-search-forward
+ (concat org-ts-regexp-both
+ "\\|"
+ "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|"
+ "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ limit t)
+ (cons 'timestamp (match-beginning 0)))))
+
+
+;;;; Underline
+
+(defun org-element-underline-parser ()
+ "Parse underline object at point.
+
+Return a list whose CAR is `underline' and CDR is a plist with
+`:begin', `:end', `:contents-begin' and `:contents-end' and
+`:post-blank' keywords.
+
+Assume point is at the first underscore marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'underline
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank)))))
+
+(defun org-element-underline-interpreter (underline contents)
+ "Interpret UNDERLINE object as Org syntax.
+CONTENTS is the contents of the object."
+ (format "_%s_" contents))
+
+
+;;;; Verbatim
+
+(defun org-element-verbatim-parser ()
+ "Parse verbatim object at point.
+
+Return a list whose CAR is `verbatim' and CDR is a plist with
+`:value', `:begin', `:end' and `:post-blank' keywords.
+
+Assume point is at the first equal sign marker."
+ (save-excursion
+ (unless (bolp) (backward-char 1))
+ (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'verbatim
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))
+
+(defun org-element-verbatim-interpreter (verbatim contents)
+ "Interpret VERBATIM object as Org syntax.
+CONTENTS is nil."
+ (format "=%s=" (org-element-property :value verbatim)))
+
+
+
+;;; Parsing Element Starting At Point
+;;
+;; `org-element--current-element' is the core function of this section.
+;; It returns the Lisp representation of the element starting at
+;; point.
+;;
+;; `org-element--current-element' makes use of special modes. They
+;; are activated for fixed element chaining (i.e. `plain-list' >
+;; `item') or fixed conditional element chaining (i.e. `headline' >
+;; `section'). Special modes are: `first-section', `section',
+;; `quote-section', `item' and `table-row'.
+
+(defun org-element--current-element
+ (limit &optional granularity special structure)
+ "Parse the element starting at point.
+
+LIMIT bounds the search.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+
+Optional argument GRANULARITY determines the depth of the
+recursion. Allowed values are `headline', `greater-element',
+`element', `object' or nil. When it is broader than `object' (or
+nil), secondary values will not be parsed, since they only
+contain objects.
+
+Optional argument SPECIAL, when non-nil, can be either
+`first-section', `section', `quote-section', `table-row' and
+`item'.
+
+If STRUCTURE isn't provided but SPECIAL is set to `item', it will
+be computed.
+
+This function assumes point is always at the beginning of the
+element it has to parse."
+ (save-excursion
+ ;; If point is at an affiliated keyword, try moving to the
+ ;; beginning of the associated element. If none is found, the
+ ;; keyword is orphaned and will be treated as plain text.
+ (when (looking-at org-element--affiliated-re)
+ (let ((opoint (point)))
+ (while (looking-at org-element--affiliated-re) (forward-line))
+ (when (looking-at "[ \t]*$") (goto-char opoint))))
+ (let ((case-fold-search t)
+ ;; Determine if parsing depth allows for secondary strings
+ ;; parsing. It only applies to elements referenced in
+ ;; `org-element-secondary-value-alist'.
+ (raw-secondary-p (and granularity (not (eq granularity 'object)))))
+ (cond
+ ;; Item.
+ ((eq special 'item)
+ (org-element-item-parser limit structure raw-secondary-p))
+ ;; Table Row.
+ ((eq special 'table-row) (org-element-table-row-parser limit))
+ ;; Headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((eq special 'section) (org-element-section-parser limit))
+ ((eq special 'quote-section) (org-element-quote-section-parser limit))
+ ((eq special 'first-section)
+ (org-element-section-parser
+ (or (save-excursion (org-with-limited-levels (outline-next-heading)))
+ limit)))
+ ;; When not at bol, point is at the beginning of an item or
+ ;; a footnote definition: next item is always a paragraph.
+ ((not (bolp)) (org-element-paragraph-parser limit))
+ ;; Planning and Clock.
+ ((and (looking-at org-planning-or-clock-line-re))
+ (if (equal (match-string 1) org-clock-string)
+ (org-element-clock-parser limit)
+ (org-element-planning-parser limit)))
+ ;; Inlinetask.
+ ((org-at-heading-p)
+ (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; LaTeX Environment.
+ ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
+ (if (save-excursion
+ (re-search-forward
+ (format "[ \t]*\\\\end{%s}[ \t]*"
+ (regexp-quote (match-string 1)))
+ nil t))
+ (org-element-latex-environment-parser limit)
+ (org-element-paragraph-parser limit)))
+ ;; Drawer and Property Drawer.
+ ((looking-at org-drawer-regexp)
+ (let ((name (match-string 1)))
+ (cond
+ ((not (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
+ (org-element-paragraph-parser limit))
+ ((equal "PROPERTIES" name)
+ (org-element-property-drawer-parser limit))
+ (t (org-element-drawer-parser limit)))))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#")
+ (goto-char (match-end 0))
+ (cond ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (let ((parser (assoc (upcase (match-string 1))
+ org-element-block-name-alist)))
+ (if parser (funcall (cdr parser) limit)
+ (org-element-special-block-parser limit))))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit))
+ ;; Table.
+ ((org-at-table-p t) (org-element-table-parser limit))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser limit (or structure (org-list-struct))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit))))))
+
+
+;; Most elements can have affiliated keywords. When looking for an
+;; element beginning, we want to move before them, as they belong to
+;; that element, and, in the meantime, collect information they give
+;; into appropriate properties. Hence the following function.
+;;
+;; Usage of optional arguments may not be obvious at first glance:
+;;
+;; - TRANS-LIST is used to polish keywords names that have evolved
+;; during Org history. In example, even though =result= and
+;; =results= coexist, we want to have them under the same =result=
+;; property. It's also true for "srcname" and "name", where the
+;; latter seems to be preferred nowadays (thus the "name" property).
+;;
+;; - CONSED allows to regroup multi-lines keywords under the same
+;; property, while preserving their own identity. This is mostly
+;; used for "attr_latex" and al.
+;;
+;; - PARSED prepares a keyword value for export. This is useful for
+;; "caption". Objects restrictions for such keywords are defined in
+;; `org-element-object-restrictions'.
+;;
+;; - DUALS is used to take care of keywords accepting a main and an
+;; optional secondary values. For example "results" has its
+;; source's name as the main value, and may have an hash string in
+;; optional square brackets as the secondary one.
+;;
+;; A keyword may belong to more than one category.
+
+(defun org-element--collect-affiliated-keywords
+ (&optional key-re trans-list consed parsed duals)
+ "Collect affiliated keywords before point.
+
+Optional argument KEY-RE is a regexp matching keywords, which
+puts matched keyword in group 1. It defaults to
+`org-element--affiliated-re'.
+
+TRANS-LIST is an alist where key is the keyword and value the
+property name it should be translated to, without the colons. It
+defaults to `org-element-keyword-translation-alist'.
+
+CONSED is a list of strings. Any keyword belonging to that list
+will have its value consed. The check is done after keyword
+translation. It defaults to `org-element-multiple-keywords'.
+
+PARSED is a list of strings. Any keyword member of this list
+will have its value parsed. The check is done after keyword
+translation. If a keyword is a member of both CONSED and PARSED,
+it's value will be a list of parsed strings. It defaults to
+`org-element-parsed-keywords'.
+
+DUALS is a list of strings. Any keyword member of this list can
+have two parts: one mandatory and one optional. Its value is
+a cons cell whose CAR is the former, and the CDR the latter. If
+a keyword is a member of both PARSED and DUALS, both values will
+be parsed. It defaults to `org-element-dual-keywords'.
+
+Return a list whose CAR is the position at the first of them and
+CDR a plist of keywords and values."
+ (save-excursion
+ (let ((case-fold-search t)
+ (key-re (or key-re org-element--affiliated-re))
+ (trans-list (or trans-list org-element-keyword-translation-alist))
+ (consed (or consed org-element-multiple-keywords))
+ (parsed (or parsed org-element-parsed-keywords))
+ (duals (or duals org-element-dual-keywords))
+ ;; RESTRICT is the list of objects allowed in parsed
+ ;; keywords value.
+ (restrict (org-element-restriction 'keyword))
+ output)
+ (unless (bobp)
+ (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
+ (let* ((raw-kwd (upcase (match-string 1)))
+ ;; Apply translation to RAW-KWD. From there, KWD is
+ ;; the official keyword.
+ (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
+ ;; Find main value for any keyword.
+ (value
+ (save-match-data
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))))
+ ;; If KWD is a dual keyword, find its secondary
+ ;; value. Maybe parse it.
+ (dual-value
+ (and (member kwd duals)
+ (let ((sec (org-match-string-no-properties 2)))
+ (if (or (not sec) (not (member kwd parsed))) sec
+ (org-element-parse-secondary-string sec restrict)))))
+ ;; Attribute a property name to KWD.
+ (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
+ ;; Now set final shape for VALUE.
+ (when (member kwd parsed)
+ (setq value (org-element-parse-secondary-string value restrict)))
+ (when (member kwd duals)
+ ;; VALUE is mandatory. Set it to nil if there is none.
+ (setq value (and value (cons value dual-value))))
+ ;; Attributes are always consed.
+ (when (or (member kwd consed) (string-match "^ATTR_" kwd))
+ (setq value (cons value (plist-get output kwd-sym))))
+ ;; Eventually store the new value in OUTPUT.
+ (setq output (plist-put output kwd-sym value))))
+ (unless (looking-at key-re) (forward-line 1)))
+ (list (point) output))))
+
+
+
+;;; The Org Parser
+;;
+;; The two major functions here are `org-element-parse-buffer', which
+;; parses Org syntax inside the current buffer, taking into account
+;; region, narrowing, or even visibility if specified, and
+;; `org-element-parse-secondary-string', which parses objects within
+;; a given string.
+;;
+;; The (almost) almighty `org-element-map' allows to apply a function
+;; on elements or objects matching some type, and accumulate the
+;; resulting values. In an export situation, it also skips unneeded
+;; parts of the parse tree.
+
+(defun org-element-parse-buffer (&optional granularity visible-only)
+ "Recursively parse the buffer and return structure.
+If narrowing is in effect, only parse the visible part of the
+buffer.
+
+Optional argument GRANULARITY determines the depth of the
+recursion. It can be set to the following symbols:
+
+`headline' Only parse headlines.
+`greater-element' Don't recurse into greater elements excepted
+ headlines and sections. Thus, elements
+ parsed are the top-level ones.
+`element' Parse everything but objects and plain text.
+`object' Parse the complete buffer (default).
+
+When VISIBLE-ONLY is non-nil, don't parse contents of hidden
+elements.
+
+Assume buffer is in Org mode."
+ (save-excursion
+ (goto-char (point-min))
+ (org-skip-whitespace)
+ (org-element--parse-elements
+ (point-at-bol) (point-max)
+ ;; Start in `first-section' mode so text before the first
+ ;; headline belongs to a section.
+ 'first-section nil granularity visible-only (list 'org-data nil))))
+
+(defun org-element-parse-secondary-string (string restriction &optional parent)
+ "Recursively parse objects in STRING and return structure.
+
+RESTRICTION is a symbol limiting the object types that will be
+looked after.
+
+Optional argument PARENT, when non-nil, is the element or object
+containing the secondary string. It is used to set correctly
+`:parent' property within the string."
+ (with-temp-buffer
+ (insert string)
+ (let ((secondary (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (mapc (lambda (obj) (org-element-put-property obj :parent parent))
+ secondary))))
+
+(defun org-element-map (data types fun &optional info first-match no-recursion)
+ "Map a function on selected elements or objects.
+
+DATA is the parsed tree, as returned by, i.e,
+`org-element-parse-buffer'. TYPES is a symbol or list of symbols
+of elements or objects types. FUN is the function called on the
+matching element or object. It must accept one arguments: the
+element or object itself.
+
+When optional argument INFO is non-nil, it should be a plist
+holding export options. In that case, parts of the parse tree
+not exportable according to that property list will be skipped.
+
+When optional argument FIRST-MATCH is non-nil, stop at the first
+match for which FUN doesn't return nil, and return that value.
+
+Optional argument NO-RECURSION is a symbol or a list of symbols
+representing elements or objects types. `org-element-map' won't
+enter any recursive element or object whose type belongs to that
+list. Though, FUN can still be applied on them.
+
+Nil values returned from FUN do not appear in the results."
+ ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
+ (unless (listp types) (setq types (list types)))
+ (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
+ ;; Recursion depth is determined by --CATEGORY.
+ (let* ((--category
+ (catch 'found
+ (let ((category 'greater-elements))
+ (mapc (lambda (type)
+ (cond ((or (memq type org-element-all-objects)
+ (eq type 'plain-text))
+ ;; If one object is found, the function
+ ;; has to recurse into every object.
+ (throw 'found 'objects))
+ ((not (memq type org-element-greater-elements))
+ ;; If one regular element is found, the
+ ;; function has to recurse, at least,
+ ;; into every element it encounters.
+ (and (not (eq category 'elements))
+ (setq category 'elements)))))
+ types)
+ category)))
+ --acc
+ --walk-tree
+ (--walk-tree
+ (function
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data)))
+ (cond
+ ((not --data))
+ ;; Ignored element in an export context.
+ ((and info (memq --data (plist-get info :ignore-list))))
+ ;; Secondary string: only objects can be found there.
+ ((not --type)
+ (when (eq --category 'objects) (mapc --walk-tree --data)))
+ ;; Unconditionally enter parse trees.
+ ((eq --type 'org-data)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (when (memq --type types)
+ (let ((result (funcall fun --data)))
+ (cond ((not result))
+ (first-match (throw '--map-first-match result))
+ (t (push result --acc)))))
+ ;; If --DATA has a secondary string that can contain
+ ;; objects with their type among TYPES, look into it.
+ (when (eq --category 'objects)
+ (let ((sec-prop
+ (assq --type org-element-secondary-value-alist)))
+ (when sec-prop
+ (funcall --walk-tree
+ (org-element-property (cdr sec-prop) --data)))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; --DATA has no contents.
+ ((not (org-element-contents --data)))
+ ;; Looking for greater elements but --DATA is simply
+ ;; an element or an object.
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements))))
+ ;; Looking for elements but --DATA is an object.
+ ((and (eq --category 'elements)
+ (memq --type org-element-all-objects)))
+ ;; In any other case, map contents.
+ (t (mapc --walk-tree (org-element-contents --data)))))))))))
+ (catch '--map-first-match
+ (funcall --walk-tree data)
+ ;; Return value in a proper order.
+ (nreverse --acc))))
+
+;; The following functions are internal parts of the parser.
+;;
+;; The first one, `org-element--parse-elements' acts at the element's
+;; level.
+;;
+;; The second one, `org-element--parse-objects' applies on all objects
+;; of a paragraph or a secondary string. It uses
+;; `org-element--get-next-object-candidates' to optimize the search of
+;; the next object in the buffer.
+;;
+;; More precisely, that function looks for every allowed object type
+;; first. Then, it discards failed searches, keeps further matches,
+;; and searches again types matched behind point, for subsequent
+;; calls. Thus, searching for a given type fails only once, and every
+;; object is searched only once at top level (but sometimes more for
+;; nested types).
+
+(defun org-element--parse-elements
+ (beg end special structure granularity visible-only acc)
+ "Parse elements between BEG and END positions.
+
+SPECIAL prioritize some elements over the others. It can be set
+to `first-section', `quote-section', `section' `item' or
+`table-row'.
+
+When value is `item', STRUCTURE will be used as the current list
+structure.
+
+GRANULARITY determines the depth of the recursion. See
+`org-element-parse-buffer' for more information.
+
+When VISIBLE-ONLY is non-nil, don't parse contents of hidden
+elements.
+
+Elements are accumulated into ACC."
+ (save-excursion
+ (goto-char beg)
+ ;; When parsing only headlines, skip any text before first one.
+ (when (and (eq granularity 'headline) (not (org-at-heading-p)))
+ (org-with-limited-levels (outline-next-heading)))
+ ;; Main loop start.
+ (while (< (point) end)
+ ;; Find current element's type and parse it accordingly to
+ ;; its category.
+ (let* ((element (org-element--current-element
+ end granularity special structure))
+ (type (org-element-type element))
+ (cbeg (org-element-property :contents-begin element)))
+ (goto-char (org-element-property :end element))
+ ;; Fill ELEMENT contents by side-effect.
+ (cond
+ ;; If VISIBLE-ONLY is true and element is hidden or if it has
+ ;; no contents, don't modify it.
+ ((or (and visible-only (org-element-property :hiddenp element))
+ (not cbeg)))
+ ;; Greater element: parse it between `contents-begin' and
+ ;; `contents-end'. Make sure GRANULARITY allows the
+ ;; recursion, or ELEMENT is an headline, in which case going
+ ;; inside is mandatory, in order to get sub-level headings.
+ ((and (memq type org-element-greater-elements)
+ (or (memq granularity '(element object nil))
+ (and (eq granularity 'greater-element)
+ (eq type 'section))
+ (eq type 'headline)))
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end element)
+ ;; Possibly switch to a special mode.
+ (case type
+ (headline
+ (if (org-element-property :quotedp element) 'quote-section
+ 'section))
+ (plain-list 'item)
+ (table 'table-row))
+ (org-element-property :structure element)
+ granularity visible-only element))
+ ;; ELEMENT has contents. Parse objects inside, if
+ ;; GRANULARITY allows it.
+ ((memq granularity '(object nil))
+ (org-element--parse-objects
+ cbeg (org-element-property :contents-end element) element
+ (org-element-restriction type))))
+ (org-element-adopt-elements acc element)))
+ ;; Return result.
+ acc))
+
+(defun org-element--parse-objects (beg end acc restriction)
+ "Parse objects between BEG and END and return recursive structure.
+
+Objects are accumulated in ACC.
+
+RESTRICTION is a list of object types which are allowed in the
+current object."
+ (let (candidates)
+ (save-excursion
+ (goto-char beg)
+ (while (and (< (point) end)
+ (setq candidates (org-element--get-next-object-candidates
+ end restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
+ (save-restriction
+ (narrow-to-region
+ cont-beg
+ (org-element-property :contents-end next-object))
+ (org-element--parse-objects
+ (point-min) (point-max) next-object
+ (org-element-restriction next-object))))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (= (point) end)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc)))
+
+(defun org-element--get-next-object-candidates (limit restriction objects)
+ "Return an alist of candidates for the next object.
+
+LIMIT bounds the search, and RESTRICTION narrows candidates to
+some object types.
+
+Return value is an alist whose CAR is position and CDR the object
+type, as a symbol.
+
+OBJECTS is the previous candidates alist."
+ (let (next-candidates types-to-search)
+ ;; If no previous result, search every object type in RESTRICTION.
+ ;; Otherwise, keep potential candidates (old objects located after
+ ;; point) and ask to search again those which had matched before.
+ (if (not objects) (setq types-to-search restriction)
+ (mapc (lambda (obj)
+ (if (< (cdr obj) (point)) (push (car obj) types-to-search)
+ (push obj next-candidates)))
+ objects))
+ ;; Call the appropriate successor function for each type to search
+ ;; and accumulate matches.
+ (mapc
+ (lambda (type)
+ (let* ((successor-fun
+ (intern
+ (format "org-element-%s-successor"
+ (or (cdr (assq type org-element-object-successor-alist))
+ type))))
+ (obj (funcall successor-fun limit)))
+ (and obj (push obj next-candidates))))
+ types-to-search)
+ ;; Return alist.
+ next-candidates))
+
+
+
+;;; Towards A Bijective Process
+;;
+;; The parse tree obtained with `org-element-parse-buffer' is really
+;; a snapshot of the corresponding Org buffer. Therefore, it can be
+;; interpreted and expanded into a string with canonical Org syntax.
+;; Hence `org-element-interpret-data'.
+;;
+;; The function relies internally on
+;; `org-element--interpret-affiliated-keywords'.
+
+;;;###autoload
+(defun org-element-interpret-data (data &optional parent)
+ "Interpret DATA as Org syntax.
+
+DATA is a parse tree, an element, an object or a secondary string
+to interpret.
+
+Optional argument PARENT is used for recursive calls. It contains
+the element or object containing data, or nil.
+
+Return Org syntax as a string."
+ (let* ((type (org-element-type data))
+ (results
+ (cond
+ ;; Secondary string.
+ ((not type)
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj parent))
+ data ""))
+ ;; Full Org document.
+ ((eq type 'org-data)
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj parent))
+ (org-element-contents data) ""))
+ ;; Plain text.
+ ((stringp data) data)
+ ;; Element/Object without contents.
+ ((not (org-element-contents data))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ data nil))
+ ;; Element/Object with contents.
+ (t
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (obj) (org-element-interpret-data obj data))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing objects must
+ ;; have their indentation normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph of an
+ ;; item or a footnote-definition, ignore
+ ;; first line's indentation.
+ (and (eq type 'paragraph)
+ (equal data (car (org-element-contents parent)))
+ (memq (org-element-type parent)
+ '(footnote-definiton item))))))
+ "")))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ data
+ (if greaterp (org-element-normalize-contents contents)
+ contents)))))))
+ (if (memq type '(org-data plain-text nil)) results
+ ;; Build white spaces. If no `:post-blank' property is
+ ;; specified, assume its value is 0.
+ (let ((post-blank (or (org-element-property :post-blank data) 0)))
+ (if (memq type org-element-all-objects)
+ (concat results (make-string post-blank 32))
+ (concat
+ (org-element--interpret-affiliated-keywords data)
+ (org-element-normalize-string results)
+ (make-string post-blank 10)))))))
+
+(defun org-element--interpret-affiliated-keywords (element)
+ "Return ELEMENT's affiliated keywords as Org syntax.
+If there is no affiliated keyword, return the empty string."
+ (let ((keyword-to-org
+ (function
+ (lambda (key value)
+ (let (dual)
+ (when (member key org-element-dual-keywords)
+ (setq dual (cdr value) value (car value)))
+ (concat "#+" key
+ (and dual
+ (format "[%s]" (org-element-interpret-data dual)))
+ ": "
+ (if (member key org-element-parsed-keywords)
+ (org-element-interpret-data value)
+ value)
+ "\n"))))))
+ (mapconcat
+ (lambda (prop)
+ (let ((value (org-element-property prop element))
+ (keyword (upcase (substring (symbol-name prop) 1))))
+ (when value
+ (if (or (member keyword org-element-multiple-keywords)
+ ;; All attribute keywords can have multiple lines.
+ (string-match "^ATTR_" keyword))
+ (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
+ value
+ "")
+ (funcall keyword-to-org keyword value)))))
+ ;; List all ELEMENT's properties matching an attribute line or an
+ ;; affiliated keyword, but ignore translated keywords since they
+ ;; cannot belong to the property list.
+ (loop for prop in (nth 1 element) by 'cddr
+ when (let ((keyword (upcase (substring (symbol-name prop) 1))))
+ (or (string-match "^ATTR_" keyword)
+ (and
+ (member keyword org-element-affiliated-keywords)
+ (not (assoc keyword
+ org-element-keyword-translation-alist)))))
+ collect prop)
+ "")))
+
+;; Because interpretation of the parse tree must return the same
+;; number of blank lines between elements and the same number of white
+;; space after objects, some special care must be given to white
+;; spaces.
+;;
+;; The first function, `org-element-normalize-string', ensures any
+;; string different from the empty string will end with a single
+;; newline character.
+;;
+;; The second function, `org-element-normalize-contents', removes
+;; global indentation from the contents of the current element.
+
+(defun org-element-normalize-string (s)
+ "Ensure string S ends with a single newline character.
+
+If S isn't a string return it unchanged. If S is the empty
+string, return it. Otherwise, return a new string with a single
+newline character at its end."
+ (cond
+ ((not (stringp s)) s)
+ ((string= "" s) "")
+ (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
+ (replace-match "\n" nil nil s)))))
+
+(defun org-element-normalize-contents (element &optional ignore-first)
+ "Normalize plain text in ELEMENT's contents.
+
+ELEMENT must only contain plain text and objects.
+
+If optional argument IGNORE-FIRST is non-nil, ignore first line's
+indentation to compute maximal common indentation.
+
+Return the normalized element that is element with global
+indentation removed from its contents. The function assumes that
+indentation is not done with TAB characters."
+ (let* (ind-list ; for byte-compiler
+ collect-inds ; for byte-compiler
+ (collect-inds
+ (function
+ ;; Return list of indentations within BLOB. This is done by
+ ;; walking recursively BLOB and updating IND-LIST along the
+ ;; way. FIRST-FLAG is non-nil when the first string hasn't
+ ;; been seen yet. It is required as this string is the only
+ ;; one whose indentation doesn't happen after a newline
+ ;; character.
+ (lambda (blob first-flag)
+ (mapc
+ (lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (string-match "\\`\\( *\\)" object)
+ (let ((len (length (match-string 1 object))))
+ ;; An indentation of zero means no string will be
+ ;; modified. Quit the process.
+ (if (zerop len) (throw 'zero (setq ind-list nil))
+ (push len ind-list))))
+ (cond
+ ((stringp object)
+ (let ((start 0))
+ ;; Avoid matching blank or empty lines.
+ (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
+ (not (equal (match-string 2 object) " ")))
+ (setq start (match-end 0))
+ (push (length (match-string 1 object)) ind-list))))
+ ((memq (org-element-type object) org-element-recursive-objects)
+ (funcall collect-inds object first-flag))))
+ (org-element-contents blob))))))
+ ;; Collect indentation list in ELEMENT. Possibly remove first
+ ;; value if IGNORE-FIRST is non-nil.
+ (catch 'zero (funcall collect-inds element (not ignore-first)))
+ (if (not ind-list) element
+ ;; Build ELEMENT back, replacing each string with the same
+ ;; string minus common indentation.
+ (let* (build ; For byte compiler.
+ (build
+ (function
+ (lambda (blob mci first-flag)
+ ;; Return BLOB with all its strings indentation
+ ;; shortened from MCI white spaces. FIRST-FLAG is
+ ;; non-nil when the first string hasn't been seen
+ ;; yet.
+ (setcdr (cdr blob)
+ (mapcar
+ (lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (setq object
+ (replace-regexp-in-string
+ (format "\\` \\{%d\\}" mci) "" object)))
+ (cond
+ ((stringp object)
+ (replace-regexp-in-string
+ (format "\n \\{%d\\}" mci) "\n" object))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object mci first-flag))
+ (t object)))
+ (org-element-contents blob)))
+ blob))))
+ (funcall build element (apply 'min ind-list) (not ignore-first))))))
+
+
+
+;;; The Toolbox
+;;
+;; The first move is to implement a way to obtain the smallest element
+;; containing point. This is the job of `org-element-at-point'. It
+;; basically jumps back to the beginning of section containing point
+;; and moves, element after element, with
+;; `org-element--current-element' until the container is found. Note:
+;; When using `org-element-at-point', secondary values are never
+;; parsed since the function focuses on elements, not on objects.
+;;
+;; At a deeper level, `org-element-context' lists all elements and
+;; objects containing point.
+;;
+;; `org-element-nested-p' and `org-element-swap-A-B' may be used
+;; internally by navigation and manipulation tools.
+
+;;;###autoload
+(defun org-element-at-point (&optional keep-trail)
+ "Determine closest element around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+Properties depend on element or object type, but always
+include :begin, :end, :parent and :post-blank properties.
+
+As a special case, if point is at the very beginning of a list or
+sub-list, returned element will be that list instead of the first
+item. In the same way, if point is at the beginning of the first
+row of a table, returned element will be the table instead of the
+first row.
+
+If optional argument KEEP-TRAIL is non-nil, the function returns
+a list of of elements leading to element at point. The list's
+CAR is always the element at point. Following positions contain
+element's siblings, then parents, siblings of parents, until the
+first element of current section."
+ (org-with-wide-buffer
+ ;; If at an headline, parse it. It is the sole element that
+ ;; doesn't require to know about context. Be sure to disallow
+ ;; secondary string parsing, though.
+ (if (org-with-limited-levels (org-at-heading-p))
+ (progn
+ (beginning-of-line)
+ (if (not keep-trail) (org-element-headline-parser (point-max) t)
+ (list (org-element-headline-parser (point-max) t))))
+ ;; Otherwise move at the beginning of the section containing
+ ;; point.
+ (let ((origin (point))
+ (end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct prevs parent)
+ (org-with-limited-levels
+ (if (org-with-limited-levels (org-before-first-heading-p))
+ (goto-char (point-min))
+ (org-back-to-heading)
+ (forward-line)))
+ (org-skip-whitespace)
+ (beginning-of-line)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (catch 'exit
+ (while t
+ (setq element
+ (org-element--current-element end 'element special-flag struct)
+ type (car element))
+ (org-element-put-property element :parent parent)
+ (when keep-trail (push element trail))
+ (cond
+ ;; 1. Skip any element ending before point. Also skip
+ ;; element ending at point when we're sure that another
+ ;; element has started.
+ ((let ((elem-end (org-element-property :end element)))
+ (when (or (< elem-end origin)
+ (and (= elem-end origin) (/= elem-end end)))
+ (goto-char elem-end))))
+ ;; 2. An element containing point is always the element at
+ ;; point.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if keep-trail trail element)))
+ ;; 3. At any other greater element type, if point is
+ ;; within contents, move into it.
+ (t
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
+ ;; Create an anchor for tables and plain lists:
+ ;; when point is at the very beginning of these
+ ;; elements, ignoring affiliated keywords,
+ ;; target them instead of their contents.
+ (and (= cbeg origin) (memq type '(plain-list table)))
+ ;; When point is at contents end, do not move
+ ;; into elements with an explicit ending, but
+ ;; return that element instead.
+ (and (= cend origin)
+ (memq type
+ '(center-block
+ drawer dynamic-block inlinetask item
+ plain-list quote-block special-block))))
+ (throw 'exit (if keep-trail trail element))
+ (setq parent element)
+ (case type
+ (plain-list
+ (setq special-flag 'item
+ struct (org-element-property :structure element)))
+ (table (setq special-flag 'table-row))
+ (otherwise (setq special-flag nil)))
+ (setq end cend)
+ (goto-char cbeg)))))))))))
+
+;;;###autoload
+(defun org-element-context ()
+ "Return closest element or object around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element or object and PROPS a plist of properties
+associated to it.
+
+Possible types are defined in `org-element-all-elements' and
+`org-element-all-objects'. Properties depend on element or
+object type, but always include :begin, :end, :parent
+and :post-blank properties."
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (org-element-at-point))
+ (type (car element))
+ end)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, move to beginning of the
+ ;; element or secondary string and set END to the other side.
+ (if (not (or (and (eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (and tag
+ (progn
+ (beginning-of-line)
+ (search-forward tag (point-at-eol))
+ (goto-char (match-beginning 0))
+ (and (>= origin (point))
+ (<= origin
+ ;; `1+' is required so some
+ ;; successors can match
+ ;; properly their object.
+ (setq end (1+ (match-end 0)))))))))
+ (and (memq type '(headline inlinetask))
+ (progn (beginning-of-line)
+ (skip-chars-forward "* ")
+ (setq end (point-at-eol))))
+ (and (memq type '(paragraph table-cell verse-block))
+ (let ((cbeg (org-element-property
+ :contents-begin element))
+ (cend (org-element-property
+ :contents-end element)))
+ (and (>= origin cbeg)
+ (<= origin cend)
+ (progn (goto-char cbeg) (setq end cend)))))))
+ element
+ (let ((restriction (org-element-restriction element))
+ (parent element)
+ candidates)
+ (catch 'exit
+ (while (setq candidates (org-element--get-next-object-candidates
+ end restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit element)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((< (org-element-property :end object) origin)
+ (goto-char (org-element-property :end object)))
+ ;; ORIGIN is within a non-recursive object or at an
+ ;; object boundaries: Return that object.
+ ((or (not cbeg) (> cbeg origin) (< cend origin))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and restrict
+ ;; search to the end of its contents.
+ (t (goto-char cbeg)
+ (org-element-put-property object :parent parent)
+ (setq parent object end cend)))))))
+ parent))))))
+
+(defsubst org-element-nested-p (elem-A elem-B)
+ "Non-nil when elements ELEM-A and ELEM-B are nested."
+ (let ((beg-A (org-element-property :begin elem-A))
+ (beg-B (org-element-property :begin elem-B))
+ (end-A (org-element-property :end elem-A))
+ (end-B (org-element-property :end elem-B)))
+ (or (and (>= beg-A beg-B) (<= end-A end-B))
+ (and (>= beg-B beg-A) (<= end-B end-A)))))
+
+(defun org-element-swap-A-B (elem-A elem-B)
+ "Swap elements ELEM-A and ELEM-B.
+Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
+end of ELEM-A."
+ (goto-char (org-element-property :begin elem-A))
+ ;; There are two special cases when an element doesn't start at bol:
+ ;; the first paragraph in an item or in a footnote definition.
+ (let ((specialp (not (bolp))))
+ ;; Only a paragraph without any affiliated keyword can be moved at
+ ;; ELEM-A position in such a situation. Note that the case of
+ ;; a footnote definition is impossible: it cannot contain two
+ ;; paragraphs in a row because it cannot contain a blank line.
+ (if (and specialp
+ (or (not (eq (org-element-type elem-B) 'paragraph))
+ (/= (org-element-property :begin elem-B)
+ (org-element-property :contents-begin elem-B))))
+ (error "Cannot swap elements"))
+ ;; In a special situation, ELEM-A will have no indentation. We'll
+ ;; give it ELEM-B's (which will in, in turn, have no indentation).
+ (let* ((ind-B (when specialp
+ (goto-char (org-element-property :begin elem-B))
+ (org-get-indentation)))
+ (beg-A (org-element-property :begin elem-A))
+ (end-A (save-excursion
+ (goto-char (org-element-property :end elem-A))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ (beg-B (org-element-property :begin elem-B))
+ (end-B (save-excursion
+ (goto-char (org-element-property :end elem-B))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ ;; Store overlays responsible for visibility status. We
+ ;; also need to store their boundaries as they will be
+ ;; removed from buffer.
+ (overlays
+ (cons
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-A end-A))
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-B end-B))))
+ ;; Get contents.
+ (body-A (buffer-substring beg-A end-A))
+ (body-B (delete-and-extract-region beg-B end-B)))
+ (goto-char beg-B)
+ (when specialp
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+ (org-indent-to-column ind-B))
+ (insert body-A)
+ ;; Restore ex ELEM-A overlays.
+ (let ((offset (- beg-B beg-A)))
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
+ (car overlays))
+ (goto-char beg-A)
+ (delete-region beg-A end-A)
+ (insert body-B)
+ ;; Restore ex ELEM-B overlays.
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
+ (cdr overlays)))
+ (goto-char (org-element-property :end elem-B)))))
+
+
+(provide 'org-element)
+;;; org-element.el ends here
diff --git a/lisp/org-entities.el b/lisp/org-entities.el
new file mode 100644
index 0000000..bd675c3
--- /dev/null
+++ b/lisp/org-entities.el
@@ -0,0 +1,574 @@
+;;; org-entities.el --- Support for special entities in Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>,
+;; Ulf Stegemann <ulf at zeitform dot de>
+;; Keywords: outlines, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-macs)
+
+(declare-function org-table-align "org-table" ())
+
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-entities nil
+ "Options concerning entities in Org-mode."
+ :tag "Org Entities"
+ :group 'org)
+
+(defcustom org-entities-ascii-explanatory nil
+ "Non-nil means replace special entities in ASCII.
+For example, this will replace \"\\nsup\" with \"[not a superset of]\"
+in backends where the corresponding character is not available."
+ :group 'org-entities
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-entities-user nil
+ "User-defined entities used in Org-mode to produce special characters.
+Each entry in this list is a list of strings. It associates the name
+of the entity that can be inserted into an Org file as \\name with the
+appropriate replacements for the different export backends. The order
+of the fields is the following
+
+name As a string, without the leading backslash
+LaTeX replacement In ready LaTeX, no further processing will take place
+LaTeX mathp A Boolean, either t or nil. t if this entity needs
+ to be in math mode.
+HTML replacement In ready HTML, no further processing will take place.
+ Usually this will be an &...; entity.
+ASCII replacement Plain ASCII, no extensions. Symbols that cannot be
+ represented will be left as they are, but see the.
+ variable `org-entities-ascii-explanatory'.
+Latin1 replacement Use the special characters available in latin1.
+utf-8 replacement Use the special characters available in utf-8.
+
+If you define new entities here that require specific LaTeX packages to be
+loaded, add these packages to `org-export-latex-packages-alist'."
+ :group 'org-entities
+ :version "24.1"
+ :type '(repeat
+ (list
+ (string :tag "name ")
+ (string :tag "LaTeX ")
+ (boolean :tag "Require LaTeX math?")
+ (string :tag "HTML ")
+ (string :tag "ASCII ")
+ (string :tag "Latin1")
+ (string :tag "utf-8 "))))
+
+(defconst org-entities
+ '(
+ "* Letters"
+ "** Latin"
+ ("Agrave" "\\`{A}" nil "&Agrave;" "A" "À" "À")
+ ("agrave" "\\`{a}" nil "&agrave;" "a" "à" "à")
+ ("Aacute" "\\'{A}" nil "&Aacute;" "A" "Á" "Á")
+ ("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
+ ("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
+ ("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
+ ("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
+ ("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
+ ("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
+ ("auml" "\\\"{a}" nil "&auml;" "ae" "ä" "ä")
+ ("Aring" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("AA" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("aring" "\\aa{}" nil "&aring;" "a" "å" "å")
+ ("AElig" "\\AE{}" nil "&AElig;" "AE" "Æ" "Æ")
+ ("aelig" "\\ae{}" nil "&aelig;" "ae" "æ" "æ")
+ ("Ccedil" "\\c{C}" nil "&Ccedil;" "C" "Ç" "Ç")
+ ("ccedil" "\\c{c}" nil "&ccedil;" "c" "ç" "ç")
+ ("Egrave" "\\`{E}" nil "&Egrave;" "E" "È" "È")
+ ("egrave" "\\`{e}" nil "&egrave;" "e" "è" "è")
+ ("Eacute" "\\'{E}" nil "&Eacute;" "E" "É" "É")
+ ("eacute" "\\'{e}" nil "&eacute;" "e" "é" "é")
+ ("Ecirc" "\\^{E}" nil "&Ecirc;" "E" "Ê" "Ê")
+ ("ecirc" "\\^{e}" nil "&ecirc;" "e" "ê" "ê")
+ ("Euml" "\\\"{E}" nil "&Euml;" "E" "Ë" "Ë")
+ ("euml" "\\\"{e}" nil "&euml;" "e" "ë" "ë")
+ ("Igrave" "\\`{I}" nil "&Igrave;" "I" "Ì" "Ì")
+ ("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
+ ("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
+ ("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
+ ("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
+ ("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
+ ("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")
+ ("iuml" "\\\"{i}" nil "&iuml;" "i" "ï" "ï")
+ ("Ntilde" "\\~{N}" nil "&Ntilde;" "N" "Ñ" "Ñ")
+ ("ntilde" "\\~{n}" nil "&ntilde;" "n" "ñ" "ñ")
+ ("Ograve" "\\`{O}" nil "&Ograve;" "O" "Ò" "Ò")
+ ("ograve" "\\`{o}" nil "&ograve;" "o" "ò" "ò")
+ ("Oacute" "\\'{O}" nil "&Oacute;" "O" "Ó" "Ó")
+ ("oacute" "\\'{o}" nil "&oacute;" "o" "ó" "ó")
+ ("Ocirc" "\\^{O}" nil "&Ocirc;" "O" "Ô" "Ô")
+ ("ocirc" "\\^{o}" nil "&ocirc;" "o" "ô" "ô")
+ ("Otilde" "\\~{O}" nil "&Otilde;" "O" "Õ" "Õ")
+ ("otilde" "\\~{o}" nil "&otilde;" "o" "õ" "õ")
+ ("Ouml" "\\\"{O}" nil "&Ouml;" "Oe" "Ö" "Ö")
+ ("ouml" "\\\"{o}" nil "&ouml;" "oe" "ö" "ö")
+ ("Oslash" "\\O" nil "&Oslash;" "O" "Ø" "Ø")
+ ("oslash" "\\o{}" nil "&oslash;" "o" "ø" "ø")
+ ("OElig" "\\OE{}" nil "&OElig;" "OE" "OE" "Œ")
+ ("oelig" "\\oe{}" nil "&oelig;" "oe" "oe" "œ")
+ ("Scaron" "\\v{S}" nil "&Scaron;" "S" "S" "Š")
+ ("scaron" "\\v{s}" nil "&scaron;" "s" "s" "š")
+ ("szlig" "\\ss{}" nil "&szlig;" "ss" "ß" "ß")
+ ("Ugrave" "\\`{U}" nil "&Ugrave;" "U" "Ù" "Ù")
+ ("ugrave" "\\`{u}" nil "&ugrave;" "u" "ù" "ù")
+ ("Uacute" "\\'{U}" nil "&Uacute;" "U" "Ú" "Ú")
+ ("uacute" "\\'{u}" nil "&uacute;" "u" "ú" "ú")
+ ("Ucirc" "\\^{U}" nil "&Ucirc;" "U" "Û" "Û")
+ ("ucirc" "\\^{u}" nil "&ucirc;" "u" "û" "û")
+ ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ü" "Ü")
+ ("uuml" "\\\"{u}" nil "&uuml;" "ue" "ü" "ü")
+ ("Yacute" "\\'{Y}" nil "&Yacute;" "Y" "Ý" "Ý")
+ ("yacute" "\\'{y}" nil "&yacute;" "y" "ý" "ý")
+ ("Yuml" "\\\"{Y}" nil "&Yuml;" "Y" "Y" "Ÿ")
+ ("yuml" "\\\"{y}" nil "&yuml;" "y" "ÿ" "ÿ")
+
+ "** Latin (special face)"
+ ("fnof" "\\textit{f}" nil "&fnof;" "f" "f" "ƒ")
+ ("real" "\\Re" t "&real;" "R" "R" "ℜ")
+ ("image" "\\Im" t "&image;" "I" "I" "ℑ")
+ ("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+
+ "** Greek"
+ ("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
+ ("alpha" "\\alpha" t "&alpha;" "alpha" "alpha" "α")
+ ("Beta" "B" nil "&Beta;" "Beta" "Beta" "Β")
+ ("beta" "\\beta" t "&beta;" "beta" "beta" "β")
+ ("Gamma" "\\Gamma" t "&Gamma;" "Gamma" "Gamma" "Γ")
+ ("gamma" "\\gamma" t "&gamma;" "gamma" "gamma" "γ")
+ ("Delta" "\\Delta" t "&Delta;" "Delta" "Gamma" "Δ")
+ ("delta" "\\delta" t "&delta;" "delta" "delta" "δ")
+ ("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
+ ("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
+ ("varepsilon" "\\varepsilon" t "&epsilon;" "varepsilon" "varepsilon" "ε")
+ ("Zeta" "Z" nil "&Zeta;" "Zeta" "Zeta" "Ζ")
+ ("zeta" "\\zeta" t "&zeta;" "zeta" "zeta" "ζ")
+ ("Eta" "H" nil "&Eta;" "Eta" "Eta" "Η")
+ ("eta" "\\eta" t "&eta;" "eta" "eta" "η")
+ ("Theta" "\\Theta" t "&Theta;" "Theta" "Theta" "Θ")
+ ("theta" "\\theta" t "&theta;" "theta" "theta" "θ")
+ ("thetasym" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("vartheta" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("Iota" "I" nil "&Iota;" "Iota" "Iota" "Ι")
+ ("iota" "\\iota" t "&iota;" "iota" "iota" "ι")
+ ("Kappa" "K" nil "&Kappa;" "Kappa" "Kappa" "Κ")
+ ("kappa" "\\kappa" t "&kappa;" "kappa" "kappa" "κ")
+ ("Lambda" "\\Lambda" t "&Lambda;" "Lambda" "Lambda" "Λ")
+ ("lambda" "\\lambda" t "&lambda;" "lambda" "lambda" "λ")
+ ("Mu" "M" nil "&Mu;" "Mu" "Mu" "Μ")
+ ("mu" "\\mu" t "&mu;" "mu" "mu" "μ")
+ ("nu" "\\nu" t "&nu;" "nu" "nu" "ν")
+ ("Nu" "N" nil "&Nu;" "Nu" "Nu" "Ν")
+ ("Xi" "\\Xi" t "&Xi;" "Xi" "Xi" "Ξ")
+ ("xi" "\\xi" t "&xi;" "xi" "xi" "ξ")
+ ("Omicron" "O" nil "&Omicron;" "Omicron" "Omicron" "Ο")
+ ("omicron" "\\textit{o}" nil "&omicron;" "omicron" "omicron" "ο")
+ ("Pi" "\\Pi" t "&Pi;" "Pi" "Pi" "Π")
+ ("pi" "\\pi" t "&pi;" "pi" "pi" "π")
+ ("Rho" "P" nil "&Rho;" "Rho" "Rho" "Ρ")
+ ("rho" "\\rho" t "&rho;" "rho" "rho" "ρ")
+ ("Sigma" "\\Sigma" t "&Sigma;" "Sigma" "Sigma" "Σ")
+ ("sigma" "\\sigma" t "&sigma;" "sigma" "sigma" "σ")
+ ("sigmaf" "\\varsigma" t "&sigmaf;" "sigmaf" "sigmaf" "ς")
+ ("varsigma" "\\varsigma" t "&sigmaf;" "varsigma" "varsigma" "ς")
+ ("Tau" "T" nil "&Tau;" "Tau" "Tau" "Τ")
+ ("Upsilon" "\\Upsilon" t "&Upsilon;" "Upsilon" "Upsilon" "Υ")
+ ("upsih" "\\Upsilon" t "&upsih;" "upsilon" "upsilon" "ϒ")
+ ("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
+ ("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
+ ("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
+ ("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
+ ("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
+ ("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
+ ("Psi" "\\Psi" t "&Psi;" "Psi" "Psi" "Ψ")
+ ("psi" "\\psi" t "&psi;" "psi" "psi" "ψ")
+ ("tau" "\\tau" t "&tau;" "tau" "tau" "τ")
+ ("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
+ ("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
+ ("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
+
+ "** Hebrew"
+ ("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+
+ "** Dead languages"
+ ("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
+ ("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
+ ("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
+ ("thorn" "\\th{}" nil "&thorn;" "th" "þ" "þ")
+
+ "* Punctuation"
+ "** Dots and Marks"
+ ("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
+ ("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
+ ("iquest" "?`" nil "&iquest;" "?" "¿" "¿")
+
+ "** Dash-like"
+ ("shy" "\\-" nil "&shy;" "" "" "")
+ ("ndash" "--" nil "&ndash;" "-" "-" "–")
+ ("mdash" "---" nil "&mdash;" "--" "--" "—")
+
+ "** Quotations"
+ ("quot" "\\textquotedbl{}" nil "&quot;" "\"" "\"" "\"")
+ ("acute" "\\textasciiacute{}" nil "&acute;" "'" "´" "´")
+ ("ldquo" "\\textquotedblleft{}" nil "&ldquo;" "\"" "\"" "“")
+ ("rdquo" "\\textquotedblright{}" nil "&rdquo;" "\"" "\"" "”")
+ ("bdquo" "\\quotedblbase{}" nil "&bdquo;" "\"" "\"" "„")
+ ("lsquo" "\\textquoteleft{}" nil "&lsquo;" "`" "`" "‘")
+ ("rsquo" "\\textquoteright{}" nil "&rsquo;" "'" "'" "’")
+ ("sbquo" "\\quotesinglbase{}" nil "&sbquo;" "," "," "‚")
+ ("laquo" "\\guillemotleft{}" nil "&laquo;" "<<" "«" "«")
+ ("raquo" "\\guillemotright{}" nil "&raquo;" ">>" "»" "»")
+ ("lsaquo" "\\guilsinglleft{}" nil "&lsaquo;" "<" "<" "‹")
+ ("rsaquo" "\\guilsinglright{}" nil "&rsaquo;" ">" ">" "›")
+
+ "* Other"
+ "** Misc. (often used)"
+ ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
+ ("vert" "\\vert{}" t "&#124;" "|" "|" "|")
+ ("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
+ ("amp" "\\&" nil "&amp;" "&" "&" "&")
+ ("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
+ ("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
+ ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ ("slash" "/" nil "/" "/" "/" "/")
+ ("plus" "+" nil "+" "+" "+" "+")
+ ("under" "\\_" nil "_" "_" "_" "_")
+ ("equal" "=" nil "=" "=" "=" "=")
+ ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
+ ("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+
+ "** Whitespace"
+ ("nbsp" "~" nil "&nbsp;" " " " " " ")
+ ("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
+ ("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
+ ("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
+
+ "** Currency"
+ ("curren" "\\textcurrency{}" nil "&curren;" "curr." "¤" "¤")
+ ("cent" "\\textcent{}" nil "&cent;" "cent" "¢" "¢")
+ ("pound" "\\pounds{}" nil "&pound;" "pound" "£" "£")
+ ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
+ ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EUR" "\\EUR{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EURdig" "\\EURdig{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EURhv" "\\EURhv{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EURcr" "\\EURcr{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EURtm" "\\EURtm{}" nil "&euro;" "EUR" "EUR" "€")
+
+ "** Property Marks"
+ ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
+ ("reg" "\\textregistered{}" nil "&reg;" "(r)" "®" "®")
+ ("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
+
+ "** Science et al."
+ ("minus" "\\minus" t "&minus;" "-" "-" "−")
+ ("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
+ ("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
+ ("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
+ ("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
+ ("frac34" "\\textthreequarters{}" nil "&frac34;" "3/4" "¾" "¾")
+ ("permil" "\\textperthousand{}" nil "&permil;" "per thousand" "per thousand" "‰")
+ ("sup1" "\\textonesuperior{}" nil "&sup1;" "^1" "¹" "¹")
+ ("sup2" "\\texttwosuperior{}" nil "&sup2;" "^2" "²" "²")
+ ("sup3" "\\textthreesuperior{}" nil "&sup3;" "^3" "³" "³")
+ ("radic" "\\sqrt{\\,}" t "&radic;" "[square root]" "[square root]" "√")
+ ("sum" "\\sum" t "&sum;" "[sum]" "[sum]" "∑")
+ ("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
+ ("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
+ ("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
+ ("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
+ ("prime" "\\prime" t "&prime;" "'" "'" "′")
+ ("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
+ ("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("proptp" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
+ ("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("vee" "\\vee" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
+ ("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
+ ("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("sim" "\\sim" t "&sim;" "~" "~" "∼")
+ ("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("asymp" "\\asymp" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("approx" "\\approx" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
+ ("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("supset" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("nsub" "\\not\\subset" t "&nsub;" "[not a subset of]" "[not a subset of" "⊄")
+ ("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
+ ("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
+ ("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
+ ("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
+ ("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("notin" "\\notin" t "&notin;" "[not an element of]" "[not an element of]" "∉")
+ ("ni" "\\ni" t "&ni;" "[contains as member]" "[contains as member]" "∋")
+ ("nabla" "\\nabla" t "&nabla;" "[nabla]" "[nabla]" "∇")
+ ("ang" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("angle" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("perp" "\\perp" t "&perp;" "[up tack]" "[up tack]" "⊥")
+ ("sdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("cdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("lceil" "\\lceil" t "&lceil;" "[left ceiling]" "[left ceiling]" "⌈")
+ ("rceil" "\\rceil" t "&rceil;" "[right ceiling]" "[right ceiling]" "⌉")
+ ("lfloor" "\\lfloor" t "&lfloor;" "[left floor]" "[left floor]" "⌊")
+ ("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
+ ("lang" "\\langle" t "&lang;" "<" "<" "⟨")
+ ("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+
+ "** Arrows"
+ ("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("leftarrow" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("gets" "\\gets" t "&larr;" "<-" "<-" "←")
+ ("lArr" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("Leftarrow" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("uarr" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uparrow" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uArr" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("Uparrow" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("rarr" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("to" "\\to" t "&rarr;" "->" "->" "→")
+ ("rightarrow" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("rArr" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("Rightarrow" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("darr" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("downarrow" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("dArr" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("Downarrow" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("harr" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("leftrightarrow" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("hArr" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("Leftrightarrow" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("crarr" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+ ("hookleftarrow" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+
+ "** Function names"
+ ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos")
+ ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin")
+ ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan")
+ ("arg" "\\arg" t "arg" "arg" "arg" "arg")
+ ("cos" "\\cos" t "cos" "cos" "cos" "cos")
+ ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh")
+ ("cot" "\\cot" t "cot" "cot" "cot" "cot")
+ ("coth" "\\coth" t "coth" "coth" "coth" "coth")
+ ("csc" "\\csc" t "csc" "csc" "csc" "csc")
+ ("deg" "\\deg" t "&deg;" "deg" "deg" "deg")
+ ("det" "\\det" t "det" "det" "det" "det")
+ ("dim" "\\dim" t "dim" "dim" "dim" "dim")
+ ("exp" "\\exp" t "exp" "exp" "exp" "exp")
+ ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd")
+ ("hom" "\\hom" t "hom" "hom" "hom" "hom")
+ ("inf" "\\inf" t "inf" "inf" "inf" "inf")
+ ("ker" "\\ker" t "ker" "ker" "ker" "ker")
+ ("lg" "\\lg" t "lg" "lg" "lg" "lg")
+ ("lim" "\\lim" t "lim" "lim" "lim" "lim")
+ ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf")
+ ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup")
+ ("ln" "\\ln" t "ln" "ln" "ln" "ln")
+ ("log" "\\log" t "log" "log" "log" "log")
+ ("max" "\\max" t "max" "max" "max" "max")
+ ("min" "\\min" t "min" "min" "min" "min")
+ ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr")
+ ("sec" "\\sec" t "sec" "sec" "sec" "sec")
+ ("sin" "\\sin" t "sin" "sin" "sin" "sin")
+ ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh")
+ ("sup" "\\sup" t "&sup;" "sup" "sup" "sup")
+ ("tan" "\\tan" t "tan" "tan" "tan" "tan")
+ ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh")
+
+ "** Signs & Symbols"
+ ("bull" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("bullet" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("star" "\\star" t "*" "*" "*" "⋆")
+ ("lowast" "\\ast" t "&lowast;" "*" "*" "∗")
+ ("ast" "\\ast" t "&lowast;" "*" "*" "*")
+ ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
+ ("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
+ ("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
+ ("checkmark" "\\checkmark" t "&#10003;" "[checkmark]" "[checkmark]" "✓")
+
+ "** Miscellaneous (seldom used)"
+ ("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
+ ("ordf" "\\textordfeminine{}" nil "&ordf;" "_a_" "ª" "ª")
+ ("ordm" "\\textordmasculine{}" nil "&ordm;" "_o_" "º" "º")
+ ("cedil" "\\c{}" nil "&cedil;" "[cedilla]" "¸" "¸")
+ ("oline" "\\overline{~}" t "&oline;" "[overline]" "¯" "‾")
+ ("uml" "\\textasciidieresis{}" nil "&uml;" "[diaeresis]" "¨" "¨")
+ ("zwnj" "\\/{}" nil "&zwnj;" "" "" "‌")
+ ("zwj" "" nil "&zwj;" "" "" "‍")
+ ("lrm" "" nil "&lrm;" "" "" "‎")
+ ("rlm" "" nil "&rlm;" "" "" "‏")
+
+ "** Smilies"
+ ("smile" "\\smile" t "&#9786;" ":-)" ":-)" "⌣")
+ ("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
+ ("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
+ ("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
+
+ "** Suits"
+ ("clubs" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("clubsuit" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("spades" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
+ ("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
+ ("Diamond" "\\diamond" t "&diamond;" "[diamond]" "[diamond]" "⋄")
+ ("loz" "\\diamond" t "&loz;" "[lozenge]" "[lozenge]" "◊")
+ )
+ "Default entities used in Org-mode to produce special characters.
+For details see `org-entities-user'.")
+
+(defsubst org-entity-get (name)
+ "Get the proper association for NAME from the entity lists.
+This first checks the user list, then the built-in list."
+ (or (assoc name org-entities-user)
+ (assoc name org-entities)))
+
+(defun org-entity-get-representation (name kind)
+ "Get the correct representation of entity NAME for export type KIND.
+Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
+ (let* ((e (org-entity-get name))
+ (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4)
+ (latin1 . 5) (utf8 . 6)))))
+ (r (and e n (nth n e))))
+ (if (and e r
+ (not org-entities-ascii-explanatory)
+ (memq kind '(ascii latin1 utf8))
+ (= (string-to-char r) ?\[))
+ (concat "\\" name)
+ r)))
+
+(defsubst org-entity-latex-math-p (name)
+ "Does entity NAME require math mode in LaTeX?"
+ (nth 2 (org-entity-get name)))
+
+;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org
+
+(defun org-entities-create-table ()
+ "Create an Org mode table with all entities."
+ (interactive)
+ (let ((pos (point)) e latex mathp html latin utf8 name ascii)
+ (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n")
+ (mapc (lambda (e) (when (listp e)
+ (setq name (car e)
+ latex (nth 1 e)
+ mathp (nth 2 e)
+ html (nth 3 e)
+ ascii (nth 4 e)
+ latin (nth 5 e)
+ utf8 (nth 6 e))
+ (if (equal ascii "|") (setq ascii "\\vert"))
+ (if (equal latin "|") (setq latin "\\vert"))
+ (if (equal utf8 "|") (setq utf8 "\\vert"))
+ (if (equal ascii "=>") (setq ascii "= >"))
+ (if (equal latin "=>") (setq latin "= >"))
+ (insert "|" name
+ "|" (format "=%s=" latex)
+ "|" (format (if mathp "$%s$" "$\\mbox{%s}$")
+ latex)
+ "|" (format "=%s=" html) "|" html
+ "|" ascii "|" latin "|" utf8
+ "|\n")))
+ org-entities)
+ (goto-char pos)
+ (org-table-align)))
+
+(defun org-entities-help ()
+ "Create a Help buffer with all available entities."
+ (interactive)
+ (with-output-to-temp-buffer "*Org Entity Help*"
+ (princ "Org-mode entities\n=================\n\n")
+ (let ((ll (append '("* User-defined additions (variable org-entities-user)")
+ org-entities-user
+ org-entities))
+ e latex mathp html latin utf8 name ascii
+ (lastwasstring t)
+ (head (concat
+ "\n"
+ " Symbol Org entity LaTeX code HTML code\n"
+ " -----------------------------------------------------------\n")))
+ (while ll
+ (setq e (pop ll))
+ (if (stringp e)
+ (progn
+ (princ e)
+ (princ "\n")
+ (setq lastwasstring t))
+ (if lastwasstring (princ head))
+ (setq lastwasstring nil)
+ (setq name (car e)
+ latex (nth 1 e)
+ html (nth 3 e)
+ utf8 (nth 6 e))
+ (princ (format " %-8s \\%-16s %-22s %-13s\n"
+ utf8 name latex html))))))
+ (with-current-buffer "*Org Entity Help*"
+ (org-mode))
+ (select-window (get-buffer-window "*Org Entity Help*")))
+
+
+(defun replace-amp ()
+ "Postprocess HTML file to unescape the ampersand."
+ (interactive)
+ (while (re-search-forward "<td>&amp;\\([^<;]+;\\)" nil t)
+ (replace-match (concat "<td>&" (match-string 1)) t t)))
+
+(provide 'org-entities)
+
+;; Local variables:
+;; coding: utf-8
+;; End:
+
+;;; org-entities.el ends here
diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el
new file mode 100644
index 0000000..4335fce
--- /dev/null
+++ b/lisp/org-eshell.el
@@ -0,0 +1,65 @@
+;;; org-eshell.el - Support for links to working directories in eshell
+
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+
+;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'org)
+(require 'eshell)
+(require 'esh-mode)
+
+(org-add-link-type "eshell" 'org-eshell-open)
+(add-hook 'org-store-link-functions 'org-eshell-store-link)
+
+(defun org-eshell-open (link)
+ "Switch to am eshell buffer and execute a command line.
+ The link can be just a command line (executed in the default
+ eshell buffer) or a command line prefixed by a buffer name
+ followed by a colon."
+ (let* ((buffer-and-command
+ (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link)
+ (list (match-string 1 link)
+ (match-string 2 link))
+ (list eshell-buffer-name link)))
+ (eshell-buffer-name (car buffer-and-command))
+ (command (cadr buffer-and-command)))
+ (if (get-buffer eshell-buffer-name)
+ (org-pop-to-buffer-same-window eshell-buffer-name)
+ (eshell))
+ (goto-char (point-max))
+ (eshell-kill-input)
+ (insert command)
+ (eshell-send-input)))
+
+(defun org-eshell-store-link ()
+ "Store a link that, when opened, switches back to the current eshell buffer
+ and the current working directory."
+ (when (eq major-mode 'eshell-mode)
+ (let* ((command (concat "cd " dired-directory))
+ (link (concat (buffer-name) ":" command)))
+ (org-store-link-props
+ :link (concat "eshell:" link)
+ :description command))))
+
+(provide 'org-eshell)
+
+;;; org-eshell.el ends here
diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el
new file mode 100644
index 0000000..89a0e5e
--- /dev/null
+++ b/lisp/org-exp-blocks.el
@@ -0,0 +1,402 @@
+;;; org-exp-blocks.el --- pre-process blocks when exporting org files
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+
+;; 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 is a utility for pre-processing blocks in org files before
+;; export using the `org-export-preprocess-hook'. It can be used for
+;; exporting new types of blocks from org-mode files and also for
+;; changing the default export behavior of existing org-mode blocks.
+;; The `org-export-blocks' and `org-export-interblocks' variables can
+;; be used to control how blocks and the spaces between blocks
+;; respectively are processed upon export.
+;;
+;; The type of a block is defined as the string following =#+begin_=,
+;; so for example the following block would be of type ditaa. Note
+;; that both upper or lower case are allowed in =#+BEGIN_= and
+;; =#+END_=.
+;;
+;; #+begin_ditaa blue.png -r -S
+;; +---------+
+;; | cBLU |
+;; | |
+;; | +----+
+;; | |cPNK|
+;; | | |
+;; +----+----+
+;; #+end_ditaa
+;;
+;;; Currently Implemented Block Types
+;;
+;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
+;; ascii pictures to actual images using ditaa
+;; http://ditaa.sourceforge.net/. To use this set
+;; `org-ditaa-jar-path' to the path to ditaa.jar on your
+;; system (should be set automatically in most cases) .
+;;
+;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
+;; graphs defined using the dot graphing language to images
+;; using the dot utility. For information on dot see
+;; http://www.graphviz.org/
+;;
+;; export-comment :: Wrap comments with titles and author information,
+;; in their own divs with author-specific ids allowing for
+;; css coloring of comments based on the author.
+;;
+;;; Adding new blocks
+;;
+;; When adding a new block type first define a formatting function
+;; along the same lines as `org-export-blocks-format-dot' and then use
+;; `org-export-blocks-add-block' to add your block type to
+;; `org-export-blocks'.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'find-func)
+(require 'org-compat)
+
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-remove-indentation "org" (code &optional n))
+
+(defvar org-protecting-blocks nil) ; From org.el
+
+(defun org-export-blocks-set (var value)
+ "Set the value of `org-export-blocks' and install fontification."
+ (set var value)
+ (mapc (lambda (spec)
+ (if (nth 2 spec)
+ (setq org-protecting-blocks
+ (delete (symbol-name (car spec))
+ org-protecting-blocks))
+ (add-to-list 'org-protecting-blocks
+ (symbol-name (car spec)))))
+ value))
+
+(defcustom org-export-blocks
+ '((export-comment org-export-blocks-format-comment t)
+ (ditaa org-export-blocks-format-ditaa nil)
+ (dot org-export-blocks-format-dot nil))
+ "Use this alist to associate block types with block exporting functions.
+The type of a block is determined by the text immediately
+following the '#+BEGIN_' portion of the block header. Each block
+export function should accept three arguments."
+ :group 'org-export-general
+ :type '(repeat
+ (list
+ (symbol :tag "Block name")
+ (function :tag "Block formatter")
+ (boolean :tag "Fontify content as Org syntax")))
+ :set 'org-export-blocks-set)
+
+(defun org-export-blocks-add-block (block-spec)
+ "Add a new block type to `org-export-blocks'.
+BLOCK-SPEC should be a three element list the first element of
+which should indicate the name of the block, the second element
+should be the formatting function called by
+`org-export-blocks-preprocess' and the third element a flag
+indicating whether these types of blocks should be fontified in
+org-mode buffers (see `org-protecting-blocks'). For example the
+BLOCK-SPEC for ditaa blocks is as follows.
+
+ (ditaa org-export-blocks-format-ditaa nil)"
+ (unless (member block-spec org-export-blocks)
+ (setq org-export-blocks (cons block-spec org-export-blocks))
+ (org-export-blocks-set 'org-export-blocks org-export-blocks)))
+
+(defcustom org-export-interblocks
+ '()
+ "Use this a-list to associate block types with block exporting functions.
+The type of a block is determined by the text immediately
+following the '#+BEGIN_' portion of the block header. Each block
+export function should accept three arguments."
+ :group 'org-export-general
+ :type 'alist)
+
+(defcustom org-export-blocks-witheld
+ '(hidden)
+ "List of block types (see `org-export-blocks') which should not be exported."
+ :group 'org-export-general
+ :type 'list)
+
+(defcustom org-export-blocks-postblock-hook nil
+ "Run after blocks have been processed with `org-export-blocks-preprocess'."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'hook)
+
+(defun org-export-blocks-html-quote (body &optional open close)
+ "Protect BODY from org html export.
+The optional OPEN and CLOSE tags will be inserted around BODY."
+ (concat
+ "\n#+BEGIN_HTML\n"
+ (or open "")
+ body (if (string-match "\n$" body) "" "\n")
+ (or close "")
+ "#+END_HTML\n"))
+
+(defun org-export-blocks-latex-quote (body &optional open close)
+ "Protect BODY from org latex export.
+The optional OPEN and CLOSE tags will be inserted around BODY."
+ (concat
+ "\n#+BEGIN_LaTeX\n"
+ (or open "")
+ body (if (string-match "\n$" body) "" "\n")
+ (or close "")
+ "#+END_LaTeX\n"))
+
+(defvar org-src-preserve-indentation) ; From org-src.el
+(defun org-export-blocks-preprocess ()
+ "Export all blocks according to the `org-export-blocks' block export alist.
+Does not export block types specified in specified in BLOCKS
+which defaults to the value of `org-export-blocks-witheld'."
+ (interactive)
+ (save-window-excursion
+ (let ((case-fold-search t)
+ (interblock (lambda (start end)
+ (mapcar (lambda (pair) (funcall (second pair) start end))
+ org-export-interblocks)))
+ matched indentation type types func
+ start end body headers preserve-indent progress-marker)
+ (goto-char (point-min))
+ (setq start (point))
+ (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
+ (while (re-search-forward beg-re nil t)
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (body-start (copy-marker (match-end 0)))
+ (indentation (length (match-string 1)))
+ (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
+ (regexp-quote (downcase (match-string 2)))))
+ (type (intern (downcase (match-string 2))))
+ (headers (save-match-data
+ (org-split-string (match-string 3) "[ \t]+")))
+ (balanced 1)
+ (preserve-indent (or org-src-preserve-indentation
+ (member "-i" headers)))
+ match-end)
+ (while (and (not (zerop balanced))
+ (re-search-forward inner-re nil t))
+ (if (string= (downcase (match-string 1)) "end")
+ (decf balanced)
+ (incf balanced)))
+ (when (not (zerop balanced))
+ (error "Unbalanced begin/end_%s blocks with %S"
+ type (buffer-substring match-start (point))))
+ (setq match-end (copy-marker (match-end 0)))
+ (unless preserve-indent
+ (setq body (save-match-data (org-remove-indentation
+ (buffer-substring
+ body-start (match-beginning 0))))))
+ (unless (memq type types) (setq types (cons type types)))
+ (save-match-data (funcall interblock start match-start))
+ (when (setq func (cadr (assoc type org-export-blocks)))
+ (let ((replacement (save-match-data
+ (if (memq type org-export-blocks-witheld) ""
+ (apply func body headers)))))
+ ;; ;; un-comment this code after the org-element merge
+ ;; (save-match-data
+ ;; (when (and replacement (string= replacement ""))
+ ;; (delete-region
+ ;; (car (org-element-collect-affiliated-keyword))
+ ;; match-start)))
+ (when replacement
+ (delete-region match-start match-end)
+ (goto-char match-start) (insert replacement)
+ (if preserve-indent
+ ;; indent only the code block markers
+ (save-excursion
+ (indent-line-to indentation) ; indent end_block
+ (goto-char match-start)
+ (indent-line-to indentation)) ; indent begin_block
+ ;; indent everything
+ (indent-code-rigidly match-start (point) indentation)))))
+ ;; cleanup markers
+ (set-marker match-start nil)
+ (set-marker body-start nil)
+ (set-marker match-end nil))
+ (setq start (point))))
+ (funcall interblock start (point-max))
+ (run-hooks 'org-export-blocks-postblock-hook))))
+
+;;================================================================================
+;; type specific functions
+
+;;--------------------------------------------------------------------------------
+;; ditaa: create images from ASCII art using the ditaa utility
+(defcustom org-ditaa-jar-path (expand-file-name
+ "ditaa.jar"
+ (file-name-as-directory
+ (expand-file-name
+ "scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../contrib"
+ (file-name-directory (org-find-library-dir "org")))))))
+ "Path to the ditaa jar executable."
+ :group 'org-babel
+ :type 'string)
+
+(defvar org-export-current-backend) ; dynamically bound in org-exp.el
+(defun org-export-blocks-format-ditaa (body &rest headers)
+ "DEPRECATED: use begin_src ditaa code blocks
+
+Pass block BODY to the ditaa utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the ditaa utility as command line arguments."
+ (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
+ (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+ (data-file (make-temp-file "org-ditaa"))
+ (hash (progn
+ (set-text-properties 0 (length body) nil body)
+ (sha1 (prin1-to-string (list body args)))))
+ (raw-out-file (if headers (car headers)))
+ (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
+ (cons (match-string 1 raw-out-file)
+ (match-string 2 raw-out-file))
+ (cons raw-out-file "png")))
+ (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
+ (unless (file-exists-p org-ditaa-jar-path)
+ (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
+ (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
+ body
+ (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
+ (org-split-string body "\n")
+ "\n")))
+ (prog1
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
+ (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
+
+;;--------------------------------------------------------------------------------
+;; dot: create graphs using the dot graphing language
+;; (require the dot executable to be in your path)
+(defun org-export-blocks-format-dot (body &rest headers)
+ "DEPRECATED: use \"#+begin_src dot\" code blocks
+
+Pass block BODY to the dot graphing utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the dot utility as command line arguments. Don't
+forget to specify the output type for the dot command, so if you
+are exporting to a file with a name like 'image.png' you should
+include a '-Tpng' argument, and your block should look like the
+following.
+
+#+begin_dot models.png -Tpng
+digraph data_relationships {
+ \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
+ \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
+ \"data_requirement\" -> \"data_product\"
+}
+#+end_dot"
+ (message "begin_dot blocks are DEPRECATED, use begin_src blocks")
+ (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+ (data-file (make-temp-file "org-ditaa"))
+ (hash (progn
+ (set-text-properties 0 (length body) nil body)
+ (sha1 (prin1-to-string (list body args)))))
+ (raw-out-file (if headers (car headers)))
+ (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
+ (cons (match-string 1 raw-out-file)
+ (match-string 2 raw-out-file))
+ (cons raw-out-file "png")))
+ (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
+ (prog1
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "dot " data-file " " args " -o " out-file))
+ (shell-command (concat "dot " data-file " " args " -o " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
+
+;;--------------------------------------------------------------------------------
+;; comment: export comments in author-specific css-stylable divs
+(defun org-export-blocks-format-comment (body &rest headers)
+ "Format comment BODY by OWNER and return it formatted for export.
+Currently, this only does something for HTML export, for all
+other backends, it converts the comment into an EXAMPLE segment."
+ (let ((owner (if headers (car headers)))
+ (title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
+ (cond
+ ((eq org-export-current-backend 'html) ;; We are exporting to HTML
+ (concat "#+BEGIN_HTML\n"
+ "<div class=\"org-comment\""
+ (if owner (format " id=\"org-comment-%s\" " owner))
+ ">\n"
+ (if owner (concat "<b>" owner "</b> ") "")
+ (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
+ "<p>\n"
+ "#+END_HTML\n"
+ body
+ "\n#+BEGIN_HTML\n"
+ "</p>\n"
+ "</div>\n"
+ "#+END_HTML\n"))
+ (t ;; This is not HTML, so just make it an example.
+ (concat "#+BEGIN_EXAMPLE\n"
+ (if title (concat "Title:" title "\n") "")
+ (if owner (concat "By:" owner "\n") "")
+ body
+ (if (string-match "\n\\'" body) "" "\n")
+ "#+END_EXAMPLE\n")))))
+
+(provide 'org-exp-blocks)
+
+;;; org-exp-blocks.el ends here
diff --git a/lisp/org-exp.el b/lisp/org-exp.el
new file mode 100644
index 0000000..6b506cd
--- /dev/null
+++ b/lisp/org-exp.el
@@ -0,0 +1,3351 @@
+;;; org-exp.el --- Export internals for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org)
+(require 'org-macs)
+(require 'org-agenda)
+(require 'org-exp-blocks)
+(require 'ob-exp)
+(require 'org-src)
+
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-export-latex-preprocess "org-latex" (parameters))
+(declare-function org-export-ascii-preprocess "org-ascii" (parameters))
+(declare-function org-export-html-preprocess "org-html" (parameters))
+(declare-function org-export-docbook-preprocess "org-docbook" (parameters))
+(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
+(declare-function org-export-htmlize-region-for-paste "org-html" (beg end))
+(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-table-cookie-line-p "org-table" (line))
+(declare-function org-table-colgroup-line-p "org-table" (line))
+(declare-function org-pop-to-buffer-same-window "org-compat"
+ (&optional buffer-or-name norecord label))
+
+(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
+
+(autoload 'org-export-as-odt "org-odt"
+ "Export the outline to a OpenDocument Text file." t)
+(autoload 'org-export-as-odt-and-open "org-odt"
+ "Export the outline to a OpenDocument Text file and open it." t)
+
+(defgroup org-export nil
+ "Options for exporting org-listings."
+ :tag "Org Export"
+ :group 'org)
+
+(defgroup org-export-general nil
+ "General options for exporting Org-mode files."
+ :tag "Org Export General"
+ :group 'org-export)
+
+(defcustom org-export-allow-BIND 'confirm
+ "Non-nil means allow #+BIND to define local variable values for export.
+This is a potential security risk, which is why the user must confirm the
+use of these lines."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Make the user confirm for each file" confirm)))
+
+;; FIXME
+(defvar org-export-publishing-directory nil)
+
+(defcustom org-export-show-temporary-export-buffer t
+ "Non-nil means show buffer after exporting to temp buffer.
+When Org exports to a file, the buffer visiting that file is ever
+shown, but remains buried. However, when exporting to a temporary
+buffer, that buffer is popped up in a second window. When this variable
+is nil, the buffer remains buried also in these cases."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-copy-to-kill-ring t
+ "Non-nil means exported stuff will also be pushed onto the kill ring."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-kill-product-buffer-when-displayed nil
+ "Non-nil means kill the product buffer if it is displayed immediately.
+This applied to the commands `org-export-as-html-and-open' and
+`org-export-as-pdf-and-open'."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-run-in-background nil
+ "Non-nil means export and publishing commands will run in background.
+This works by starting up a separate Emacs process visiting the same file
+and doing the export from there.
+Not all export commands are affected by this - only the ones which
+actually write to a file, and that do not depend on the buffer state.
+\\<org-mode-map>
+If this option is nil, you can still get background export by calling
+`org-export' with a double prefix arg: \
+\\[universal-argument] \\[universal-argument] \\[org-export].
+
+If this option is t, the double prefix can be used to exceptionally
+force an export command into the current process."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-initial-scope 'buffer
+ "The initial scope when exporting with `org-export'.
+This variable can be either set to 'buffer or 'subtree."
+ :group 'org-export-general
+ :version "24.1"
+ :type '(choice
+ (const :tag "Export current buffer" 'buffer)
+ (const :tag "Export current subtree" 'subtree)))
+
+(defcustom org-export-select-tags '("export")
+ "Tags that select a tree for export.
+If any such tag is found in a buffer, all trees that do not carry one
+of these tags will be deleted before export.
+Inside trees that are selected like this, you can still deselect a
+subtree by tagging it with one of the `org-export-exclude-tags'."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-export-exclude-tags '("noexport")
+ "Tags that exclude a tree from export.
+All trees carrying any of these tags will be excluded from export.
+This is without condition, so even subtrees inside that carry one of the
+`org-export-select-tags' will be removed."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+;; FIXME: rename, this is a general variable
+(defcustom org-export-html-expand t
+ "Non-nil means for HTML export, treat @<...> as HTML tag.
+When nil, these tags will be exported as plain text and therefore
+not be interpreted by a browser.
+
+This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
+ :group 'org-export-html
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-special-strings t
+ "Non-nil means interpret \"\-\", \"--\" and \"---\" for export.
+When this option is turned on, these strings will be exported as:
+
+ Org HTML LaTeX
+ -----+----------+--------
+ \\- &shy; \\-
+ -- &ndash; --
+ --- &mdash; ---
+ ... &hellip; \ldots
+
+This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
+ :group 'org-export-translation
+ :type 'boolean)
+
+(defcustom org-export-html-link-up ""
+ "Where should the \"UP\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :group 'org-export-general
+ :type '(string :tag "File or URL"))
+
+(defcustom org-export-html-link-home ""
+ "Where should the \"HOME\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :group 'org-export-general
+ :type '(string :tag "File or URL"))
+
+(defcustom org-export-language-setup
+ '(("en" "Author" "Date" "Table of Contents" "Footnotes")
+ ("ca" "Autor" "Data" "&Iacute;ndex" "Peus de p&agrave;gina")
+ ("cs" "Autor" "Datum" "Obsah" "Pozn\xe1mky pod carou")
+ ("da" "Ophavsmand" "Dato" "Indhold" "Fodnoter")
+ ("de" "Autor" "Datum" "Inhaltsverzeichnis" "Fu&szlig;noten")
+ ("eo" "A&#365;toro" "Dato" "Enhavo" "Piednotoj")
+ ("es" "Autor" "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
+ ("fi" "Tekij&auml;" "P&auml;iv&auml;m&auml;&auml;r&auml;" "Sis&auml;llysluettelo" "Alaviitteet")
+ ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page")
+ ("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
+ ("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
+ ("it" "Autore" "Data" "Indice" "Note a pi&egrave; di pagina")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("ja" "著者" "日付" "目次" "脚注")
+ ("ja" "&#33879;&#32773;" "&#26085;&#20184;" "&#30446;&#27425;" "&#33050;&#27880;")
+ ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten")
+ ("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
+ ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
+ ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
+ ("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("ru" "Автор" "Дата" "Содержание" "Сноски")
+ ("ru" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;")
+ ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("uk" "Автор" "Дата" "Зміст" "Примітки")
+ ("uk" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1047;&#1084;&#1110;&#1089;&#1090;" "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("zh-CN" "作者" "日期" "目录" "脚注")
+ ("zh-CN" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#24405;" "&#33050;&#27880;")
+ ;; Use numeric character entities for proper rendering of non-UTF8 documents
+ ;; ("zh-TW" "作者" "日期" "目錄" "腳註")
+ ("zh-TW" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#37636;" "&#33139;&#35387;"))
+ "Terms used in export text, translated to different languages.
+Use the variable `org-export-default-language' to set the language,
+or use the +OPTION lines for a per-file setting."
+ :group 'org-export-general
+ :type '(repeat
+ (list
+ (string :tag "HTML language tag")
+ (string :tag "Author")
+ (string :tag "Date")
+ (string :tag "Table of Contents")
+ (string :tag "Footnotes"))))
+
+(defcustom org-export-default-language "en"
+ "The default language for export and clocktable translations, as a string.
+This should have an association in `org-export-language-setup'
+and in `org-clock-clocktable-language-setup'."
+ :group 'org-export-general
+ :type 'string)
+
+(defcustom org-export-date-timestamp-format "%Y-%m-%d"
+ "Time string format for Org timestamps in the #+DATE option."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'string)
+
+(defvar org-export-page-description ""
+ "The page description, for the XHTML meta tag.
+This is best set with the #+DESCRIPTION line in a file, it does not make
+sense to set this globally.")
+
+(defvar org-export-page-keywords ""
+ "The page description, for the XHTML meta tag.
+This is best set with the #+KEYWORDS line in a file, it does not make
+sense to set this globally.")
+
+(defcustom org-export-skip-text-before-1st-heading nil
+ "Non-nil means skip all text before the first headline when exporting.
+When nil, that text is exported as well."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-headline-levels 3
+ "The last level which is still exported as a headline.
+Inferior levels will produce itemize lists when exported.
+Note that a numeric prefix argument to an exporter function overrides
+this setting.
+
+This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
+ :group 'org-export-general
+ :type 'integer)
+
+(defcustom org-export-with-section-numbers t
+ "Non-nil means add section numbers to headlines when exporting.
+
+This option can also be set with the +OPTIONS line, e.g. \"num:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-section-number-format '((("1" ".")) . "")
+ "Format of section numbers for export.
+The variable has two components.
+1. A list of lists, each indicating a counter type and a separator.
+ The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\".
+ It causes causes numeric, alphabetic, or roman counters, respectively.
+ The separator is only used if another counter for a subsection is being
+ added.
+ If there are more numbered section levels than entries in this lists,
+ then the last entry will be reused.
+2. A terminator string that will be added after the entire
+ section number."
+ :group 'org-export-general
+ :type '(cons
+ (repeat
+ (list
+ (string :tag "Counter Type")
+ (string :tag "Separator ")))
+ (string :tag "Terminator")))
+
+(defcustom org-export-with-toc t
+ "Non-nil means create a table of contents in exported files.
+The TOC contains headlines with levels up to`org-export-headline-levels'.
+When an integer, include levels up to N in the toc, this may then be
+different from `org-export-headline-levels', but it will not be allowed
+to be larger than the number of headline levels.
+When nil, no table of contents is made.
+
+Headlines which contain any TODO items will be marked with \"(*)\" in
+ASCII export, and with red color in HTML output, if the option
+`org-export-mark-todo-in-toc' is set.
+
+In HTML output, the TOC will be clickable.
+
+This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"
+or \"toc:3\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "No Table of Contents" nil)
+ (const :tag "Full Table of Contents" t)
+ (integer :tag "TOC to level")))
+
+(defcustom org-export-mark-todo-in-toc nil
+ "Non-nil means mark TOC lines that contain any open TODO items."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-todo-keywords t
+ "Non-nil means include TODO keywords in export.
+When nil, remove all these keywords from the export."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-tasks t
+ "Non-nil means include TODO items for export.
+This may have the following values:
+t include tasks independent of state.
+todo include only tasks that are not yet done.
+done include only tasks that are already done.
+nil remove all tasks before export
+list of TODO kwds keep only tasks with these keywords"
+ :group 'org-export-general
+ :version "24.1"
+ :type '(choice
+ (const :tag "All tasks" t)
+ (const :tag "No tasks" nil)
+ (const :tag "Not-done tasks" todo)
+ (const :tag "Only done tasks" done)
+ (repeat :tag "Specific TODO keywords"
+ (string :tag "Keyword"))))
+
+(defcustom org-export-with-priority nil
+ "Non-nil means include priority cookies in export.
+When nil, remove priority cookies for export."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-preserve-breaks nil
+ "Non-nil means preserve all line breaks when exporting.
+Normally, in HTML output paragraphs will be reformatted. In ASCII
+export, line breaks will always be preserved, regardless of this variable.
+
+This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-archived-trees 'headline
+ "Whether subtrees with the ARCHIVE tag should be exported.
+This can have three different values
+nil Do not export, pretend this tree is not present
+t Do export the entire tree
+headline Only export the headline, but skip the tree below it."
+ :group 'org-export-general
+ :group 'org-archive
+ :type '(choice
+ (const :tag "not at all" nil)
+ (const :tag "headline only" 'headline)
+ (const :tag "entirely" t)))
+
+(defcustom org-export-author-info t
+ "Non-nil means insert author name and email into the exported file.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"author:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-email-info nil
+ "Non-nil means insert author name and email into the exported file.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"email:t\"."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-creator-info t
+ "Non-nil means the postamble should contain a creator sentence.
+This sentence is \"HTML generated by org-mode XX in emacs XXX\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-time-stamp-file t
+ "Non-nil means insert a time stamp into the exported file.
+The time stamp shows when the file was created.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"timestamp:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-timestamps t
+ "If nil, do not export time stamps and associated keywords."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-remove-timestamps-from-toc t
+ "If t, remove timestamps from the table of contents entries."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-tags 'not-in-toc
+ "If nil, do not export tags, just remove them from headlines.
+If this is the symbol `not-in-toc', tags will be removed from table of
+contents entries, but still be shown in the headlines of the document.
+
+This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Off" nil)
+ (const :tag "Not in TOC" not-in-toc)
+ (const :tag "On" t)))
+
+(defcustom org-export-with-drawers nil
+ "Non-nil means export with drawers like the property drawer.
+When t, all drawers are exported. This may also be a list of
+drawer names to export."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))))
+
+(defvar org-export-first-hook nil
+ "Hook called as the first thing in each exporter.
+Point will be still in the original buffer.
+Good for general initialization")
+
+(defvar org-export-preprocess-hook nil
+ "Hook for preprocessing an export buffer.
+Pretty much the first thing when exporting is running this hook.
+Point will be in a temporary buffer that contains a copy of
+the original buffer, or of the section that is being exported.
+All the other hooks in the org-export-preprocess... category
+also work in that temporary buffer, already modified by various
+stages of the processing.")
+
+(defvar org-export-preprocess-after-include-files-hook nil
+ "Hook for preprocessing an export buffer.
+This is run after the contents of included files have been inserted.")
+
+(defvar org-export-preprocess-after-tree-selection-hook nil
+ "Hook for preprocessing an export buffer.
+This is run after selection of trees to be exported has happened.
+This selection includes tags-based selection, as well as removal
+of commented and archived trees.")
+
+(defvar org-export-preprocess-after-headline-targets-hook nil
+ "Hook for preprocessing export buffer.
+This is run just after the headline targets have been defined and
+the target-alist has been set up.")
+
+(defvar org-export-preprocess-before-selecting-backend-code-hook nil
+ "Hook for preprocessing an export buffer.
+This is run just before backend-specific blocks get selected.")
+
+(defvar org-export-preprocess-after-blockquote-hook nil
+ "Hook for preprocessing an export buffer.
+This is run after blockquote/quote/verse/center have been marked
+with cookies.")
+
+(defvar org-export-preprocess-after-radio-targets-hook nil
+ "Hook for preprocessing an export buffer.
+This is run after radio target processing.")
+
+(defvar org-export-preprocess-before-normalizing-links-hook nil
+ "Hook for preprocessing an export buffer.
+This hook is run before links are normalized.")
+
+(defvar org-export-preprocess-before-backend-specifics-hook nil
+ "Hook run before backend-specific functions are called during preprocessing.")
+
+(defvar org-export-preprocess-final-hook nil
+ "Hook for preprocessing an export buffer.
+This is run as the last thing in the preprocessing buffer, just before
+returning the buffer string to the backend.")
+
+(defgroup org-export-translation nil
+ "Options for translating special ascii sequences for the export backends."
+ :tag "Org Export Translation"
+ :group 'org-export)
+
+(defcustom org-export-with-emphasize t
+ "Non-nil means interpret *word*, /word/, and _word_ as emphasized text.
+If the export target supports emphasizing text, the word will be
+typeset in bold, italic, or underlined, respectively. Works only for
+single words, but you can say: I *really* *mean* *this*.
+Not all export backends support this.
+
+This option can also be set with the +OPTIONS line, e.g. \"*:nil\"."
+ :group 'org-export-translation
+ :type 'boolean)
+
+(defcustom org-export-with-footnotes t
+ "If nil, export [1] as a footnote marker.
+Lines starting with [1] will be formatted as footnotes.
+
+This option can also be set with the +OPTIONS line, e.g. \"f:nil\"."
+ :group 'org-export-translation
+ :type 'boolean)
+
+(defcustom org-export-with-TeX-macros t
+ "Non-nil means interpret simple TeX-like macros when exporting.
+For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
+Not only real TeX macros will work here, but the standard HTML entities
+for math can be used as macro names as well. For a list of supported
+names in HTML export, see the constant `org-entities' and the user option
+`org-entities-user'.
+Not all export backends support this.
+
+This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
+ :group 'org-export-translation
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-with-LaTeX-fragments t
+ "Non-nil means process LaTeX math fragments for HTML display.
+When set, the exporter will find and process LaTeX environments if the
+\\begin line is the first non-white thing on a line. It will also find
+and process the math delimiters like $a=b$ and \\( a=b \\) for inline math,
+$$a=b$$ and \\=\\[ a=b \\] for display math.
+
+This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
+
+Allowed values are:
+
+nil Don't do anything.
+verbatim Keep everything in verbatim
+dvipng Process the LaTeX fragments to images.
+ This will also include processing of non-math environments.
+imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
+ to convert pdf files to png files.
+t Do MathJax preprocessing if there is at least on math snippet,
+ and arrange for MathJax.js to be loaded.
+
+The default is nil, because this option needs the `dvipng' program which
+is not available on all systems."
+ :group 'org-export-translation
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (const :tag "Obsolete, use dvipng setting" t)
+ (const :tag "Use dvipng to make images" dvipng)
+ (const :tag "Use imagemagick to make images" imagemagick)
+ (const :tag "Use MathJax to display math" mathjax)
+ (const :tag "Leave math verbatim" verbatim)))
+
+(defcustom org-export-with-fixed-width t
+ "Non-nil means lines starting with \":\" will be in fixed width font.
+This can be used to have pre-formatted text, fragments of code etc. For
+example:
+ : ;; Some Lisp examples
+ : (while (defc cnt)
+ : (ding))
+will be looking just like this in also HTML. See also the QUOTE keyword.
+Not all export backends support this.
+
+This option can also be set with the +OPTIONS line, e.g. \"::nil\"."
+ :group 'org-export-translation
+ :type 'boolean)
+
+(defgroup org-export-tables nil
+ "Options for exporting tables in Org-mode."
+ :tag "Org Export Tables"
+ :group 'org-export)
+
+(defcustom org-export-with-tables t
+ "If non-nil, lines starting with \"|\" define a table.
+For example:
+
+ | Name | Address | Birthday |
+ |-------------+----------+-----------|
+ | Arthur Dent | England | 29.2.2100 |
+
+Not all export backends support this.
+
+This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-highlight-first-table-line t
+ "Non-nil means highlight the first table line.
+In HTML export, this means use <th> instead of <td>.
+In tables created with table.el, this applies to the first table line.
+In Org-mode tables, all lines before the first horizontal separator
+line will be formatted with <th> tags."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-table-remove-special-lines t
+ "Remove special lines and marking characters in calculating tables.
+This removes the special marking character column from tables that are set
+up for spreadsheet calculations. It also removes the entire lines
+marked with `!', `_', or `^'. The lines with `$' are kept, because
+the values of constants may be useful to have."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-table-remove-empty-lines t
+ "Remove empty lines when exporting tables.
+This is the global equivalent of the :remove-nil-lines option
+when locally sending a table with #+ORGTBL."
+ :group 'org-export-tables
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-prefer-native-exporter-for-tables nil
+ "Non-nil means always export tables created with table.el natively.
+Natively means use the HTML code generator in table.el.
+When nil, Org-mode's own HTML generator is used when possible (i.e. if
+the table does not use row- or column-spanning). This has the
+advantage, that the automatic HTML conversions for math symbols and
+sub/superscripts can be applied. Org-mode's HTML generator is also
+much faster. The LaTeX exporter always use the native exporter for
+table.el tables."
+ :group 'org-export-tables
+ :type 'boolean)
+
+;;;; Exporting
+
+;;; Variables, constants, and parameter plists
+
+(defconst org-level-max 20)
+
+(defvar org-export-current-backend nil
+ "During export, this will be bound to a symbol such as 'html,
+ 'latex, 'docbook, 'ascii, etc, indicating which of the export
+ backends is in use. Otherwise it has the value nil. Users
+ should not attempt to change the value of this variable
+ directly, but it can be used in code to test whether export is
+ in progress, and if so, what the backend is.")
+
+(defvar org-current-export-file nil) ; dynamically scoped parameter
+(defvar org-current-export-dir nil) ; dynamically scoped parameter
+(defvar org-export-opt-plist nil
+ "Contains the current option plist.")
+(defvar org-last-level nil) ; dynamically scoped variable
+(defvar org-min-level nil) ; dynamically scoped variable
+(defvar org-levels-open nil) ; dynamically scoped parameter
+(defvar org-export-footnotes-data nil
+ "Alist of labels used in buffers, along with their definition.")
+(defvar org-export-footnotes-seen nil
+ "Alist of labels encountered so far by the exporter, along with their definition.")
+
+
+(defconst org-export-plist-vars
+ '((:link-up nil org-export-html-link-up)
+ (:link-home nil org-export-html-link-home)
+ (:language nil org-export-default-language)
+ (:keywords nil org-export-page-keywords)
+ (:description nil org-export-page-description)
+ (:customtime nil org-display-custom-times)
+ (:headline-levels "H" org-export-headline-levels)
+ (:section-numbers "num" org-export-with-section-numbers)
+ (:section-number-format nil org-export-section-number-format)
+ (:table-of-contents "toc" org-export-with-toc)
+ (:preserve-breaks "\\n" org-export-preserve-breaks)
+ (:archived-trees nil org-export-with-archived-trees)
+ (:emphasize "*" org-export-with-emphasize)
+ (:sub-superscript "^" org-export-with-sub-superscripts)
+ (:special-strings "-" org-export-with-special-strings)
+ (:footnotes "f" org-export-with-footnotes)
+ (:drawers "d" org-export-with-drawers)
+ (:tags "tags" org-export-with-tags)
+ (:todo-keywords "todo" org-export-with-todo-keywords)
+ (:tasks "tasks" org-export-with-tasks)
+ (:priority "pri" org-export-with-priority)
+ (:TeX-macros "TeX" org-export-with-TeX-macros)
+ (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments)
+ (:latex-listings nil org-export-latex-listings)
+ (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading)
+ (:fixed-width ":" org-export-with-fixed-width)
+ (:timestamps "<" org-export-with-timestamps)
+ (:author nil user-full-name)
+ (:email nil user-mail-address)
+ (:author-info "author" org-export-author-info)
+ (:email-info "email" org-export-email-info)
+ (:creator-info "creator" org-export-creator-info)
+ (:time-stamp-file "timestamp" org-export-time-stamp-file)
+ (:tables "|" org-export-with-tables)
+ (:table-auto-headline nil org-export-highlight-first-table-line)
+ (:style-include-default nil org-export-html-style-include-default)
+ (:style-include-scripts nil org-export-html-style-include-scripts)
+ (:style nil org-export-html-style)
+ (:style-extra nil org-export-html-style-extra)
+ (:agenda-style nil org-agenda-export-html-style)
+ (:convert-org-links nil org-export-html-link-org-files-as-html)
+ (:inline-images nil org-export-html-inline-images)
+ (:html-extension nil org-export-html-extension)
+ (:html-preamble nil org-export-html-preamble)
+ (:html-postamble nil org-export-html-postamble)
+ (:xml-declaration nil org-export-html-xml-declaration)
+ (:html-table-tag nil org-export-html-table-tag)
+ (:expand-quoted-html "@" org-export-html-expand)
+ (:timestamp nil org-export-html-with-timestamp)
+ (:publishing-directory nil org-export-publishing-directory)
+ (:select-tags nil org-export-select-tags)
+ (:exclude-tags nil org-export-exclude-tags)
+
+ (:latex-image-options nil org-export-latex-image-default-option))
+ "List of properties that represent export/publishing variables.
+Each element is a list of 3 items:
+1. The property that is used internally, and also for org-publish-project-alist
+2. The string that can be used in the OPTION lines to set this option,
+ or nil if this option cannot be changed in this way
+3. The customization variable that sets the default for this option."
+ )
+
+(defun org-default-export-plist ()
+ "Return the property list with default settings for the export variables."
+ (let* ((infile (org-infile-export-plist))
+ (letbind (plist-get infile :let-bind))
+ (l org-export-plist-vars) rtn e s v)
+ (while (setq e (pop l))
+ (setq s (nth 2 e)
+ v (cond
+ ((assq s letbind) (nth 1 (assq s letbind)))
+ ((boundp s) (symbol-value s)))
+ rtn (cons (car e) (cons v rtn))))
+ rtn))
+
+(defvar org-export-inbuffer-options-extra nil
+ "List of additional in-buffer options that should be detected.
+Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL,
+etc. Extensions can add to this list to get their options detected, and they
+can then add a function to `org-export-options-filters' to process these
+options.
+Each element in this list must be a list, with the in-buffer keyword as car,
+and a property (a symbol) as the next element. All occurrences of the
+keyword will be found, the values concatenated with a space character
+in between, and the result stored in the export options property list.")
+
+(defvar org-export-options-filters nil
+ "Functions to be called to finalize the export/publishing options.
+All these options are stored in a property list, and each of the functions
+in this hook gets a chance to modify this property list. Each function
+must accept the property list as an argument, and must return the (possibly
+modified) list.")
+
+;; FIXME: should we fold case here?
+
+(defun org-infile-export-plist ()
+ "Return the property list with file-local settings for export."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((re (org-make-options-regexp
+ (append
+ '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
+ "MATHJAX"
+ "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
+ "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS"
+ "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
+ "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
+ (mapcar 'car org-export-inbuffer-options-extra))))
+ (case-fold-search t)
+ p key val text options mathjax a pr style
+ latex-header latex-class latex-class-options macros letbind
+ ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
+ (while (or (and ext-setup-or-nil
+ (string-match re ext-setup-or-nil start)
+ (setq start (match-end 0)))
+ (and (setq ext-setup-or-nil nil start 0)
+ (re-search-forward re nil t)))
+ (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil))
+ val (org-match-string-no-properties 2 ext-setup-or-nil))
+ (cond
+ ((setq a (assoc key org-export-inbuffer-options-extra))
+ (setq pr (nth 1 a))
+ (setq p (plist-put p pr (concat (plist-get p pr) " " val))))
+ ((string-equal key "TITLE") (setq p (plist-put p :title val)))
+ ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
+ ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
+ ((string-equal key "DATE")
+ ;; If date is an Org timestamp, convert it to a time
+ ;; string using `org-export-date-timestamp-format'
+ (when (string-match org-ts-regexp3 val)
+ (setq val (format-time-string
+ org-export-date-timestamp-format
+ (apply 'encode-time (org-parse-time-string
+ (match-string 0 val))))))
+ (setq p (plist-put p :date val)))
+ ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
+ ((string-equal key "DESCRIPTION")
+ (setq p (plist-put p :description val)))
+ ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
+ ((string-equal key "STYLE")
+ (setq style (concat style "\n" val)))
+ ((string-equal key "LATEX_HEADER")
+ (setq latex-header (concat latex-header "\n" val)))
+ ((string-equal key "LATEX_CLASS")
+ (setq latex-class val))
+ ((string-equal key "LATEX_CLASS_OPTIONS")
+ (setq latex-class-options val))
+ ((string-equal key "TEXT")
+ (setq text (if text (concat text "\n" val) val)))
+ ((string-equal key "OPTIONS")
+ (setq options (concat val " " options)))
+ ((string-equal key "MATHJAX")
+ (setq mathjax (concat val " " mathjax)))
+ ((string-equal key "BIND")
+ (push (read (concat "(" val ")")) letbind))
+ ((string-equal key "XSLT")
+ (setq p (plist-put p :xslt val)))
+ ((string-equal key "LINK_UP")
+ (setq p (plist-put p :link-up val)))
+ ((string-equal key "LINK_HOME")
+ (setq p (plist-put p :link-home val)))
+ ((string-equal key "EXPORT_SELECT_TAGS")
+ (setq p (plist-put p :select-tags (org-split-string val))))
+ ((string-equal key "EXPORT_EXCLUDE_TAGS")
+ (setq p (plist-put p :exclude-tags (org-split-string val))))
+ ((string-equal key "MACRO")
+ (push val macros))
+ ((equal key "SETUPFILE")
+ (setq setup-file (org-remove-double-quotes (org-trim val))
+ ;; take care of recursive inclusion of setupfiles
+ setup-file (if (or (file-name-absolute-p val) (not setup-dir))
+ (expand-file-name setup-file)
+ (let ((default-directory setup-dir))
+ (expand-file-name setup-file))))
+ (setq setup-dir (file-name-directory setup-file))
+ (setq setup-contents (org-file-contents setup-file 'noerror))
+ (if (not ext-setup-or-nil)
+ (setq ext-setup-or-nil setup-contents start 0)
+ (setq ext-setup-or-nil
+ (concat (substring ext-setup-or-nil 0 start)
+ "\n" setup-contents "\n"
+ (substring ext-setup-or-nil start)))))))
+ (setq p (plist-put p :text text))
+ (when (and letbind (org-export-confirm-letbind))
+ (setq p (plist-put p :let-bind letbind)))
+ (when style (setq p (plist-put p :style-extra style)))
+ (when latex-header
+ (setq p (plist-put p :latex-header-extra (substring latex-header 1))))
+ (when latex-class
+ (setq p (plist-put p :latex-class latex-class)))
+ (when latex-class-options
+ (setq p (plist-put p :latex-class-options latex-class-options)))
+ (when options
+ (setq p (org-export-add-options-to-plist p options)))
+ (when mathjax
+ (setq p (plist-put p :mathjax mathjax)))
+ ;; Add macro definitions
+ (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
+ (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
+ (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))
+ (setq p (plist-put
+ p :macro-modification-time
+ (and (buffer-file-name)
+ (file-exists-p (buffer-file-name))
+ (concat
+ "(eval (format-time-string \"$1\" '"
+ (prin1-to-string (nth 5 (file-attributes
+ (buffer-file-name))))
+ "))"))))
+ (setq p (plist-put p :macro-input-file (and (buffer-file-name)
+ (file-name-nondirectory
+ (buffer-file-name)))))
+ (while (setq val (pop macros))
+ (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val)
+ (setq p (plist-put
+ p (intern
+ (concat ":macro-" (downcase (match-string 1 val))))
+ (org-export-interpolate-newlines (match-string 2 val))))))
+ p))))
+
+(defun org-export-interpolate-newlines (s)
+ (while (string-match "\\\\n" s)
+ (setq s (replace-match "\n" t t s)))
+ s)
+
+(defvar org-export-allow-BIND-local nil)
+(defun org-export-confirm-letbind ()
+ "Can we use #+BIND values during export?
+By default this will ask for confirmation by the user, to divert possible
+security risks."
+ (cond
+ ((not org-export-allow-BIND) nil)
+ ((eq org-export-allow-BIND t) t)
+ ((local-variable-p 'org-export-allow-BIND-local (current-buffer))
+ org-export-allow-BIND-local)
+ (t (org-set-local 'org-export-allow-BIND-local
+ (yes-or-no-p "Allow BIND values in this buffer? ")))))
+
+(defun org-install-letbind ()
+ "Install the values from #+BIND lines as local variables."
+ (let ((letbind (plist-get org-export-opt-plist :let-bind))
+ pair)
+ (while (setq pair (pop letbind))
+ (org-set-local (car pair) (nth 1 pair)))))
+
+(defun org-export-add-options-to-plist (p options)
+ "Parse an OPTIONS line and set values in the property list P."
+ (let (o)
+ (when options
+ (let ((op org-export-plist-vars))
+ (while (setq o (pop op))
+ (if (and (nth 1 o)
+ (string-match (concat "\\(\\`\\|[ \t]\\)"
+ (regexp-quote (nth 1 o))
+ ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
+ options))
+ (setq p (plist-put p (car o)
+ (car (read-from-string
+ (match-string 2 options))))))))))
+ p)
+
+(defun org-export-add-subtree-options (p pos)
+ "Add options in subtree at position POS to property list P."
+ (save-excursion
+ (goto-char pos)
+ (when (org-at-heading-p)
+ (let (a)
+ ;; This is actually read in `org-export-get-title-from-subtree'
+ ;; (when (setq a (org-entry-get pos "EXPORT_TITLE"))
+ ;; (setq p (plist-put p :title a)))
+ (when (setq a (org-entry-get pos "EXPORT_TEXT"))
+ (setq p (plist-put p :text a)))
+ (when (setq a (org-entry-get pos "EXPORT_AUTHOR"))
+ (setq p (plist-put p :author a)))
+ (when (setq a (org-entry-get pos "EXPORT_DATE"))
+ (setq p (plist-put p :date a)))
+ (when (setq a (org-entry-get pos "EXPORT_OPTIONS"))
+ (setq p (org-export-add-options-to-plist p a)))))
+ p))
+
+(defun org-export-directory (type plist)
+ (let* ((val (plist-get plist :publishing-directory))
+ (dir (if (listp val)
+ (or (cdr (assoc type val)) ".")
+ val)))
+ dir))
+
+(defun org-export-process-option-filters (plist)
+ (let ((functions org-export-options-filters) f)
+ (while (setq f (pop functions))
+ (setq plist (funcall f plist))))
+ plist)
+
+;;;###autoload
+(defun org-export (&optional arg)
+ "Export dispatcher for Org-mode.
+When `org-export-run-in-background' is non-nil, try to run the command
+in the background. This will be done only for commands that write
+to a file. For details see the docstring of `org-export-run-in-background'.
+
+The prefix argument ARG will be passed to the exporter. However, if
+ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \
+that means to inverse the
+value of `org-export-run-in-background'.
+
+If `org-export-initial-scope' is set to 'subtree, try to export
+the current subtree, otherwise try to export the whole buffer.
+Pressing `1' will switch between these two options."
+ (interactive "P")
+ (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
+ (subtree-p (or (org-region-active-p)
+ (eq org-export-initial-scope 'subtree)))
+ (regb (and (org-region-active-p) (region-beginning)))
+ (rege (and (org-region-active-p) (region-end)))
+ (help "[t] insert the export option template
+\[v] limit export to visible part of outline tree
+\[1] switch buffer/subtree export
+\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop)
+
+\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer
+
+\[h] export as HTML [H] to temporary buffer [R] export region
+\[b] export as HTML and open in browser
+
+\[l] export as LaTeX [L] to temporary buffer
+\[p] export as LaTeX and process to PDF [d] ... and open PDF file
+
+\[D] export as DocBook [V] export as DocBook, process to PDF, and open
+
+\[o] export as OpenDocument Text [O] ... and open
+
+\[j] export as TaskJuggler [J] ... and open
+
+\[m] export as Freemind mind map
+\[x] export as XOXO
+\[g] export using Wes Hardaker's generic exporter
+
+\[i] export current file as iCalendar file
+\[I] export all agenda files as iCalendar files [c] ...as one combined file
+
+\[F] publish current file [P] publish current project
+\[X] publish a project... [E] publish every projects")
+ (cmds
+ '((?t org-insert-export-options-template nil)
+ (?v org-export-visible nil)
+ (?a org-export-as-ascii t)
+ (?A org-export-as-ascii-to-buffer t)
+ (?n org-export-as-latin1 t)
+ (?N org-export-as-latin1-to-buffer t)
+ (?u org-export-as-utf8 t)
+ (?U org-export-as-utf8-to-buffer t)
+ (?h org-export-as-html t)
+ (?b org-export-as-html-and-open t)
+ (?H org-export-as-html-to-buffer nil)
+ (?R org-export-region-as-html nil)
+ (?x org-export-as-xoxo t)
+ (?g org-export-generic t)
+ (?D org-export-as-docbook t)
+ (?V org-export-as-docbook-pdf-and-open t)
+ (?o org-export-as-odt t)
+ (?O org-export-as-odt-and-open t)
+ (?j org-export-as-taskjuggler t)
+ (?J org-export-as-taskjuggler-and-open t)
+ (?m org-export-as-freemind t)
+ (?l org-export-as-latex t)
+ (?p org-export-as-pdf t)
+ (?d org-export-as-pdf-and-open t)
+ (?L org-export-as-latex-to-buffer nil)
+ (?i org-export-icalendar-this-file t)
+ (?I org-export-icalendar-all-agenda-files t)
+ (?c org-export-icalendar-combine-agenda-files t)
+ (?F org-publish-current-file t)
+ (?P org-publish-current-project t)
+ (?X org-publish t)
+ (?E org-publish-all t)))
+ r1 r2 ass
+ (cpos (point)) (cbuf (current-buffer)) bpos)
+ (save-excursion
+ (save-window-excursion
+ (if subtree-p
+ (message "Export subtree: ")
+ (message "Export buffer: "))
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Org Export/Publishing Help*"
+ (princ help))
+ (org-fit-window-to-buffer (get-buffer-window
+ "*Org Export/Publishing Help*"))
+ (while (eq (setq r1 (read-char-exclusive)) ?1)
+ (cond (subtree-p
+ (setq subtree-p nil)
+ (message "Export buffer: "))
+ ((not subtree-p)
+ (setq subtree-p t)
+ (setq bpos (point))
+ (org-mark-subtree)
+ (org-activate-mark)
+ (setq regb (and (org-region-active-p) (region-beginning)))
+ (setq rege (and (org-region-active-p) (region-end)))
+ (message "Export subtree: "))))
+ (when (eq r1 ?\ )
+ (let ((case-fold-search t)
+ (end (save-excursion (while (org-up-heading-safe)) (point))))
+ (outline-next-heading)
+ (if (re-search-backward
+ "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-"
+ end t)
+ (progn
+ (org-back-to-heading t)
+ (setq subtree-p t)
+ (setq bpos (point))
+ (message "Select command (for subtree): ")
+ (setq r1 (read-char-exclusive)))
+ (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME")
+ )))))
+ (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay)
+ (and bpos (goto-char bpos))
+ (setq r2 (if (< r1 27) (+ r1 96) r1))
+ (unless (setq ass (assq r2 cmds))
+ (error "No command associated with key %c" r1))
+ (if (and bg (nth 2 ass)
+ (not (buffer-base-buffer))
+ (not (org-region-active-p)))
+ ;; execute in background
+ (let ((p (start-process
+ (concat "Exporting " (file-name-nondirectory (buffer-file-name)))
+ "*Org Processes*"
+ (expand-file-name invocation-name invocation-directory)
+ "-batch"
+ "-l" user-init-file
+ "--eval" "(require 'org-exp)"
+ "--eval" "(setq org-wait .2)"
+ (buffer-file-name)
+ "-f" (symbol-name (nth 1 ass)))))
+ (set-process-sentinel p 'org-export-process-sentinel)
+ (message "Background process \"%s\": started" p))
+ ;; set the mark correctly when exporting a subtree
+ (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb)))
+
+ (call-interactively (nth 1 ass))
+ (when (and bpos (get-buffer-window cbuf))
+ (let ((cw (selected-window)))
+ (select-window (get-buffer-window cbuf))
+ (goto-char cpos)
+ (deactivate-mark)
+ (select-window cw))))))
+
+(defun org-export-process-sentinel (process status)
+ (if (string-match "\n+\\'" status)
+ (setq status (substring status 0 -1)))
+ (message "Background process \"%s\": %s" process status))
+
+;;; General functions for all backends
+
+(defvar org-export-target-aliases nil
+ "Alist of targets with invisible aliases.")
+(defvar org-export-preferred-target-alist nil
+ "Alist of section id's with preferred aliases.")
+(defvar org-export-id-target-alist nil
+ "Alist of section id's with preferred aliases.")
+(defvar org-export-code-refs nil
+ "Alist of code references and line numbers.")
+
+(defun org-export-preprocess-string (string &rest parameters)
+ "Cleanup STRING so that the true exported has a more consistent source.
+This function takes STRING, which should be a buffer-string of an org-file
+to export. It then creates a temporary buffer where it does its job.
+The result is then again returned as a string, and the exporter works
+on this string to produce the exported version."
+ (interactive)
+ (let* ((org-export-current-backend (or (plist-get parameters :for-backend)
+ org-export-current-backend))
+ (archived-trees (plist-get parameters :archived-trees))
+ (inhibit-read-only t)
+ (drawers org-drawers)
+ (source-buffer (current-buffer))
+ target-alist rtn)
+
+ (setq org-export-target-aliases nil
+ org-export-preferred-target-alist nil
+ org-export-id-target-alist nil
+ org-export-code-refs nil)
+
+ (with-temp-buffer
+ (erase-buffer)
+ (insert string)
+ (setq case-fold-search t)
+
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max)
+ '(read-only t)))
+
+ ;; Remove license-to-kill stuff
+ ;; The caller marks some stuff for killing, stuff that has been
+ ;; used to create the page title, for example.
+ (org-export-kill-licensed-text)
+
+ (let ((org-inhibit-startup t)) (org-mode))
+ (setq case-fold-search t)
+ (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)")
+ (org-install-letbind)
+
+ ;; Call the hook
+ (run-hooks 'org-export-preprocess-hook)
+
+ (untabify (point-min) (point-max))
+
+ ;; Handle include files, and call a hook
+ (org-export-handle-include-files-recurse)
+ (run-hooks 'org-export-preprocess-after-include-files-hook)
+
+ ;; Get rid of archived trees
+ (org-export-remove-archived-trees archived-trees)
+
+ ;; Remove comment environment and comment subtrees
+ (org-export-remove-comment-blocks-and-subtrees)
+
+ ;; Get rid of excluded trees, and call a hook
+ (org-export-handle-export-tags (plist-get parameters :select-tags)
+ (plist-get parameters :exclude-tags))
+ (run-hooks 'org-export-preprocess-after-tree-selection-hook)
+
+ ;; Get rid of tasks, depending on configuration
+ (org-export-remove-tasks (plist-get parameters :tasks))
+
+ ;; Prepare footnotes for export. During that process, footnotes
+ ;; actually included in the exported part of the buffer go
+ ;; though some transformations:
+
+ ;; 1. They have their label normalized (like "[N]");
+
+ ;; 2. They get moved at the same place in the buffer (usually at
+ ;; its end, but backends may define another place via
+ ;; `org-footnote-insert-pos-for-preprocessor');
+
+ ;; 3. The are stored in `org-export-footnotes-seen', while
+ ;; `org-export-preprocess-string' is applied to their
+ ;; definition.
+
+ ;; Line-wise exporters ignore `org-export-footnotes-seen', as
+ ;; they interpret footnotes at the moment they see them in the
+ ;; buffer. Context-wise exporters grab all the info needed in
+ ;; that variable and delete moved definitions (as described in
+ ;; 2nd step).
+ (when (plist-get parameters :footnotes)
+ (org-footnote-normalize nil parameters))
+
+ ;; Change lists ending. Other parts of export may insert blank
+ ;; lines and lists' structure could be altered.
+ (org-export-mark-list-end)
+
+ ;; Process the macros
+ (org-export-preprocess-apply-macros)
+ (run-hooks 'org-export-preprocess-after-macros-hook)
+
+ ;; Export code blocks
+ (org-export-blocks-preprocess)
+
+ ;; Mark lists with properties
+ (org-export-mark-list-properties)
+
+ ;; Handle source code snippets
+ (org-export-replace-src-segments-and-examples)
+
+ ;; Protect short examples marked by a leading colon
+ (org-export-protect-colon-examples)
+
+ ;; Protected spaces
+ (org-export-convert-protected-spaces)
+
+ ;; Find all headings and compute the targets for them
+ (setq target-alist (org-export-define-heading-targets target-alist))
+
+ (run-hooks 'org-export-preprocess-after-headline-targets-hook)
+
+ ;; Find HTML special classes for headlines
+ (org-export-remember-html-container-classes)
+
+ ;; Get rid of drawers
+ (org-export-remove-or-extract-drawers
+ drawers (plist-get parameters :drawers))
+
+ ;; Get the correct stuff before the first headline
+ (when (plist-get parameters :skip-before-1st-heading)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
+ (delete-region (point-min) (match-beginning 0))
+ (goto-char (point-min))
+ (insert "\n")))
+ (when (plist-get parameters :add-text)
+ (goto-char (point-min))
+ (insert (plist-get parameters :add-text) "\n"))
+
+ ;; Remove todo-keywords before exporting, if the user has requested so
+ (org-export-remove-headline-metadata parameters)
+
+ ;; Find targets in comments and move them out of comments,
+ ;; but mark them as targets that should be invisible
+ (setq target-alist (org-export-handle-invisible-targets target-alist))
+
+ ;; Select and protect backend specific stuff, throw away stuff
+ ;; that is specific for other backends
+ (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook)
+ (org-export-select-backend-specific-text)
+
+ ;; Protect quoted subtrees
+ (org-export-protect-quoted-subtrees)
+
+ ;; Remove clock lines
+ (org-export-remove-clock-lines)
+
+ ;; Protect verbatim elements
+ (org-export-protect-verbatim)
+
+ ;; Blockquotes, verse, and center
+ (org-export-mark-blockquote-verse-center)
+ (run-hooks 'org-export-preprocess-after-blockquote-hook)
+
+ ;; Remove timestamps, if the user has requested so
+ (unless (plist-get parameters :timestamps)
+ (org-export-remove-timestamps))
+
+ ;; Attach captions to the correct object
+ (setq target-alist (org-export-attach-captions-and-attributes target-alist))
+
+ ;; Find matches for radio targets and turn them into internal links
+ (org-export-mark-radio-links)
+ (run-hooks 'org-export-preprocess-after-radio-targets-hook)
+
+ ;; Find all links that contain a newline and put them into a single line
+ (org-export-concatenate-multiline-links)
+
+ ;; Normalize links: Convert angle and plain links into bracket links
+ ;; and expand link abbreviations
+ (run-hooks 'org-export-preprocess-before-normalizing-links-hook)
+ (org-export-normalize-links)
+
+ ;; Find all internal links. If they have a fuzzy match (i.e. not
+ ;; a *dedicated* target match, let the link point to the
+ ;; corresponding section.
+ (org-export-target-internal-links target-alist)
+
+ ;; Find multiline emphasis and put them into single line
+ (when (plist-get parameters :emph-multiline)
+ (org-export-concatenate-multiline-emphasis))
+
+ ;; Remove special table lines, and store alignment information
+ (org-store-forced-table-alignment)
+ (when org-export-table-remove-special-lines
+ (org-export-remove-special-table-lines))
+
+ ;; Another hook
+ (run-hooks 'org-export-preprocess-before-backend-specifics-hook)
+
+ ;; Backend-specific preprocessing
+ (let* ((backend-name (symbol-name org-export-current-backend))
+ (f (intern (format "org-export-%s-preprocess" backend-name))))
+ (require (intern (concat "org-" backend-name)) nil)
+ (funcall f parameters))
+
+ ;; Remove or replace comments
+ (org-export-handle-comments (plist-get parameters :comments))
+
+ ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
+ (org-export-handle-metalines)
+
+ ;; Run the final hook
+ (run-hooks 'org-export-preprocess-final-hook)
+
+ (setq rtn (buffer-string)))
+ rtn))
+
+(defun org-export-kill-licensed-text ()
+ "Remove all text that is marked with a :org-license-to-kill property."
+ (let (p)
+ (while (setq p (text-property-any (point-min) (point-max)
+ :org-license-to-kill t))
+ (delete-region
+ p (or (next-single-property-change p :org-license-to-kill)
+ (point-max))))))
+
+(defvar org-export-define-heading-targets-headline-hook nil
+ "Hook that is run when a headline was matched during target search.
+This is part of the preprocessing for export.")
+
+(defun org-export-define-heading-targets (target-alist)
+ "Find all headings and define the targets for them.
+The new targets are added to TARGET-ALIST, which is also returned.
+Also find all ID and CUSTOM_ID properties and store them."
+ (goto-char (point-min))
+ (org-init-section-numbers)
+ (let ((re (concat "^" org-outline-regexp
+ "\\|"
+ "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)"))
+ level target last-section-target a id)
+ (while (re-search-forward re nil t)
+ (org-if-unprotected-at (match-beginning 0)
+ (if (match-end 2)
+ (progn
+ (setq id (org-match-string-no-properties 2))
+ (push (cons id target) target-alist)
+ (setq a (or (assoc last-section-target org-export-target-aliases)
+ (progn
+ (push (list last-section-target)
+ org-export-target-aliases)
+ (car org-export-target-aliases))))
+ (push (caar target-alist) (cdr a))
+ (when (equal (match-string 1) "CUSTOM_ID")
+ (if (not (assoc last-section-target
+ org-export-preferred-target-alist))
+ (push (cons last-section-target id)
+ org-export-preferred-target-alist)))
+ (when (equal (match-string 1) "ID")
+ (if (not (assoc last-section-target
+ org-export-id-target-alist))
+ (push (cons last-section-target (concat "ID-" id))
+ org-export-id-target-alist))))
+ (setq level (org-reduced-level
+ (save-excursion (goto-char (point-at-bol))
+ (org-outline-level))))
+ (setq target (org-solidify-link-text
+ (format "sec-%s" (replace-regexp-in-string
+ "\\." "-"
+ (org-section-number level)))))
+ (setq last-section-target target)
+ (push (cons target target) target-alist)
+ (add-text-properties
+ (point-at-bol) (point-at-eol)
+ (list 'target target))
+ (run-hooks 'org-export-define-heading-targets-headline-hook)))))
+ target-alist)
+
+(defun org-export-handle-invisible-targets (target-alist)
+ "Find targets in comments and move them out of comments.
+Mark them as invisible targets."
+ (let (target tmp a)
+ (goto-char (point-min))
+ (while (re-search-forward "^#.*?\\(<<<?\\([^>\r\n]+\\)>>>?\\).*" nil t)
+ ;; Check if the line before or after is a headline with a target
+ (if (setq target (or (get-text-property (point-at-bol 0) 'target)
+ (get-text-property (point-at-bol 2) 'target)))
+ (progn
+ ;; use the existing target in a neighboring line
+ (setq tmp (match-string 2))
+ (replace-match "")
+ (and (looking-at "\n") (delete-char 1))
+ (push (cons (setq tmp (org-solidify-link-text tmp)) target)
+ target-alist)
+ (setq a (or (assoc target org-export-target-aliases)
+ (progn
+ (push (list target) org-export-target-aliases)
+ (car org-export-target-aliases))))
+ (push tmp (cdr a)))
+ ;; Make an invisible target
+ (replace-match "\\1(INVISIBLE)"))))
+ target-alist)
+
+(defun org-export-target-internal-links (target-alist)
+ "Find all internal links and assign targets to them.
+If a link has a fuzzy match (i.e. not a *dedicated* target match),
+let the link point to the corresponding section.
+This function also handles the id links, if they have a match in
+the current file."
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (org-if-unprotected-at (1+ (match-beginning 0))
+ (let* ((org-link-search-must-match-exact-headline t)
+ (md (match-data))
+ (desc (match-end 2))
+ (link (org-link-unescape (match-string 1)))
+ (slink (org-solidify-link-text link))
+ found props pos cref
+ (target
+ (cond
+ ((= (string-to-char link) ?#)
+ ;; user wants exactly this link
+ link)
+ ((cdr (assoc slink target-alist))
+ (or (cdr (assoc (assoc slink target-alist)
+ org-export-preferred-target-alist))
+ (cdr (assoc slink target-alist))))
+ ((and (string-match "^id:" link)
+ (cdr (assoc (substring link 3) target-alist))))
+ ((string-match "^(\\(.*\\))$" link)
+ (setq cref (match-string 1 link))
+ (concat "coderef:" cref))
+ ((string-match org-link-types-re link) nil)
+ ((or (file-name-absolute-p link)
+ (string-match "^\\." link))
+ nil)
+ (t
+ (let ((org-link-search-inhibit-query t))
+ (save-excursion
+ (setq found (condition-case nil (org-link-search link)
+ (error nil)))
+ (when (and found
+ (or (org-at-heading-p)
+ (not (eq found 'dedicated))))
+ (or (get-text-property (point) 'target)
+ (get-text-property
+ (max (point-min)
+ (1- (or (previous-single-property-change
+ (point) 'target) 0)))
+ 'target)))))))))
+ (when target
+ (set-match-data md)
+ (goto-char (match-beginning 1))
+ (setq props (text-properties-at (point)))
+ (delete-region (match-beginning 1) (match-end 1))
+ (setq pos (point))
+ (insert target)
+ (unless desc (insert "][" link))
+ (add-text-properties pos (point) props))))))
+
+(defun org-export-remember-html-container-classes ()
+ "Store the HTML_CONTAINER_CLASS properties in a text property."
+ (goto-char (point-min))
+ (let (class)
+ (while (re-search-forward
+ "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
+ (setq class (match-string 1))
+ (save-excursion
+ (when (re-search-backward "^\\*" (point-min) t)
+ (org-back-to-heading t)
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'html-container-class class))))))
+
+(defvar org-export-format-drawer-function nil
+ "Function to be called to format the contents of a drawer.
+The function must accept two parameters:
+ NAME the drawer name, like \"PROPERTIES\"
+ CONTENT the content of the drawer.
+You can check the export backend through `org-export-current-backend'.
+The function should return the text to be inserted into the buffer.
+If this is nil, `org-export-format-drawer' is used as a default.")
+
+(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers)
+ "Remove drawers, or extract and format the content.
+ALL-DRAWERS is a list of all drawer names valid in the current buffer.
+EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers
+whose content to keep. Any drawers that are in ALL-DRAWERS but not in
+EXP-DRAWERS will be removed."
+ (goto-char (point-min))
+ (let ((re (concat "^[ \t]*:\\("
+ (mapconcat 'identity all-drawers "\\|")
+ "\\):[ \t]*$"))
+ name beg beg-content eol content)
+ (while (re-search-forward re nil t)
+ (org-if-unprotected
+ (setq name (match-string 1))
+ (setq beg (match-beginning 0)
+ beg-content (1+ (point-at-eol))
+ eol (point-at-eol))
+ (if (not (and (re-search-forward
+ "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" nil t)
+ (match-end 1)))
+ (goto-char eol)
+ (goto-char (match-beginning 0))
+ (and (looking-at ".*\n?") (replace-match ""))
+ (setq content (buffer-substring beg-content (point)))
+ (delete-region beg (point))
+ (when (or (eq exp-drawers t)
+ (member name exp-drawers))
+ (setq content (funcall (or org-export-format-drawer-function
+ 'org-export-format-drawer)
+ name content))
+ (insert content)))))))
+
+(defun org-export-format-drawer (name content)
+ "Format the content of a drawer as a colon example."
+ (if (string-match "[ \t]+\\'" content)
+ (setq content (substring content (match-beginning 0))))
+ (while (string-match "\\`[ \t]*\n" content)
+ (setq content (substring content (match-end 0))))
+ (setq content (org-remove-indentation content))
+ (setq content (concat ": " (mapconcat 'identity
+ (org-split-string content "\n")
+ "\n: ")
+ "\n"))
+ (setq content (concat " : " (upcase name) "\n" content))
+ (org-add-props content nil 'org-protected t))
+
+(defun org-export-handle-export-tags (select-tags exclude-tags)
+ "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS.
+Both arguments are lists of tags.
+If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG
+will be removed.
+After that, all subtrees that are marked by EXCLUDE-TAGS will be
+removed as well."
+ (remove-text-properties (point-min) (point-max) '(:org-delete t))
+ (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote
+ select-tags "\\|")
+ "\\):"))
+ (re-excl (concat ":\\(" (mapconcat 'regexp-quote
+ exclude-tags "\\|")
+ "\\):"))
+ beg end cont)
+ (goto-char (point-min))
+ (when (and select-tags
+ (re-search-forward
+ (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t))
+ ;; At least one tree is marked for export, this means
+ ;; all the unmarked stuff needs to go.
+ ;; Dig out the trees that should be exported
+ (goto-char (point-min))
+ (outline-next-heading)
+ (setq beg (point))
+ (put-text-property beg (point-max) :org-delete t)
+ (while (re-search-forward re-sel nil t)
+ (when (org-at-heading-p)
+ (org-back-to-heading)
+ (remove-text-properties
+ (max (1- (point)) (point-min))
+ (setq cont (save-excursion (org-end-of-subtree t t)))
+ '(:org-delete t))
+ (while (and (org-up-heading-safe)
+ (get-text-property (point) :org-delete))
+ (remove-text-properties (max (1- (point)) (point-min))
+ (point-at-eol) '(:org-delete t)))
+ (goto-char cont))))
+ ;; Remove the trees explicitly marked for noexport
+ (when exclude-tags
+ (goto-char (point-min))
+ (while (re-search-forward re-excl nil t)
+ (when (org-at-heading-p)
+ (org-back-to-heading t)
+ (setq beg (point))
+ (org-end-of-subtree t t)
+ (delete-region beg (point))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe)))))
+ ;; Remove everything that is now still marked for deletion
+ (goto-char (point-min))
+ (while (setq beg (text-property-any (point-min) (point-max) :org-delete t))
+ (setq end (or (next-single-property-change beg :org-delete)
+ (point-max)))
+ (delete-region beg end))))
+
+(defun org-export-remove-tasks (keep)
+ "Remove tasks depending on configuration.
+When KEEP is nil, remove all tasks.
+When KEEP is `todo', remove the tasks that are DONE.
+When KEEP is `done', remove the tasks that are not yet done.
+When it is a list of strings, keep only tasks with these TODO keywords."
+ (when (or (listp keep) (memq keep '(todo done nil)))
+ (let ((re (concat "^\\*+[ \t]+\\("
+ (mapconcat
+ 'regexp-quote
+ (cond ((not keep) org-todo-keywords-1)
+ ((eq keep 'todo) org-done-keywords)
+ ((eq keep 'done) org-not-done-keywords)
+ ((listp keep)
+ (org-delete-all keep (copy-sequence
+ org-todo-keywords-1))))
+ "\\|")
+ "\\)\\($\\|[ \t]\\)"))
+ (case-fold-search nil)
+ beg)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (org-if-unprotected
+ (setq beg (match-beginning 0))
+ (org-end-of-subtree t t)
+ (if (looking-at "^\\*+[ \t]+END[ \t]*$")
+ ;; Kill the END line of the inline task
+ (goto-char (min (point-max) (1+ (match-end 0)))))
+ (delete-region beg (point)))))))
+
+(defun org-export-remove-archived-trees (export-archived-trees)
+ "Remove archived trees.
+When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported.
+When it is t, the entire archived tree will be exported.
+When it is nil the entire tree including the headline will be removed
+from the buffer."
+ (let ((re-archive (concat ":" org-archive-tag ":"))
+ a b)
+ (when (not (eq export-archived-trees t))
+ (goto-char (point-min))
+ (while (re-search-forward re-archive nil t)
+ (if (not (org-at-heading-p t))
+ (goto-char (point-at-eol))
+ (beginning-of-line 1)
+ (setq a (if export-archived-trees
+ (1+ (point-at-eol)) (point))
+ b (org-end-of-subtree t))
+ (if (> b a) (delete-region a b)))))))
+
+(defun org-export-remove-headline-metadata (opts)
+ "Remove meta data from the headline, according to user options."
+ (let ((re org-complex-heading-regexp)
+ (todo (plist-get opts :todo-keywords))
+ (tags (plist-get opts :tags))
+ (pri (plist-get opts :priority))
+ (elts '(1 2 3 4 5))
+ (case-fold-search nil)
+ rpl)
+ (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5))))
+ (when (or (not todo) (not tags) (not pri))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (org-if-unprotected
+ (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) ""))
+ elts " "))
+ (replace-match rpl t t))))))
+
+(defun org-export-remove-timestamps ()
+ "Remove timestamps and keywords for export."
+ (goto-char (point-min))
+ (while (re-search-forward org-maybe-keyword-time-regexp nil t)
+ (backward-char 1)
+ (org-if-unprotected
+ (unless (save-match-data (org-at-table-p))
+ (replace-match "")
+ (beginning-of-line 1)
+ (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n")
+ (replace-match ""))))))
+
+(defun org-export-remove-clock-lines ()
+ "Remove clock lines for export."
+ (goto-char (point-min))
+ (let ((re (concat "^[ \t]*" org-clock-string ".*\n?")))
+ (while (re-search-forward re nil t)
+ (org-if-unprotected
+ (replace-match "")))))
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defun org-export-protect-quoted-subtrees ()
+ "Mark quoted subtrees with the protection property."
+ (let ((org-re-quote (format org-heading-keyword-regexp-format
+ org-quote-string)))
+ (goto-char (point-min))
+ (while (re-search-forward org-re-quote nil t)
+ (goto-char (match-beginning 0))
+ (end-of-line 1)
+ (add-text-properties (point) (org-end-of-subtree t)
+ '(org-protected t)))))
+
+(defun org-export-convert-protected-spaces ()
+ "Convert strings like \\____ to protected spaces in all backends."
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\__+" nil t)
+ (org-if-unprotected-1
+ (replace-match
+ (org-add-props
+ (cond
+ ((eq org-export-current-backend 'latex)
+ (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0))))
+ ((eq org-export-current-backend 'html)
+ (org-add-props (match-string 0) nil
+ 'org-whitespace (- (match-end 0) (match-beginning 0))))
+ ;; ((eq org-export-current-backend 'docbook))
+ ((eq org-export-current-backend 'ascii)
+ (org-add-props (match-string 0) '(org-whitespace t)))
+ (t (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
+ '(org-protected t))
+ t t))))
+
+(defun org-export-protect-verbatim ()
+ "Mark verbatim snippets with the protection property."
+ (goto-char (point-min))
+ (while (re-search-forward org-verbatim-re nil t)
+ (org-if-unprotected
+ (add-text-properties (match-beginning 4) (match-end 4)
+ '(org-protected t org-verbatim-emph t))
+ (goto-char (1+ (match-end 4))))))
+
+(defun org-export-protect-colon-examples ()
+ "Protect lines starting with a colon."
+ (goto-char (point-min))
+ (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg)
+ (while (re-search-forward re nil t)
+ (beginning-of-line 1)
+ (setq beg (point))
+ (while (looking-at re)
+ (end-of-line 1)
+ (or (eobp) (forward-char 1)))
+ (add-text-properties beg (if (bolp) (1- (point)) (point))
+ '(org-protected t)))))
+
+(defvar org-export-backends
+ '(docbook html beamer ascii latex)
+ "List of Org supported export backends.")
+
+(defun org-export-select-backend-specific-text ()
+ (let ((formatters org-export-backends)
+ (case-fold-search t)
+ backend backend-name beg beg-content end end-content ind)
+
+ (while formatters
+ (setq backend (pop formatters)
+ backend-name (symbol-name backend))
+
+ ;; Handle #+BACKEND: stuff
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name
+ ":[ \t]*\\(.*\\)") nil t)
+ (if (not (eq backend org-export-current-backend))
+ (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
+ (let ((ind (get-text-property (point-at-bol) 'original-indentation)))
+ (replace-match "\\1\\2" t)
+ (add-text-properties
+ (point-at-bol) (min (1+ (point-at-eol)) (point-max))
+ `(org-protected t original-indentation ,ind org-native-text t)))))
+ ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
+ ;; matching the current backend will be taken care of by
+ ;; `org-export-attach-captions-and-attributes'
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name
+ ":[ \t]*\\(.*\\)") nil t)
+ (setq ind (org-get-indentation))
+ (when (not (eq backend org-export-current-backend))
+ (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
+ ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?")
+ nil t)
+ (setq beg (match-beginning 0) beg-content (match-end 0))
+ (setq ind (or (get-text-property beg 'original-indentation)
+ (save-excursion (goto-char beg) (org-get-indentation))))
+ (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?")
+ nil t)
+ (setq end (match-end 0) end-content (match-beginning 0))
+ (if (eq backend org-export-current-backend)
+ ;; yes, keep this
+ (progn
+ (add-text-properties
+ beg-content end-content
+ `(org-protected t original-indentation ,ind org-native-text t))
+ ;; strip protective commas
+ (org-strip-protective-commas beg-content end-content)
+ (delete-region (match-beginning 0) (match-end 0))
+ (save-excursion
+ (goto-char beg)
+ (delete-region (point) (1+ (point-at-eol)))))
+ ;; No, this is for a different backend, kill it
+ (delete-region beg end)))))))
+
+(defun org-export-mark-blockquote-verse-center ()
+ "Mark block quote and verse environments with special cookies.
+These special cookies will later be interpreted by the backend."
+ ;; Blockquotes
+ (let (type t1 ind beg end beg1 end1 content)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)"
+ nil t)
+ (setq ind (length (match-string 1))
+ type (downcase (match-string 3))
+ t1 (if (equal type "quote") "blockquote" type))
+ (setq beg (match-beginning 0)
+ beg1 (1+ (match-end 0)))
+ (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t)
+ (setq end1 (1- (match-beginning 0))
+ end (+ (point-at-eol) (if (looking-at "\n$") 1 0)))
+ (setq content (org-remove-indentation (buffer-substring beg1 end1)))
+ (setq content (concat "ORG-" (upcase t1) "-START\n"
+ content "\n"
+ "ORG-" (upcase t1) "-END\n"))
+ (delete-region beg end)
+ (insert (org-add-props content nil 'original-indentation ind))))))
+
+(defun org-export-mark-list-end ()
+ "Mark all list endings with a special string."
+ (unless (eq org-export-current-backend 'ascii)
+ (mapc
+ (lambda (e)
+ ;; For each type allowing list export, find every list, remove
+ ;; ending regexp if needed, and insert org-list-end.
+ (goto-char (point-min))
+ (while (re-search-forward (org-item-beginning-re) nil t)
+ (when (eq (nth 2 (org-list-context)) e)
+ (let* ((struct (org-list-struct))
+ (bottom (org-list-get-bottom-point struct))
+ (top (point-at-bol))
+ (top-ind (org-list-get-ind top struct)))
+ (goto-char bottom)
+ (when (and (not (looking-at "[ \t]*$"))
+ (looking-at org-list-end-re))
+ (replace-match ""))
+ (unless (bolp) (insert "\n"))
+ ;; As org-list-end is inserted at column 0, it would end
+ ;; by indentation any list. It can be problematic when
+ ;; there are lists within lists: the inner list end would
+ ;; also become the outer list end. To avoid this, text
+ ;; property `original-indentation' is added, as
+ ;; `org-list-struct' pays attention to it when reading a
+ ;; list.
+ (insert (org-add-props
+ "ORG-LIST-END-MARKER\n"
+ (list 'original-indentation top-ind)))))))
+ (cons nil org-list-export-context))))
+
+(defun org-export-mark-list-properties ()
+ "Mark list with special properties.
+These special properties will later be interpreted by the backend."
+ (let ((mark-list
+ (function
+ ;; Mark a list with 3 properties: `list-item' which is
+ ;; position at beginning of line, `list-struct' which is
+ ;; list structure, and `list-prevs' which is the alist of
+ ;; item and its predecessor. Leave point at list ending.
+ (lambda (ctxt)
+ (let* ((struct (org-list-struct))
+ (top (org-list-get-top-point struct))
+ (bottom (org-list-get-bottom-point struct))
+ (prevs (org-list-prevs-alist struct))
+ poi)
+ ;; Get every item and ending position, without dups and
+ ;; without bottom point of list.
+ (mapc (lambda (e)
+ (let ((pos (car e))
+ (end (nth 6 e)))
+ (unless (memq pos poi)
+ (push pos poi))
+ (unless (or (= end bottom) (memq end poi))
+ (push end poi))))
+ struct)
+ (setq poi (sort poi '<))
+ ;; For every point of interest, mark the whole line with
+ ;; its position in list.
+ (mapc
+ (lambda (e)
+ (goto-char e)
+ (add-text-properties (point-at-bol) (point-at-eol)
+ (list 'list-item (point-at-bol)
+ 'list-struct struct
+ 'list-prevs prevs)))
+ poi)
+ ;; Take care of bottom point. As babel may have inserted
+ ;; a new list in buffer, list ending isn't always
+ ;; marked. Now mark every list ending and add properties
+ ;; useful to line processing exporters.
+ (goto-char bottom)
+ (when (or (looking-at "^ORG-LIST-END-MARKER\n")
+ (and (not (looking-at "[ \t]*$"))
+ (looking-at org-list-end-re)))
+ (replace-match ""))
+ (unless (bolp) (insert "\n"))
+ (insert
+ (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
+ 'list-struct struct
+ 'list-prevs prevs)))
+ ;; Following property is used by LaTeX exporter.
+ (add-text-properties top (point) (list 'list-context ctxt)))))))
+ ;; Mark lists except for backends not interpreting them.
+ (unless (eq org-export-current-backend 'ascii)
+ (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
+ (mapc
+ (lambda (e)
+ (goto-char (point-min))
+ (while (re-search-forward (org-item-beginning-re) nil t)
+ (let ((context (nth 2 (org-list-context))))
+ (if (eq context e)
+ (funcall mark-list e)
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'list-context context)))))
+ (cons nil org-list-export-context))))))
+
+(defun org-export-attach-captions-and-attributes (target-alist)
+ "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties.
+If the next thing following is a table, add the text properties to the first
+table line. If it is a link, add it to the line containing the link."
+ (goto-char (point-min))
+ (remove-text-properties (point-min) (point-max)
+ '(org-caption nil org-attributes nil))
+ (let ((case-fold-search t)
+ (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)"
+ "\\|"
+ "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)"
+ "\\|"
+ "^[ \t]*#\\+label:[ \t]+\\(.*\\)"
+ "\\|"
+ "^[ \t]*\\(|[^-]\\)"
+ "\\|"
+ "^[ \t]*\\[\\[.*\\]\\][ \t]*$"))
+ cap shortn attr label end)
+ (while (re-search-forward re nil t)
+ (cond
+ ;; there is a caption
+ ((match-end 1)
+ (progn
+ (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))
+ (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap)
+ (setq shortn (match-string 1 cap)
+ cap (match-string 2 cap)))
+ (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
+ ;; there is an attribute
+ ((match-end 2)
+ (progn
+ (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))
+ (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
+ ;; there is a label
+ ((match-end 3)
+ (progn
+ (setq label (org-trim (match-string 3)))
+ (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
+ (t
+ (setq end (if (match-end 4)
+ (let ((ee (org-table-end)))
+ (prog1 (1- (marker-position ee)) (move-marker ee nil)))
+ (point-at-eol)))
+ (add-text-properties (point-at-bol) end
+ (list 'org-caption cap
+ 'org-caption-shortn shortn
+ 'org-attributes attr
+ 'org-label label))
+ (if label (push (cons label label) target-alist))
+ (goto-char end)
+ (setq cap nil shortn nil attr nil label nil)))))
+ target-alist)
+
+(defun org-export-remove-comment-blocks-and-subtrees ()
+ "Remove the comment environment, and also commented subtrees."
+ (let ((re-commented (format org-heading-keyword-regexp-format
+ org-comment-string))
+ case-fold-search)
+ ;; Remove comment environment
+ (goto-char (point-min))
+ (setq case-fold-search t)
+ (while (re-search-forward
+ "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t)
+ (replace-match "" t t))
+ ;; Remove subtrees that are commented
+ (goto-char (point-min))
+ (setq case-fold-search nil)
+ (while (re-search-forward re-commented nil t)
+ (goto-char (match-beginning 0))
+ (delete-region (point) (org-end-of-subtree t)))))
+
+(defun org-export-handle-comments (org-commentsp)
+ "Remove comments, or convert to backend-specific format.
+ORG-COMMENTSP can be a format string for publishing comments.
+When it is nil, all comments will be removed."
+ (let ((re "^[ \t]*#\\( \\|$\\)"))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (let ((pos (match-beginning 0))
+ (end (progn (forward-line) (point))))
+ (if (get-text-property pos 'org-protected)
+ (forward-line)
+ (if (not org-commentsp) (delete-region pos end)
+ (add-text-properties pos end '(org-protected t))
+ (replace-match
+ (org-add-props
+ (format org-commentsp (buffer-substring (match-end 0) end))
+ nil 'org-protected t)
+ t t)))))
+ ;; Hack attack: previous implementation also removed keywords at
+ ;; column 0. Brainlessly do it again.
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+" nil t)
+ (unless (get-text-property (point-at-bol) 'org-protected)
+ (delete-region (point-at-bol) (progn (forward-line) (point)))))))
+
+(defun org-export-handle-metalines ()
+ "Remove tables and source blocks metalines.
+This function should only be called after all block processing
+has taken place."
+ (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)")
+ (case-fold-search t)
+ pos)
+ (goto-char (point-min))
+ (while (or (looking-at re)
+ (re-search-forward re nil t))
+ (setq pos (match-beginning 0))
+ (if (get-text-property (match-beginning 1) 'org-protected)
+ (goto-char (1+ pos))
+ (goto-char (1+ pos))
+ (replace-match "")
+ (goto-char (max (point-min) (1- pos)))))))
+
+(defun org-export-mark-radio-links ()
+ "Find all matches for radio targets and turn them into internal links."
+ (let ((re-radio (and org-target-link-regexp
+ (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))))
+ (goto-char (point-min))
+ (when re-radio
+ (while (re-search-forward re-radio nil t)
+ (unless
+ (save-match-data
+ (or (org-in-regexp org-bracket-link-regexp)
+ (org-in-regexp org-plain-link-re)
+ (org-in-regexp "<<[^<>]+>>")))
+ (org-if-unprotected
+ (replace-match "\\1[[\\2]]")))))))
+
+(defun org-store-forced-table-alignment ()
+ "Find table lines which force alignment, store the results in properties."
+ (let (line cnt cookies)
+ (goto-char (point-min))
+ (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|"
+ nil t)
+ ;; OK, this looks like a table line with an alignment cookie
+ (org-if-unprotected
+ (setq line (buffer-substring (point-at-bol) (point-at-eol)))
+ (when (and (org-at-table-p)
+ (org-table-cookie-line-p line))
+ (setq cnt 0 cookies nil)
+ (mapc
+ (lambda (x)
+ (setq cnt (1+ cnt))
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x)
+ (let ((align (and (match-end 1)
+ (downcase (match-string 1 x))))
+ (width (and (match-end 2)
+ (string-to-number (match-string 2 x)))))
+ (push (cons cnt (list align width)) cookies))))
+ (org-split-string line "[ \t]*|[ \t]*"))
+ (add-text-properties (org-table-begin) (org-table-end)
+ (list 'org-col-cookies cookies))))
+ (goto-char (point-at-eol)))))
+
+(defun org-export-remove-special-table-lines ()
+ "Remove tables lines that are used for internal purposes.
+Also, store forced alignment information found in such lines."
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*|" nil t)
+ (org-if-unprotected-at (1- (point))
+ (beginning-of-line 1)
+ (if (or (looking-at "[ \t]*| *[!_^] *|")
+ (not
+ (memq
+ nil
+ (mapcar
+ (lambda (f)
+ (or (and org-export-table-remove-empty-lines (= (length f) 0))
+ (string-match
+ "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f)))
+ (org-split-string ;; FIXME, can't we do without splitting???
+ (buffer-substring (point-at-bol) (point-at-eol))
+ "[ \t]*|[ \t]*")))))
+ (delete-region (max (point-min) (1- (point-at-bol)))
+ (point-at-eol))
+ (end-of-line 1)))))
+
+(defun org-export-protect-sub-super (s)
+ (save-match-data
+ (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s)
+ (setq s (replace-match "\\1\\\\\\2" nil nil s)))
+ s))
+
+(defun org-export-normalize-links ()
+ "Convert all links to bracket links, and expand link abbreviations."
+ (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
+ (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
+ nodesc)
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t))
+ (goto-char (point-min))
+ (while (re-search-forward re-plain-link nil t)
+ (unless (get-text-property (match-beginning 0) 'org-normalized-link)
+ (goto-char (1- (match-end 0)))
+ (org-if-unprotected-at (1+ (match-beginning 0))
+ (let* ((s (concat (match-string 1)
+ "[[" (match-string 2) ":" (match-string 3)
+ "][" (match-string 2) ":" (org-export-protect-sub-super
+ (match-string 3))
+ "]]")))
+ ;; added 'org-link face to links
+ (put-text-property 0 (length s) 'face 'org-link s)
+ (replace-match s t t)))))
+ (goto-char (point-min))
+ (while (re-search-forward re-angle-link nil t)
+ (goto-char (1- (match-end 0)))
+ (org-if-unprotected
+ (let* ((s (concat (match-string 1)
+ "[[" (match-string 2) ":" (match-string 3)
+ "][" (match-string 2) ":" (org-export-protect-sub-super
+ (match-string 3))
+ "]]")))
+ (put-text-property 0 (length s) 'face 'org-link s)
+ (replace-match s t t))))
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (goto-char (1- (match-end 0)))
+ (setq nodesc (not (match-end 3)))
+ (org-if-unprotected
+ (let* ((xx (save-match-data
+ (org-translate-link
+ (org-link-expand-abbrev (match-string 1)))))
+ (s (concat
+ "[[" (org-add-props (copy-sequence xx)
+ nil 'org-protected t 'org-no-description nodesc)
+ "]"
+ (if (match-end 3)
+ (match-string 2)
+ (concat "[" (copy-sequence xx)
+ "]"))
+ "]")))
+ (put-text-property 0 (length s) 'face 'org-link s)
+ (replace-match s t t))))))
+
+(defun org-export-concatenate-multiline-links ()
+ "Find multi-line links and put it all into a single line.
+This is to make sure that the line-processing export backends
+can work correctly."
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (replace-match "\\1 \\3")
+ (goto-char (match-beginning 0)))))
+
+(defun org-export-concatenate-multiline-emphasis ()
+ "Find multi-line emphasis and put it all into a single line.
+This is to make sure that the line-processing export backends
+can work correctly."
+ (goto-char (point-min))
+ (while (re-search-forward org-emph-re nil t)
+ (if (and (not (= (char-after (match-beginning 3))
+ (char-after (match-beginning 4))))
+ (save-excursion (goto-char (match-beginning 0))
+ (save-match-data
+ (and (not (org-at-table-p))
+ (not (org-at-heading-p))))))
+ (org-if-unprotected
+ (subst-char-in-region (match-beginning 0) (match-end 0)
+ ?\n ?\ t)
+ (goto-char (1- (match-end 0))))
+ (goto-char (1+ (match-beginning 0))))))
+
+(defun org-export-grab-title-from-buffer ()
+ "Get a title for the current document, from looking at the buffer."
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((end (if (looking-at org-outline-regexp)
+ (point)
+ (save-excursion (outline-next-heading) (point)))))
+ (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t)
+ ;; Mark the line so that it will not be exported as normal text.
+ (unless (org-in-block-p org-list-forbidden-blocks)
+ (org-unmodified
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list :org-license-to-kill t))))
+ ;; Return the title string
+ (org-trim (match-string 0)))))))
+
+(defun org-export-get-title-from-subtree ()
+ "Return subtree title and exclude it from export."
+ (let ((rbeg (region-beginning)) (rend (region-end))
+ (inhibit-read-only t)
+ (tags (plist-get (org-infile-export-plist) :tags))
+ title)
+ (save-excursion
+ (goto-char rbeg)
+ (when (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))
+ (when (plist-member org-export-opt-plist :tags)
+ (setq tags (or (plist-get org-export-opt-plist :tags) tags)))
+ ;; This is a subtree, we take the title from the first heading
+ (goto-char rbeg)
+ (looking-at org-todo-line-tags-regexp)
+ (setq title (if (and (eq tags t) (match-string 4))
+ (format "%s\t%s" (match-string 3) (match-string 4))
+ (match-string 3)))
+ (org-unmodified
+ (add-text-properties (point) (1+ (point-at-eol))
+ (list :org-license-to-kill t)))
+ (setq title (or (org-entry-get nil "EXPORT_TITLE") title))))
+ title))
+
+(defun org-solidify-link-text (s &optional alist)
+ "Take link text and make a safe target out of it."
+ (save-match-data
+ (let* ((rtn
+ (mapconcat
+ 'identity
+ (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-"))
+ (a (assoc rtn alist)))
+ (or (cdr a) rtn))))
+
+(defun org-get-min-level (lines &optional offset)
+ "Get the minimum level in LINES."
+ (let ((re "^\\(\\*+\\) ") l)
+ (catch 'exit
+ (while (setq l (pop lines))
+ (if (string-match re l)
+ (throw 'exit (org-tr-level (- (length (match-string 1 l))
+ (or offset 0))))))
+ 1)))
+
+;; Variable holding the vector with section numbers
+(defvar org-section-numbers (make-vector org-level-max 0))
+
+(defun org-init-section-numbers ()
+ "Initialize the vector for the section numbers."
+ (let* ((level -1)
+ (numbers (nreverse (org-split-string "" "\\.")))
+ (depth (1- (length org-section-numbers)))
+ (i depth) number-string)
+ (while (>= i 0)
+ (if (> i level)
+ (aset org-section-numbers i 0)
+ (setq number-string (or (car numbers) "0"))
+ (if (string-match "\\`[A-Z]\\'" number-string)
+ (aset org-section-numbers i
+ (- (string-to-char number-string) ?A -1))
+ (aset org-section-numbers i (string-to-number number-string)))
+ (pop numbers))
+ (setq i (1- i)))))
+
+(defun org-section-number (&optional level)
+ "Return a string with the current section number.
+When LEVEL is non-nil, increase section numbers on that level."
+ (let* ((depth (1- (length org-section-numbers)))
+ (string "")
+ (fmts (car org-export-section-number-format))
+ (term (cdr org-export-section-number-format))
+ (sep "")
+ ctype fmt idx n)
+ (when level
+ (when (> level -1)
+ (aset org-section-numbers
+ level (1+ (aref org-section-numbers level))))
+ (setq idx (1+ level))
+ (while (<= idx depth)
+ (if (not (= idx 1))
+ (aset org-section-numbers idx 0))
+ (setq idx (1+ idx))))
+ (setq idx 0)
+ (while (<= idx depth)
+ (when (> (aref org-section-numbers idx) 0)
+ (setq fmt (or (pop fmts) fmt)
+ ctype (car fmt)
+ n (aref org-section-numbers idx)
+ string (if (> n 0)
+ (concat string sep (org-number-to-counter n ctype))
+ (concat string ".0"))
+ sep (nth 1 fmt)))
+ (setq idx (1+ idx)))
+ (save-match-data
+ (if (string-match "\\`\\([@0]\\.\\)+" string)
+ (setq string (replace-match "" t nil string)))
+ (if (string-match "\\(\\.0\\)+\\'" string)
+ (setq string (replace-match "" t nil string))))
+ (concat string term)))
+
+(defun org-number-to-counter (n type)
+ "Concert number N to a string counter, according to TYPE.
+TYPE must be a string, any of:
+ 1 number
+ A A,B,....
+ a a,b,....
+ I upper case roman numeral
+ i lower case roman numeral"
+ (cond
+ ((equal type "1") (number-to-string n))
+ ((equal type "A") (char-to-string (+ ?A n -1)))
+ ((equal type "a") (char-to-string (+ ?a n -1)))
+ ((equal type "I") (org-number-to-roman n))
+ ((equal type "i") (downcase (org-number-to-roman n)))
+ (t (error "Invalid counter type `%s'" type))))
+
+(defun org-number-to-roman (n)
+ "Convert integer N into a roman numeral."
+ (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
+ ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
+ ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV")
+ ( 1 . "I")))
+ (res ""))
+ (if (<= n 0)
+ (number-to-string n)
+ (while roman
+ (if (>= n (caar roman))
+ (setq n (- n (caar roman))
+ res (concat res (cdar roman)))
+ (pop roman)))
+ res)))
+
+;;; Macros
+
+(defun org-export-preprocess-apply-macros ()
+ "Replace macro references."
+ (goto-char (point-min))
+ (let (sy val key args args2 ind-str s n)
+ (while (re-search-forward
+ "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
+ nil t)
+ (unless (save-match-data (save-excursion
+ (goto-char (point-at-bol))
+ (looking-at "[ \t]*#\\+macro")))
+ ;; Get macro name (KEY), arguments (ARGS), and indentation of
+ ;; current line (IND-STR) as strings.
+ (setq key (downcase (match-string 1))
+ args (match-string 3)
+ ind-str (save-match-data (save-excursion
+ (beginning-of-line)
+ (looking-at "^\\([ \t]*\\).*")
+ (match-string 1))))
+ ;; When macro is defined, retrieve replacement text in VAL,
+ ;; and proceed with expansion.
+ (when (setq val (or (plist-get org-export-opt-plist
+ (intern (concat ":macro-" key)))
+ (plist-get org-export-opt-plist
+ (intern (concat ":" key)))))
+ (save-match-data
+ ;; If arguments are provided, first retrieve them properly
+ ;; (in ARGS, as a list), then replace them in VAL.
+ (when args
+ (setq args (org-split-string args ",") args2 nil)
+ (while args
+ (while (string-match "\\\\\\'" (car args))
+ ;; Repair bad splits.
+ (setcar (cdr args) (concat (substring (car args) 0 -1)
+ "," (nth 1 args)))
+ (pop args))
+ (push (pop args) args2))
+ (setq args (mapcar 'org-trim (nreverse args2)))
+ (setq s 0)
+ (while (string-match "\\$\\([0-9]+\\)" val s)
+ (setq s (1+ (match-beginning 0))
+ n (string-to-number (match-string 1 val)))
+ (and (>= (length args) n)
+ (setq val (replace-match (nth (1- n) args) t t val)))))
+ ;; VAL starts with "(eval": it is a sexp, `eval' it.
+ (when (string-match "\\`(eval\\>" val)
+ (setq val (eval (read val))))
+ ;; Ensure VAL is a string (or nil) and that each new line
+ ;; is indented as the first one.
+ (setq val (and val
+ (mapconcat 'identity
+ (org-split-string
+ (if (stringp val) val (format "%s" val))
+ "\n")
+ (concat "\n" ind-str)))))
+ ;; Eventually do the replacement, if VAL isn't nil. Move
+ ;; point at beginning of macro for recursive expansions.
+ (when val
+ (replace-match val t t)
+ (goto-char (match-beginning 0))))))))
+
+(defun org-export-apply-macros-in-string (s)
+ "Apply the macros in string S."
+ (when s
+ (with-temp-buffer
+ (insert s)
+ (org-export-preprocess-apply-macros)
+ (buffer-string))))
+
+;;; Include files
+
+(defun org-export-handle-include-files ()
+ "Include the contents of include files, with proper formatting."
+ (let ((case-fold-search t)
+ params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines)
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t)
+ (setq params (read (concat "(" (match-string 1) ")"))
+ prefix (org-get-and-remove-property 'params :prefix)
+ prefix1 (org-get-and-remove-property 'params :prefix1)
+ minlevel (org-get-and-remove-property 'params :minlevel)
+ addlevel (org-get-and-remove-property 'params :addlevel)
+ lines (org-get-and-remove-property 'params :lines)
+ file (org-symname-or-string (pop params))
+ markup (org-symname-or-string (pop params))
+ lang (and (member markup '("src" "SRC"))
+ (org-symname-or-string (pop params)))
+ switches (mapconcat #'(lambda (x) (format "%s" x)) params " ")
+ start nil end nil)
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq currentlevel (or (org-current-level) 0))
+ (if (or (not file)
+ (not (file-exists-p file))
+ (not (file-readable-p file)))
+ (insert (format "CANNOT INCLUDE FILE %s" file))
+ (setq all (cons file all))
+ (when markup
+ (if (equal (downcase markup) "src")
+ (setq start (format "#+begin_src %s %s\n"
+ (or lang "fundamental")
+ (or switches ""))
+ end "#+end_src")
+ (setq start (format "#+begin_%s %s\n" markup switches)
+ end (format "#+end_%s" markup))))
+ (insert (or start ""))
+ (insert (org-get-file-contents (expand-file-name file)
+ prefix prefix1 markup currentlevel minlevel addlevel lines))
+ (or (bolp) (newline))
+ (insert (or end ""))))
+ all))
+
+(defun org-export-handle-include-files-recurse ()
+ "Recursively include files aborting on circular inclusion."
+ (let ((now (list org-current-export-file)) all)
+ (while now
+ (setq all (append now all))
+ (setq now (org-export-handle-include-files))
+ (let ((intersection
+ (delq nil
+ (mapcar (lambda (el) (when (member el all) el)) now))))
+ (when intersection
+ (error "Recursive #+INCLUDE: %S" intersection))))))
+
+(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines)
+ "Get the contents of FILE and return them as a string.
+If PREFIX is a string, prepend it to each line. If PREFIX1
+is a string, prepend it to the first line instead of PREFIX.
+If MARKUP, don't protect org-like lines, the exporter will
+take care of the block they are in. If ADDLEVEL is a number,
+demote included file to current heading level+ADDLEVEL.
+If LINES is a string specifying a range of lines,
+include only those lines."
+ (if (stringp markup) (setq markup (downcase markup)))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when lines
+ (let* ((lines (split-string lines "-"))
+ (lbeg (string-to-number (car lines)))
+ (lend (string-to-number (cadr lines)))
+ (beg (if (zerop lbeg) (point-min)
+ (goto-char (point-min))
+ (forward-line (1- lbeg))
+ (point)))
+ (end (if (zerop lend) (point-max)
+ (goto-char (point-min))
+ (forward-line (1- lend))
+ (point))))
+ (narrow-to-region beg end)))
+ (when (or prefix prefix1)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert (or prefix1 prefix))
+ (setq prefix1 "")
+ (beginning-of-line 2)))
+ (buffer-string)
+ (when (member markup '("src" "example"))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t)
+ (goto-char (match-beginning 0))
+ (insert ",")
+ (end-of-line 1)))
+ (when minlevel
+ (dotimes (lvl minlevel)
+ (org-map-region 'org-demote (point-min) (point-max))))
+ (when addlevel
+ (let ((inclevel (or (if (org-before-first-heading-p)
+ (1- (and (outline-next-heading)
+ (org-current-level)))
+ (1- (org-current-level)))
+ 0)))
+ (dotimes (level (- (+ parentlevel addlevel) inclevel))
+ (org-map-region 'org-demote (point-min) (point-max)))))
+ (buffer-string)))
+
+(defun org-get-and-remove-property (listvar prop)
+ "Check if the value of LISTVAR contains PROP as a property.
+If yes, return the value of that property (i.e. the element following
+in the list) and remove property and value from the list in LISTVAR."
+ (let ((list (symbol-value listvar)) m v)
+ (when (setq m (member prop list))
+ (setq v (nth 1 m))
+ (if (equal (car list) prop)
+ (set listvar (cddr list))
+ (setcdr (nthcdr (- (length list) (length m) 1) list)
+ (cddr m))
+ (set listvar list)))
+ v))
+
+(defun org-symname-or-string (s)
+ (if (symbolp s)
+ (if s (symbol-name s) s)
+ s))
+
+;;; Fontification and line numbers for code examples
+
+(defvar org-export-last-code-line-counter-value 0)
+
+(defun org-export-replace-src-segments-and-examples ()
+ "Replace source code segments with special code for export."
+ (setq org-export-last-code-line-counter-value 0)
+ (let ((case-fold-search t)
+ lang code trans opts indent caption)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)"
+ nil t)
+ (if (match-end 1)
+ (if (not (match-string 4))
+ (error "Source block missing language specification: %s"
+ (let* ((body (match-string 6))
+ (nothing (message "body:%s" body))
+ (preview (or (and (string-match
+ "^[ \t]*\\([^\n\r]*\\)" body)
+ (match-string 1 body)) body)))
+ (if (> (length preview) 35)
+ (concat (substring preview 0 32) "...")
+ preview)))
+ ;; src segments
+ (setq lang (match-string 4)
+ opts (match-string 5)
+ code (match-string 6)
+ indent (length (match-string 2))
+ caption (get-text-property 0 'org-caption (match-string 0))))
+ (setq lang nil
+ opts (match-string 9)
+ code (match-string 10)
+ indent (length (match-string 8))
+ caption (get-text-property 0 'org-caption (match-string 0))))
+
+ (setq trans (org-export-format-source-code-or-example
+ lang code opts indent caption))
+ (replace-match trans t t))))
+
+(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el
+(defvar org-export-latex-listings) ;; defined in org-latex.el
+(defvar org-export-latex-listings-langs) ;; defined in org-latex.el
+(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el
+(defvar org-export-latex-minted-langs) ;; defined in org-latex.el
+(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el
+(defvar org-export-latex-listings-options) ;; defined in org-latex.el
+(defvar org-export-latex-minted-options) ;; defined in org-latex.el
+
+(defun org-remove-formatting-on-newlines-in-region (beg end)
+ "Remove formatting on newline characters."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ (while (progn (end-of-line) (< (point) end))
+ (put-text-property (point) (1+ (point)) 'face nil)
+ (forward-char 1))))
+
+(defun org-export-format-source-code-or-example
+ (lang code &optional opts indent caption)
+ "Format CODE from language LANG and return it formatted for export.
+The CODE is marked up in `org-export-current-backend' format.
+
+Check if a function by name
+\"org-<backend>-format-source-code-or-example\" is bound. If yes,
+use it as the custom formatter. Otherwise, use the default
+formatter. Default formatters are provided for docbook, html,
+latex and ascii backends. For example, use
+`org-html-format-source-code-or-example' to provide a custom
+formatter for export to \"html\".
+
+If LANG is nil, do not add any fontification.
+OPTS contains formatting options, like `-n' for triggering numbering lines,
+and `+n' for continuing previous numbering.
+Code formatting according to language currently only works for HTML.
+Numbering lines works for all three major backends (html, latex, and ascii).
+INDENT was the original indentation of the block."
+ (save-match-data
+ (let* ((backend-name (symbol-name org-export-current-backend))
+ (backend-formatter
+ (intern (format "org-%s-format-source-code-or-example"
+ backend-name)))
+ (backend-feature (intern (concat "org-" backend-name)))
+ (backend-formatter
+ (and (require (intern (concat "org-" backend-name)) nil)
+ (fboundp backend-formatter) backend-formatter))
+ num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt)
+ (setq opts (or opts "")
+ num (string-match "[-+]n\\>" opts)
+ cont (string-match "\\+n\\>" opts)
+ rpllbl (string-match "-r\\>" opts)
+ keepp (string-match "-k\\>" opts)
+ textareap (string-match "-t\\>" opts)
+ preserve-indentp (or org-src-preserve-indentation
+ (string-match "-i\\>" opts))
+ cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts)
+ (string-to-number (match-string 1 opts))
+ 80)
+ rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts)
+ (string-to-number (match-string 1 opts))
+ (org-count-lines code))
+ fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts)
+ (match-string 1 opts)))
+ (when (and textareap (eq org-export-current-backend 'html))
+ ;; we cannot use numbering or highlighting.
+ (setq num nil cont nil lang nil))
+ (if keepp (setq rpllbl 'keep))
+ (setq rtn (if preserve-indentp code (org-remove-indentation code)))
+ (when (string-match "^," rtn)
+ (setq rtn (with-temp-buffer
+ (insert rtn)
+ ;; Free up the protected lines
+ (goto-char (point-min))
+ (while (re-search-forward "^," nil t)
+ (if (or (equal lang "org")
+ (save-match-data
+ (looking-at "\\([*#]\\|[ \t]*#\\+\\)")))
+ (replace-match ""))
+ (end-of-line 1))
+ (buffer-string))))
+ ;; Now backend-specific coding
+ (setq rtn
+ (cond
+ (backend-formatter
+ (funcall backend-formatter rtn lang caption textareap cols rows num
+ cont rpllbl fmt))
+ ((eq org-export-current-backend 'docbook)
+ (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
+ (concat "<programlisting><![CDATA["
+ rtn
+ "]]></programlisting>\n"))
+ ((eq org-export-current-backend 'html)
+ ;; We are exporting to HTML
+ (when lang
+ (if (featurep 'xemacs)
+ (require 'htmlize)
+ (require 'htmlize nil t))
+ (when (not (fboundp 'htmlize-region-for-paste))
+ ;; we do not have htmlize.el, or an old version of it
+ (setq lang nil)
+ (message
+ "htmlize.el 1.34 or later is needed for source code formatting")))
+
+ (if lang
+ (let* ((lang-m (when lang
+ (or (cdr (assoc lang org-src-lang-modes))
+ lang)))
+ (mode (and lang-m (intern
+ (concat
+ (if (symbolp lang-m)
+ (symbol-name lang-m)
+ lang-m)
+ "-mode"))))
+ (org-inhibit-startup t)
+ (org-startup-folded nil))
+ (setq rtn
+ (with-temp-buffer
+ (insert rtn)
+ (if (functionp mode)
+ (funcall mode)
+ (fundamental-mode))
+ (font-lock-fontify-buffer)
+ ;; markup each line separately
+ (org-remove-formatting-on-newlines-in-region (point-min) (point-max))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ (org-export-htmlize-region-for-paste
+ (point-min) (point-max))))
+ (if (string-match "<pre\\([^>]*\\)>\n*" rtn)
+ (setq rtn
+ (concat
+ (if caption
+ (concat
+ "<div class=\"org-src-container\">"
+ (format
+ "<label class=\"org-src-name\">%s</label>"
+ caption))
+ "")
+ (replace-match
+ (format "<pre class=\"src src-%s\">\n" lang)
+ t t rtn)
+ (if caption "</div>" "")))))
+ (if textareap
+ (setq rtn (concat
+ (format "<p>\n<textarea cols=\"%d\" rows=\"%d\">"
+ cols rows)
+ rtn "</textarea>\n</p>\n"))
+ (with-temp-buffer
+ (insert rtn)
+ (goto-char (point-min))
+ (while (re-search-forward "[<>&]" nil t)
+ (replace-match (cdr (assq (char-before)
+ '((?&."&amp;")(?<."&lt;")(?>."&gt;"))))
+ t t))
+ (setq rtn (buffer-string)))
+ (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n"))))
+ (unless textareap
+ (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt)))
+ (if (string-match "\\(\\`<[^>]*>\\)\n" rtn)
+ (setq rtn (replace-match "\\1" t nil rtn)))
+ rtn)
+ ((eq org-export-current-backend 'latex)
+ (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
+ (cond
+ ((and lang org-export-latex-listings)
+ (let* ((make-option-string
+ (lambda (pair)
+ (concat (first pair)
+ (if (> (length (second pair)) 0)
+ (concat "=" (second pair))))))
+ (lang-sym (intern lang))
+ (minted-p (eq org-export-latex-listings 'minted))
+ (listings-p (not minted-p))
+ (backend-lang
+ (or (cadr
+ (assq
+ lang-sym
+ (cond
+ (minted-p org-export-latex-minted-langs)
+ (listings-p org-export-latex-listings-langs))))
+ lang))
+ (custom-environment
+ (cadr
+ (assq
+ lang-sym
+ org-export-latex-custom-lang-environments))))
+ (concat
+ (when (and listings-p (not custom-environment))
+ (format
+ "\\lstset{%s}\n"
+ (mapconcat
+ make-option-string
+ (append org-export-latex-listings-options
+ `(("language" ,backend-lang))) ",")))
+ (when (and caption org-export-latex-listings-w-names)
+ (format
+ "\n%s $\\equiv$ \n"
+ (replace-regexp-in-string "_" "\\\\_" caption)))
+ (cond
+ (custom-environment
+ (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-environment rtn custom-environment))
+ (listings-p
+ (format "\\begin{%s}\n%s\\end{%s}"
+ "lstlisting" rtn "lstlisting"))
+ (minted-p
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ (mapconcat make-option-string
+ org-export-latex-minted-options ",")
+ backend-lang rtn))))))
+ (t (concat (car org-export-latex-verbatim-wrap)
+ rtn (cdr org-export-latex-verbatim-wrap)))))
+ ((eq org-export-current-backend 'ascii)
+ ;; This is not HTML or LaTeX, so just make it an example.
+ (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
+ (concat caption "\n"
+ (concat
+ (mapconcat
+ (lambda (l) (concat " " l))
+ (org-split-string rtn "\n")
+ "\n")
+ "\n")))
+ (t
+ (error "Don't know how to markup source or example block in %s"
+ (upcase backend-name)))))
+ (setq rtn
+ (concat
+ "\n#+BEGIN_" backend-name "\n"
+ (org-add-props rtn
+ '(org-protected t org-example t org-native-text t))
+ "\n#+END_" backend-name "\n"))
+ (org-add-props rtn nil 'original-indentation indent))))
+
+(defun org-export-number-lines (text &optional skip1 skip2 number cont
+ replace-labels label-format preprocess)
+ "Apply line numbers to literal examples and handle code references.
+Handle user-specified options under info node `(org)Literal
+examples' and return the modified source block.
+
+TEXT contains the source or example block.
+
+SKIP1 and SKIP2 are the number of lines that are to be skipped at
+the beginning and end of TEXT. Use these to skip over
+backend-specific lines pre-pended or appended to the original
+source block.
+
+NUMBER is non-nil if the literal example specifies \"+n\" or
+\"-n\" switch. If NUMBER is non-nil add line numbers.
+
+CONT is non-nil if the literal example specifies \"+n\" switch.
+If CONT is nil, start numbering this block from 1. Otherwise
+continue numbering from the last numbered block.
+
+REPLACE-LABELS is dual-purpose.
+1. It controls the retention of labels in the exported block.
+2. It specifies in what manner the links (or references) to a
+ labeled line be formatted.
+
+REPLACE-LABELS is the symbol `keep' if the literal example
+specifies \"-k\" option, is numeric if the literal example
+specifies \"-r\" option and is nil otherwise.
+
+Handle REPLACE-LABELS as below:
+- If nil, retain labels in the exported block and use
+ user-provided labels for referencing the labeled lines.
+- If it is a number, remove labels in the exported block and use
+ one of line numbers or labels for referencing labeled lines based
+ on NUMBER option.
+- If it is a keep, retain labels in the exported block and use
+ one of line numbers or labels for referencing labeled lines
+ based on NUMBER option.
+
+LABEL-FORMAT is the value of \"-l\" switch associated with
+literal example. See `org-coderef-label-format'.
+
+PREPROCESS is intended for backend-agnostic handling of source
+block numbering. When non-nil do the following:
+- do not number the lines
+- always strip the labels from exported block
+- do not make the labeled line a target of an incoming link.
+ Instead mark the labeled line with `org-coderef' property and
+ store the label in it."
+ (setq skip1 (or skip1 0) skip2 (or skip2 0))
+ (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0))
+ (with-temp-buffer
+ (insert text)
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n\r")
+ (delete-region (point) (point-max))
+ (beginning-of-line (- 1 skip2))
+ (let* ((last (org-current-line))
+ (n org-export-last-code-line-counter-value)
+ (nmax (+ n (- last skip1)))
+ (fmt (format "%%%dd: " (length (number-to-string nmax))))
+ (fm
+ (cond
+ ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
+ fmt))
+ ((eq org-export-current-backend 'ascii) fmt)
+ ((eq org-export-current-backend 'latex) fmt)
+ ((eq org-export-current-backend 'docbook) fmt)
+ (t "")))
+ (label-format (or label-format org-coderef-label-format))
+ (label-pre (if (string-match "%s" label-format)
+ (substring label-format 0 (match-beginning 0))
+ label-format))
+ (label-post (if (string-match "%s" label-format)
+ (substring label-format (match-end 0))
+ ""))
+ (lbl-re
+ (concat
+ ".*?\\S-.*?\\([ \t]*\\("
+ (regexp-quote label-pre)
+ "\\([-a-zA-Z0-9_ ]+\\)"
+ (regexp-quote label-post)
+ "\\)\\)"))
+ ref)
+
+ (org-goto-line (1+ skip1))
+ (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax))
+ (when number (incf n))
+ (if (or preprocess (not number))
+ (forward-char 1)
+ (insert (format fm n)))
+ (when (looking-at lbl-re)
+ (setq ref (match-string 3))
+ (cond ((numberp replace-labels)
+ ;; remove labels; use numbers for references when lines
+ ;; are numbered, use labels otherwise
+ (delete-region (match-beginning 1) (match-end 1))
+ (push (cons ref (if (> n 0) n ref)) org-export-code-refs))
+ ((eq replace-labels 'keep)
+ ;; don't remove labels; use numbers for references when
+ ;; lines are numbered, use labels otherwise
+ (goto-char (match-beginning 2))
+ (delete-region (match-beginning 2) (match-end 2))
+ (unless preprocess
+ (insert "(" ref ")"))
+ (push (cons ref (if (> n 0) n (concat "(" ref ")")))
+ org-export-code-refs))
+ (t
+ ;; don't remove labels and don't use numbers for
+ ;; references
+ (goto-char (match-beginning 2))
+ (delete-region (match-beginning 2) (match-end 2))
+ (unless preprocess
+ (insert "(" ref ")"))
+ (push (cons ref (concat "(" ref ")")) org-export-code-refs)))
+ (when (and (eq org-export-current-backend 'html) (not preprocess))
+ (save-excursion
+ (beginning-of-line 1)
+ (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">"
+ ref))
+ (end-of-line 1)
+ (insert "</span>")))
+ (when preprocess
+ (add-text-properties
+ (point-at-bol) (point-at-eol) (list 'org-coderef ref)))))
+ (setq org-export-last-code-line-counter-value n)
+ (goto-char (point-max))
+ (newline)
+ (buffer-string))))
+
+(defun org-search-todo-below (line lines level)
+ "Search the subtree below LINE for any TODO entries."
+ (let ((rest (cdr (memq line lines)))
+ (re org-todo-line-regexp)
+ line lv todo)
+ (catch 'exit
+ (while (setq line (pop rest))
+ (if (string-match re line)
+ (progn
+ (setq lv (- (match-end 1) (match-beginning 1))
+ todo (and (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords))))
+ ; TODO, not DONE
+ (if (<= lv level) (throw 'exit nil))
+ (if todo (throw 'exit t))))))))
+
+;;;###autoload
+(defun org-export-visible (type arg)
+ "Create a copy of the visible part of the current buffer, and export it.
+The copy is created in a temporary buffer and removed after use.
+TYPE is the final key (as a string) that also selects the export command in
+the \\<org-mode-map>\\[org-export] export dispatcher.
+As a special case, if the you type SPC at the prompt, the temporary
+org-mode file will not be removed but presented to you so that you can
+continue to use it. The prefix arg ARG is passed through to the exporting
+command."
+ (interactive
+ (list (progn
+ (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer")
+ (read-char-exclusive))
+ current-prefix-arg))
+ (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R)))
+ (error "Invalid export key"))
+ (let* ((binding (cdr (assoc type
+ '(
+ (?a . org-export-as-ascii)
+ (?A . org-export-as-ascii-to-buffer)
+ (?n . org-export-as-latin1)
+ (?N . org-export-as-latin1-to-buffer)
+ (?u . org-export-as-utf8)
+ (?U . org-export-as-utf8-to-buffer)
+ (?\C-a . org-export-as-ascii)
+ (?b . org-export-as-html-and-open)
+ (?\C-b . org-export-as-html-and-open)
+ (?h . org-export-as-html)
+ (?H . org-export-as-html-to-buffer)
+ (?R . org-export-region-as-html)
+ (?D . org-export-as-docbook)
+
+ (?l . org-export-as-latex)
+ (?p . org-export-as-pdf)
+ (?d . org-export-as-pdf-and-open)
+ (?L . org-export-as-latex-to-buffer)
+
+ (?x . org-export-as-xoxo)))))
+ (keepp (equal type ?\ ))
+ (file buffer-file-name)
+ (buffer (get-buffer-create "*Org Export Visible*"))
+ s e)
+ ;; Need to hack the drawers here.
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (goto-char (match-beginning 1))
+ (or (outline-invisible-p) (org-flag-drawer nil))))
+ (with-current-buffer buffer (erase-buffer))
+ (save-excursion
+ (setq s (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (org-find-invisible))
+ (append-to-buffer buffer s (point))
+ (setq s (goto-char (org-find-visible))))
+ (org-cycle-hide-drawers 'all)
+ (goto-char (point-min))
+ (unless keepp
+ ;; Copy all comment lines to the end, to make sure #+ settings are
+ ;; still available for the second export step. Kind of a hack, but
+ ;; does do the trick.
+ (if (looking-at "#[^\r\n]*")
+ (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
+ (when (re-search-forward "^\\*+[ \t]+" nil t)
+ (while (re-search-backward "[\n\r]#[^\n\r]*" nil t)
+ (append-to-buffer buffer (1+ (match-beginning 0))
+ (min (point-max) (1+ (match-end 0)))))))
+ (set-buffer buffer)
+ (let ((buffer-file-name file)
+ (org-inhibit-startup t))
+ (org-mode)
+ (show-all)
+ (unless keepp (funcall binding arg))))
+ (if (not keepp)
+ (kill-buffer buffer)
+ (switch-to-buffer-other-window buffer)
+ (goto-char (point-min)))))
+
+(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
+
+(defun org-export-string (string fmt &optional dir)
+ "Export STRING to FMT using existing export facilities.
+During export STRING is saved to a temporary file whose location
+could vary. Optional argument DIR can be used to force the
+directory in which the temporary file is created during export
+which can be useful for resolving relative paths. Dir defaults
+to the value of `temporary-file-directory'."
+ (let ((temporary-file-directory (or dir temporary-file-directory))
+ (tmp-file (make-temp-file "org-")))
+ (unwind-protect
+ (with-temp-buffer
+ (insert string)
+ (write-file tmp-file)
+ (org-load-modules-maybe)
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
+ (eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode'
+ (list 'let org-local-vars
+ (list (intern (format "org-export-as-%s" fmt))
+ nil nil nil ''string t))))
+ (delete-file tmp-file))))
+
+;;;###autoload
+(defun org-export-as-org (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Make a copy with not-exporting stuff removed.
+The purpose of this function is to provide a way to export the source
+Org file of a webpage in Org format, but with sensitive and/or irrelevant
+stuff removed. This command will remove the following:
+
+- archived trees (if the variable `org-export-with-archived-trees' is nil)
+- comment blocks and trees starting with the COMMENT keyword
+- only trees that are consistent with `org-export-select-tags'
+ and `org-export-exclude-tags'.
+
+The only arguments that will be used are EXT-PLIST and PUB-DIR,
+all the others will be ignored (but are present so that the general
+mechanism to call publishing functions will work).
+
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When PUB-DIR is set, use this as the publishing
+directory."
+ (interactive "P")
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist)))
+ (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ (filename (concat (file-name-as-directory
+ (or pub-dir
+ (org-export-directory :org opt-plist)))
+ (file-name-sans-extension
+ (file-name-nondirectory bfname))
+ ".org"))
+ (filename (and filename
+ (if (equal (file-truename filename)
+ (file-truename bfname))
+ (concat (file-name-sans-extension filename)
+ "-source."
+ (file-name-extension filename))
+ filename)))
+ (backup-inhibited t)
+ (buffer (find-file-noselect filename))
+ (region (buffer-string))
+ str-ret)
+ (save-excursion
+ (org-pop-to-buffer-same-window buffer)
+ (erase-buffer)
+ (insert region)
+ (let ((org-inhibit-startup t)) (org-mode))
+ (org-install-letbind)
+
+ ;; Get rid of archived trees
+ (org-export-remove-archived-trees (plist-get opt-plist :archived-trees))
+
+ ;; Remove comment environment and comment subtrees
+ (org-export-remove-comment-blocks-and-subtrees)
+
+ ;; Get rid of excluded trees
+ (org-export-handle-export-tags (plist-get opt-plist :select-tags)
+ (plist-get opt-plist :exclude-tags))
+
+ (when (or (plist-get opt-plist :plain-source)
+ (not (or (plist-get opt-plist :plain-source)
+ (plist-get opt-plist :htmlized-source))))
+ ;; Either nothing special is requested (default call)
+ ;; or the plain source is explicitly requested
+ ;; so: save it
+ (save-buffer))
+ (when (plist-get opt-plist :htmlized-source)
+ ;; Make the htmlized version
+ (require 'htmlize)
+ (require 'org-html)
+ (font-lock-fontify-buffer)
+ (let* ((htmlize-output-type 'css)
+ (newbuf (htmlize-buffer)))
+ (with-current-buffer newbuf
+ (when org-export-htmlized-org-css-url
+ (goto-char (point-min))
+ (and (re-search-forward
+ "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*"
+ nil t)
+ (replace-match
+ (format
+ "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
+ org-export-htmlized-org-css-url)
+ t t)))
+ (write-file (concat filename ".html")))
+ (kill-buffer newbuf)))
+ (set-buffer-modified-p nil)
+ (if (equal to-buffer 'string)
+ (progn (setq str-ret (buffer-string))
+ (kill-buffer (current-buffer))
+ str-ret)
+ (kill-buffer (current-buffer))))))
+
+(defvar org-archive-location) ;; gets loaded with the org-archive require.
+(defun org-get-current-options ()
+ "Return a string with current options as keyword options.
+Does include HTML export options as well as TODO and CATEGORY stuff."
+ (require 'org-archive)
+ (format
+ "#+TITLE: %s
+#+AUTHOR: %s
+#+EMAIL: %s
+#+DATE: %s
+#+DESCRIPTION:
+#+KEYWORDS:
+#+LANGUAGE: %s
+#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s
+#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s
+%s
+#+EXPORT_SELECT_TAGS: %s
+#+EXPORT_EXCLUDE_TAGS: %s
+#+LINK_UP: %s
+#+LINK_HOME: %s
+#+XSLT:
+#+CATEGORY: %s
+#+SEQ_TODO: %s
+#+TYP_TODO: %s
+#+PRIORITIES: %c %c %c
+#+DRAWERS: %s
+#+STARTUP: %s %s %s %s %s
+#+TAGS: %s
+#+FILETAGS: %s
+#+ARCHIVE: %s
+#+LINK: %s
+"
+ (buffer-name) (user-full-name) user-mail-address
+ (format-time-string (substring (car org-time-stamp-formats) 1 -1))
+ org-export-default-language
+ org-export-headline-levels
+ org-export-with-section-numbers
+ org-export-with-toc
+ org-export-preserve-breaks
+ org-export-html-expand
+ org-export-with-fixed-width
+ org-export-with-tables
+ org-export-with-sub-superscripts
+ org-export-with-special-strings
+ org-export-with-footnotes
+ org-export-with-emphasize
+ org-export-with-timestamps
+ org-export-with-TeX-macros
+ org-export-with-LaTeX-fragments
+ org-export-skip-text-before-1st-heading
+ org-export-with-drawers
+ org-export-with-todo-keywords
+ org-export-with-priority
+ org-export-with-tags
+ (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "")
+ (mapconcat 'identity org-export-select-tags " ")
+ (mapconcat 'identity org-export-exclude-tags " ")
+ org-export-html-link-up
+ org-export-html-link-home
+ (or (ignore-errors
+ (file-name-sans-extension
+ (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))
+ "NOFILENAME")
+ "TODO FEEDBACK VERIFY DONE"
+ "Me Jason Marie DONE"
+ org-highest-priority org-lowest-priority org-default-priority
+ (mapconcat 'identity org-drawers " ")
+ (cdr (assoc org-startup-folded
+ '((nil . "showall") (t . "overview") (content . "content"))))
+ (if org-odd-levels-only "odd" "oddeven")
+ (if org-hide-leading-stars "hidestars" "showstars")
+ (if org-startup-align-all-tables "align" "noalign")
+ (cond ((eq org-log-done t) "logdone")
+ ((equal org-log-done 'note) "lognotedone")
+ ((not org-log-done) "nologdone"))
+ (or (mapconcat (lambda (x)
+ (cond
+ ((equal :startgroup (car x)) "{")
+ ((equal :endgroup (car x)) "}")
+ ((equal :newline (car x)) "")
+ ((cdr x) (format "%s(%c)" (car x) (cdr x)))
+ (t (car x))))
+ (or org-tag-alist (org-get-buffer-tags)) " ") "")
+ (mapconcat 'identity org-file-tags " ")
+ org-archive-location
+ "org file:~/org/%s.org"))
+
+;;;###autoload
+(defun org-insert-export-options-template ()
+ "Insert into the buffer a template with information for exporting."
+ (interactive)
+ (if (not (bolp)) (newline))
+ (let ((s (org-get-current-options)))
+ (and (string-match "#\\+CATEGORY" s)
+ (setq s (substring s 0 (match-beginning 0))))
+ (insert s)))
+
+(defvar org-table-colgroup-info nil)
+
+(defun org-table-clean-before-export (lines &optional maybe-quoted)
+ "Check if the table has a marking column.
+If yes remove the column and the special lines."
+ (setq org-table-colgroup-info nil)
+ (if (memq nil
+ (mapcar
+ (lambda (x) (or (string-match "^[ \t]*|-" x)
+ (string-match
+ (if maybe-quoted
+ "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|"
+ "^[ \t]*| *\\([\#!$*_^ /]\\) *|")
+ x)))
+ lines))
+ ;; No special marking column
+ (progn
+ (setq org-table-clean-did-remove-column nil)
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond
+ ((org-table-colgroup-line-p x)
+ ;; This line contains colgroup info, extract it
+ ;; and then discard the line
+ (setq org-table-colgroup-info
+ (mapcar (lambda (x)
+ (cond ((member x '("<" "&lt;")) :start)
+ ((member x '(">" "&gt;")) :end)
+ ((member x '("<>" "&lt;&gt;")) :startend)))
+ (org-split-string x "[ \t]*|[ \t]*")))
+ nil)
+ ((org-table-cookie-line-p x)
+ ;; This line contains formatting cookies, discard it
+ nil)
+ (t x)))
+ lines)))
+ ;; there is a special marking column
+ (setq org-table-clean-did-remove-column t)
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond
+ ((org-table-colgroup-line-p x)
+ ;; This line contains colgroup info, extract it
+ ;; and then discard the line
+ (setq org-table-colgroup-info
+ (mapcar (lambda (x)
+ (cond ((member x '("<" "&lt;")) :start)
+ ((member x '(">" "&gt;")) :end)
+ ((member x '("<>" "&lt;&gt;")) :startend)))
+ (cdr (org-split-string x "[ \t]*|[ \t]*"))))
+ nil)
+ ((org-table-cookie-line-p x)
+ ;; This line contains formatting cookies, discard it
+ nil)
+ ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x)
+ ;; ignore this line
+ nil)
+ ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
+ (string-match "^\\([ \t]*\\)|[^|]*|" x))
+ ;; remove the first column
+ (replace-match "\\1|" t nil x))))
+ lines))))
+
+(defun org-export-cleanup-toc-line (s)
+ "Remove tags and timestamps from lines going into the toc."
+ (if (not s)
+ "" ; Return a string when argument is nil
+ (when (memq org-export-with-tags '(not-in-toc nil))
+ (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
+ (setq s (replace-match "" t t s))))
+ (when org-export-remove-timestamps-from-toc
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (setq s (replace-match "" t t s))))
+ (while (string-match org-bracket-link-regexp s)
+ (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
+ t t s)))
+ (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
+ (setq s (replace-match "" t t s)))
+ s))
+
+
+(defun org-get-text-property-any (pos prop &optional object)
+ (or (get-text-property pos prop object)
+ (and (setq pos (next-single-property-change pos prop object))
+ (get-text-property pos prop object))))
+
+(defun org-export-get-coderef-format (path desc)
+ (save-match-data
+ (if (and desc (string-match
+ (regexp-quote (concat "(" path ")"))
+ desc))
+ (replace-match "%s" t t desc)
+ (or desc "%s"))))
+
+(defun org-export-push-to-kill-ring (format)
+ "Push buffer content to kill ring.
+The depends on the variable `org-export-copy-to-kill-ring'."
+ (when org-export-copy-to-kill-ring
+ (org-kill-new (buffer-string))
+ (when (fboundp 'x-set-selection)
+ (ignore-errors (x-set-selection 'PRIMARY (buffer-string)))
+ (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string))))
+ (message "%s export done, pushed to kill ring and clipboard" format)))
+
+(provide 'org-exp)
+
+;;; org-exp.el ends here
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
new file mode 100644
index 0000000..cfa4c1c
--- /dev/null
+++ b/lisp/org-faces.el
@@ -0,0 +1,781 @@
+;;; org-faces.el --- Face definitions for Org-mode.
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the face definitions for Org.
+
+;;; Code:
+
+(require 'org-macs)
+(require 'org-compat)
+
+(defun org-copy-face (old-face new-face docstring &rest attributes)
+ (unless (facep new-face)
+ (if (fboundp 'set-face-attribute)
+ (progn
+ (make-face new-face)
+ (set-face-attribute new-face nil :inherit old-face)
+ (apply 'set-face-attribute new-face nil attributes)
+ (set-face-doc-string new-face docstring))
+ (copy-face old-face new-face)
+ (if (fboundp 'set-face-doc-string)
+ (set-face-doc-string new-face docstring)))))
+(put 'org-copy-face 'lisp-indent-function 2)
+
+(defgroup org-faces nil
+ "Faces in Org-mode."
+ :tag "Org Faces"
+ :group 'org-appearance)
+
+(defface org-default
+ (org-compatible-face 'default nil)
+ "Face used for default text."
+ :group 'org-faces)
+
+(defface org-hide
+ '((((background light)) (:foreground "white"))
+ (((background dark)) (:foreground "black")))
+ "Face used to hide leading stars in headlines.
+The foreground color of this face should be equal to the background
+color of the frame."
+ :group 'org-faces)
+
+(defface org-level-1 ;; originally copied from font-lock-function-name-face
+ (org-compatible-face 'outline-1
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t))))
+ "Face used for level 1 headlines."
+ :group 'org-faces)
+
+(defface org-level-2 ;; originally copied from font-lock-variable-name-face
+ (org-compatible-face 'outline-2
+ '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 8) (background light)) (:foreground "yellow"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
+ (t (:bold t))))
+ "Face used for level 2 headlines."
+ :group 'org-faces)
+
+(defface org-level-3 ;; originally copied from font-lock-keyword-face
+ (org-compatible-face 'outline-3
+ '((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
+ (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
+ (t (:bold t))))
+ "Face used for level 3 headlines."
+ :group 'org-faces)
+
+(defface org-level-4 ;; originally copied from font-lock-comment-face
+ (org-compatible-face 'outline-4
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 16) (background light)) (:foreground "red"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t))))
+ "Face used for level 4 headlines."
+ :group 'org-faces)
+
+(defface org-level-5 ;; originally copied from font-lock-type-face
+ (org-compatible-face 'outline-5
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))))
+ "Face used for level 5 headlines."
+ :group 'org-faces)
+
+(defface org-level-6 ;; originally copied from font-lock-constant-face
+ (org-compatible-face 'outline-6
+ '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
+ (((class color) (min-colors 8)) (:foreground "magenta"))))
+ "Face used for level 6 headlines."
+ :group 'org-faces)
+
+(defface org-level-7 ;; originally copied from font-lock-builtin-face
+ (org-compatible-face 'outline-7
+ '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue"))))
+ "Face used for level 7 headlines."
+ :group 'org-faces)
+
+(defface org-level-8 ;; originally copied from font-lock-string-face
+ (org-compatible-face 'outline-8
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+ (((class color) (min-colors 8)) (:foreground "green"))))
+ "Face used for level 8 headlines."
+ :group 'org-faces)
+
+(defface org-special-keyword ;; originally copied from font-lock-string-face
+ (org-compatible-face 'font-lock-keyword-face
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+ (t (:italic t))))
+ "Face used for special keywords."
+ :group 'org-faces)
+
+(defface org-drawer ;; originally copied from font-lock-function-name-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t))))
+ "Face used for drawers."
+ :group 'org-faces)
+
+(defface org-property-value nil
+ "Face used for the value of a property."
+ :group 'org-faces)
+
+(defface org-column
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"
+ :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (t (:inverse-video t))))
+ "Face for column display of entry properties.
+This is actually only part of the face definition for the text in column view.
+The following faces apply, with this priority.
+
+1. The color of the reference face. This is normally the level fact that
+ is used in the outline. In agenda-mode, it will be the face of the
+ first character in the line. The color is explicitly retained to
+ make sure that the column line still looks a bit like the structure
+ line it is masking.
+
+2. The `org-column' face.
+
+3. The remaining properties of the reference face.
+
+Since column view works by putting overlays with a display property
+over individual characters in the buffer, the face of the underlining
+character (this might for example be the a TODO keyword) might still
+shine through in some properties. So when your column view looks
+funny, with \"random\" colors, weight, strike-through, try to explicitly
+set the properties in the `org-column' face. For example, set
+:underline to nil, or the :slant to `normal'.
+
+Under XEmacs, the rules are simpler, because the XEmacs version of
+column view defines special faces for each outline level. See the file
+`org-colview-xemacs.el' for details."
+ :group 'org-faces)
+
+(defface org-column-title
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :underline t :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :underline t :weight bold))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black" :underline t :weight bold))
+ (t (:inverse-video t))))
+ "Face for column display of entry properties."
+ :group 'org-faces)
+
+(when (fboundp 'set-face-attribute)
+ ;; Make sure that a fixed-width face is used when we have a column table.
+ (set-face-attribute 'org-column nil
+ :height (face-attribute 'default :height)
+ :family (face-attribute 'default :family)))
+
+(defface org-agenda-column-dateline
+ (org-compatible-face 'org-column
+ '((t nil)))
+ "Face used in agenda column view for datelines with summaries."
+ :group 'org-faces)
+
+(defface org-warning
+ (org-compatible-face 'font-lock-warning-face
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t))))
+ "Face for deadlines and TODO keywords."
+ :group 'org-faces)
+
+(defface org-archived ; similar to shadow
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face for headline with the ARCHIVE tag."
+ :group 'org-faces)
+
+(defface org-link
+ (org-compatible-face 'link
+ '((((class color) (background light)) (:foreground "Purple" :underline t))
+ (((class color) (background dark)) (:foreground "Cyan" :underline t))
+ (t (:underline t))))
+ "Face for links."
+ :group 'org-faces)
+
+(defface org-footnote
+ '((((class color) (background light)) (:foreground "Purple" :underline t))
+ (((class color) (background dark)) (:foreground "Cyan" :underline t))
+ (t (:underline t)))
+ "Face for links."
+ :group 'org-faces)
+
+(defface org-ellipsis
+ '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
+ (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t))
+ (t (:strike-through t)))
+ "Face for the ellipsis in folded text."
+ :group 'org-faces)
+
+(defface org-target
+ '((((class color) (background light)) (:underline t))
+ (((class color) (background dark)) (:underline t))
+ (t (:underline t)))
+ "Face for link targets."
+ :group 'org-faces)
+
+(defface org-date
+ '((((class color) (background light)) (:foreground "Purple" :underline t))
+ (((class color) (background dark)) (:foreground "Cyan" :underline t))
+ (t (:underline t)))
+ "Face for date/time stamps."
+ :group 'org-faces)
+
+(defface org-date-selected
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
+ (t (:inverse-video t))))
+ "Face for highlighting the calendar day when using `org-read-date'.
+Using a bold face here might cause discrepencies while displaying the
+calendar."
+ :group 'org-faces)
+
+(defface org-sexp-date
+ '((((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (t (:underline t)))
+ "Face for diary-like sexp date specifications."
+ :group 'org-faces)
+
+(defface org-tag
+ '((t (:bold t)))
+ "Default face for tags.
+Note that the variable `org-tag-faces' can be used to overrule this face for
+specific tags."
+ :group 'org-faces)
+
+(defface org-list-dt
+ '((t (:bold t)))
+ "Default face for definition terms in lists."
+ :group 'org-faces)
+
+(defface org-todo ; font-lock-warning-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:inverse-video t :bold t))))
+ "Face for TODO keywords."
+ :group 'org-faces)
+
+(defface org-done ;; originally copied from font-lock-type-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t))))
+ "Face used for todo keywords that indicate DONE items."
+ :group 'org-faces)
+
+(defface org-agenda-done ;; originally copied from font-lock-type-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold nil))))
+ "Face used in agenda, to indicate lines switched to DONE.
+This face is used to de-emphasize items that where brightly colored in the
+agenda because they were things to do, or overdue. The DONE state itself
+is of course immediately visible, but for example a passed deadline is
+\(by default) very bright read. This face could be simply the default face
+of the frame, for example."
+ :group 'org-faces)
+
+(defface org-headline-done ;; originally copied from font-lock-string-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+ (((class color) (min-colors 8) (background light)) (:bold nil))))
+ "Face used to indicate that a headline is DONE.
+This face is only used if `org-fontify-done-headline' is set. If applies
+to the part of the headline after the DONE keyword."
+ :group 'org-faces)
+
+(defcustom org-faces-easy-properties
+ '((todo . :foreground) (tag . :foreground) (priority . :foreground))
+ "The property changes by easy faces.
+This is an alist, the keys show the area of application, the values
+can be `:foreground' or `:background'. A color string for special
+keywords will then be interpreted as either foreground or background
+color."
+ :group 'org-faces
+ :group 'org-todo
+ :version "24.1"
+ :type '(repeat
+ (cons (choice (const todo) (const tag) (const priority))
+ (choice (const :foreground) (const :background)))))
+
+(defcustom org-todo-keyword-faces nil
+ "Faces for specific TODO keywords.
+This is a list of cons cells, with TODO keywords in the car
+and faces in the cdr. The face can be a symbol, a color
+as a string (in which case the rest is inherited from the `org-todo' face),
+or a property list of attributes, like
+ (:foreground \"blue\" :weight bold :underline t).
+If it is a color string, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
+ :group 'org-faces
+ :group 'org-todo
+ :type '(repeat
+ (cons
+ (string :tag "Keyword")
+ (choice :tag "Face "
+ (string :tag "Color")
+ (sexp :tag "Face")))))
+
+(defcustom org-priority-faces nil
+ "Faces for specific Priorities.
+This is a list of cons cells, with priority character in the car
+and faces in the cdr. The face can be a symbol, a color as
+as a string, or a property list of attributes, like
+ (:foreground \"blue\" :weight bold :underline t).
+If it is a color string, the variable `org-faces-easy-properties'
+determines if it is a foreground or a background color."
+ :group 'org-faces
+ :group 'org-todo
+ :type '(repeat
+ (cons
+ (character :tag "Priority")
+ (choice :tag "Face "
+ (string :tag "Color")
+ (sexp :tag "Face")))))
+
+(defvar org-tags-special-faces-re nil)
+(defun org-set-tag-faces (var value)
+ (set var value)
+ (if (not value)
+ (setq org-tags-special-faces-re nil)
+ (setq org-tags-special-faces-re
+ (concat ":\\(" (mapconcat 'car value "\\|") "\\):"))))
+
+(defface org-checkbox
+ (org-compatible-face 'bold
+ '((t (:bold t))))
+ "Face for checkboxes."
+ :group 'org-faces)
+
+
+(org-copy-face 'org-todo 'org-checkbox-statistics-todo
+ "Face used for unfinished checkbox statistics.")
+
+(org-copy-face 'org-done 'org-checkbox-statistics-done
+ "Face used for finished checkbox statistics.")
+
+(defcustom org-tag-faces nil
+ "Faces for specific tags.
+This is a list of cons cells, with tags in the car and faces in the cdr.
+The face can be a symbol, a foreground color (in which case the rest is
+inherited from the `org-tag' face) or a property list of attributes,
+like (:foreground \"blue\" :weight bold :underline t).
+If you set this variable through customize, it will immediately be effective
+in new buffers and in modified lines.
+If you set it with Lisp, a restart of Emacs is required to activate the
+changes."
+ :group 'org-faces
+ :group 'org-tags
+ :set 'org-set-tag-faces
+ :type '(repeat
+ (cons
+ (string :tag "Tag ")
+ (choice :tag "Face"
+ (string :tag "Foreground color")
+ (sexp :tag "Face")))))
+
+(defface org-table ;; originally copied from font-lock-function-name-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8) (background light)) (:foreground "blue"))
+ (((class color) (min-colors 8) (background dark)))))
+ "Face used for tables."
+ :group 'org-faces)
+
+(defface org-formula
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red"))
+ (t (:bold t :italic t))))
+ "Face for formulas."
+ :group 'org-faces)
+
+(defface org-code
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face for fixed-width text like code snippets."
+ :group 'org-faces
+ :version "22.1")
+
+(defface org-meta-line
+ (org-compatible-face 'font-lock-comment-face nil)
+ "Face for meta lines startin with \"#+\"."
+ :group 'org-faces
+ :version "22.1")
+
+(defface org-document-title
+ '((((class color) (background light)) (:foreground "midnight blue" :weight bold))
+ (((class color) (background dark)) (:foreground "pale turquoise" :weight bold))
+ (t (:weight bold)))
+ "Face for document title, i.e. that which follows the #+TITLE: keyword."
+ :group 'org-faces)
+
+(defface org-document-info
+ '((((class color) (background light)) (:foreground "midnight blue"))
+ (((class color) (background dark)) (:foreground "pale turquoise"))
+ (t nil))
+ "Face for document date, author and email; i.e. that which
+follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
+ :group 'org-faces)
+
+(defface org-document-info-keyword
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords."
+ :group 'org-faces)
+
+(defface org-block
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50"))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70"))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green"))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow"))))
+ "Face text in #+begin ... #+end blocks."
+ :group 'org-faces
+ :version "22.1")
+
+(defface org-block-background '((t ()))
+ "Face used for the source block background.")
+
+(org-copy-face 'org-meta-line 'org-block-begin-line
+ "Face used for the line delimiting the begin of source blocks.")
+
+(org-copy-face 'org-meta-line 'org-block-end-line
+ "Face used for the line delimiting the end of source blocks.")
+
+(defface org-verbatim
+ (org-compatible-face 'shadow
+ '((((class color grayscale) (min-colors 88) (background light))
+ (:foreground "grey50" :underline t))
+ (((class color grayscale) (min-colors 88) (background dark))
+ (:foreground "grey70" :underline t))
+ (((class color) (min-colors 8) (background light))
+ (:foreground "green" :underline t))
+ (((class color) (min-colors 8) (background dark))
+ (:foreground "yellow" :underline t))))
+ "Face for fixed-with text like code snippets."
+ :group 'org-faces
+ :version "22.1")
+
+(org-copy-face 'org-block 'org-quote
+ "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
+(org-copy-face 'org-block 'org-verse
+ "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
+
+(defcustom org-fontify-quote-and-verse-blocks nil
+ "Non-nil means, add a special face to #+begin_quote and #+begin_verse block.
+When nil, format these as normal Org. This is the default, because the
+content of these blocks will still be treated as Org syntax."
+ :group 'org-faces
+ :version "24.1"
+ :type 'boolean)
+
+(defface org-clock-overlay ;; copied from secondary-selection
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light))
+ (:background "yellow1"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "SkyBlue4"))
+ (((class color) (min-colors 16) (background light))
+ (:background "yellow"))
+ (((class color) (min-colors 16) (background dark))
+ (:background "SkyBlue4"))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"))
+ (t (:inverse-video t))))
+ "Basic face for displaying the secondary selection."
+ :group 'org-faces)
+
+(defface org-agenda-structure ;; originally copied from font-lock-function-name-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t))))
+ "Face used in agenda for captions and dates."
+ :group 'org-faces)
+
+(org-copy-face 'org-agenda-structure 'org-agenda-date
+ "Face used in agenda for normal days.")
+
+(org-copy-face 'org-agenda-date 'org-agenda-date-today
+ "Face used in agenda for today."
+ :weight 'bold :italic 't)
+
+(org-copy-face 'secondary-selection 'org-agenda-clocking
+ "Face marking the current clock item in the agenda.")
+
+(org-copy-face 'org-agenda-date 'org-agenda-date-weekend
+ "Face used in agenda for weekend days.
+See the variable `org-agenda-weekend-days' for a definition of which days
+belong to the weekend."
+ :weight 'bold)
+
+(defface org-scheduled
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t))))
+ "Face for items scheduled for a certain day."
+ :group 'org-faces)
+
+(defface org-scheduled-today
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t))))
+ "Face for items scheduled for a certain day."
+ :group 'org-faces)
+
+(defface org-agenda-dimmed-todo-face
+ '((((background light)) (:foreground "grey50"))
+ (((background dark)) (:foreground "grey50")))
+ "Face used to dim blocked tasks in the agenda."
+ :group 'org-faces)
+
+(defface org-scheduled-previously
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t))))
+ "Face for items scheduled previously, and not yet done."
+ :group 'org-faces)
+
+(defface org-upcoming-deadline
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t))))
+ "Face for items scheduled previously, and not yet done."
+ :group 'org-faces)
+
+(defcustom org-agenda-deadline-faces
+ '((1.0 . org-warning)
+ (0.5 . org-upcoming-deadline)
+ (0.0 . default))
+ "Faces for showing deadlines in the agenda.
+This is a list of cons cells. The cdr of each cell is a face to be used,
+and it can also just be like '(:foreground \"yellow\").
+Each car is a fraction of the head-warning time that must have passed for
+this the face in the cdr to be used for display. The numbers must be
+given in descending order. The head-warning time is normally taken
+from `org-deadline-warning-days', but can also be specified in the deadline
+timestamp itself, like this:
+
+ DEADLINE: <2007-08-13 Mon -8d>
+
+You may use d for days, w for weeks, m for months and y for years. Months
+and years will only be treated in an approximate fashion (30.4 days for a
+month and 365.24 days for a year)."
+ :group 'org-faces
+ :group 'org-agenda-daily/weekly
+ :type '(repeat
+ (cons
+ (number :tag "Fraction of head-warning time passed")
+ (sexp :tag "Face"))))
+
+(defface org-agenda-restriction-lock
+ (org-compatible-face nil
+ '((((class color) (min-colors 88) (background light)) (:background "yellow1"))
+ (((class color) (min-colors 88) (background dark)) (:background "skyblue4"))
+ (((class color) (min-colors 16) (background light)) (:background "yellow1"))
+ (((class color) (min-colors 16) (background dark)) (:background "skyblue4"))
+ (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
+ (t (:inverse-video t))))
+ "Face for showing the agenda restriction lock."
+ :group 'org-faces)
+
+(defface org-agenda-filter-tags
+ (org-compatible-face 'modeline
+ nil)
+ "Face for tag(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
+(defface org-agenda-filter-category
+ (org-compatible-face 'modeline
+ nil)
+ "Face for tag(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
+(defface org-time-grid ;; originally copied from font-lock-variable-name-face
+ (org-compatible-face nil
+ '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
+ "Face used for time grids."
+ :group 'org-faces)
+
+(org-copy-face 'org-time-grid 'org-agenda-current-time
+ "Face used to show the current time in the time grid.")
+
+(defface org-agenda-diary
+ (org-compatible-face 'default
+ nil)
+ "Face used for agenda entries that come from the Emacs diary."
+ :group 'org-faces)
+
+(defface org-agenda-calendar-event
+ (org-compatible-face 'default
+ nil)
+ "Face used to show events and appointments in the agenda."
+ :group 'org-faces)
+
+(defface org-agenda-calendar-sexp
+ (org-compatible-face 'default
+ nil)
+ "Face used to show events computed from a S-expression."
+ :group 'org-faces)
+
+(defconst org-level-faces
+ '(org-level-1 org-level-2 org-level-3 org-level-4
+ org-level-5 org-level-6 org-level-7 org-level-8
+ ))
+
+(defcustom org-n-level-faces (length org-level-faces)
+ "The number of different faces to be used for headlines.
+Org-mode defines 8 different headline faces, so this can be at most 8.
+If it is less than 8, the level-1 face gets re-used for level N+1 etc."
+ :type 'integer
+ :group 'org-faces)
+
+(defcustom org-cycle-level-faces t
+ "Non-nil means level styles cycle after level `org-n-level-faces'.
+Then so level org-n-level-faces+1 is styled like level 1.
+If nil, then all levels >=org-n-level-faces are styled like
+level org-n-level-faces"
+ :group 'org-appearance
+ :group 'org-faces
+ :version "24.1"
+ :type 'boolean)
+
+(defface org-latex-and-export-specials
+ (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 latex and other special exporter stuff."
+ :group 'org-faces)
+
+(org-copy-face 'modeline 'org-mode-line-clock
+ "Face used for clock display in mode line.")
+(org-copy-face 'modeline 'org-mode-line-clock-overrun
+ "Face used for clock display for overrun tasks in mode line."
+ :background "red")
+
+(provide 'org-faces)
+
+;;; org-faces.el ends here
diff --git a/lisp/org-feed.el b/lisp/org-feed.el
new file mode 100644
index 0000000..91bf334
--- /dev/null
+++ b/lisp/org-feed.el
@@ -0,0 +1,698 @@
+;;; org-feed.el --- Add RSS feed items to Org files
+;;
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This module allows to create and change entries in an Org-mode
+;; file triggered by items in an RSS feed. The basic functionality is
+;; geared toward simply adding new items found in a feed as outline nodes
+;; to an Org file. Using hooks, arbitrary actions can be triggered for
+;; new or changed items.
+;;
+;; Selecting feeds and target locations
+;; ------------------------------------
+;;
+;; This module is configured through a single variable, `org-feed-alist'.
+;; Here is an example, using a notes/tasks feed from reQall.com.
+;;
+;; (setq org-feed-alist
+;; '(("ReQall"
+;; "http://www.reqall.com/user/feeds/rss/a1b2c3....."
+;; "~/org/feeds.org" "ReQall Entries")
+;;
+;; With this setup, the command `M-x org-feed-update-all' will
+;; collect new entries in the feed at the given URL and create
+;; entries as subheadings under the "ReQall Entries" heading in the
+;; file "~/org/feeds.org". Each feed should normally have its own
+;; heading - however see the `:drawer' parameter.
+;;
+;; Besides these standard elements that need to be specified for each
+;; feed, keyword-value pairs can set additional options. For example,
+;; to de-select transitional entries with a title containing
+;;
+;; "reQall is typing what you said",
+;;
+;; you could use the `:filter' argument:
+;;
+;; (setq org-feed-alist
+;; '(("ReQall"
+;; "http://www.reqall.com/user/feeds/rss/a1b2c3....."
+;; "~/org/feeds.org" "ReQall Entries"
+;; :filter my-reqall-filter)))
+;;
+;; (defun my-reqall-filter (e)
+;; (if (string-match "reQall is typing what you said"
+;; (plist-get e :title))
+;; nil
+;; e))
+;;
+;; See the docstring for `org-feed-alist' for more details.
+;;
+;;
+;; Keeping track of previously added entries
+;; -----------------------------------------
+;;
+;; Since Org allows you to delete, archive, or move outline nodes,
+;; org-feed.el needs to keep track of which feed items have been handled
+;; before, so that they will not be handled again. For this, org-feed.el
+;; stores information in a special drawer, FEEDSTATUS, under the heading
+;; that received the input of the feed. You should add FEEDSTATUS
+;; to your list of drawers in the files that receive feed input:
+;;
+;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
+;;
+;; Acknowledgments
+;; ---------------
+;;
+;; org-feed.el is based on ideas by Brad Bozarth who implemented a
+;; similar mechanism using shell and awk scripts.
+
+;;; Code:
+
+(require 'org)
+(require 'sha1)
+
+(declare-function url-retrieve-synchronously "url" (url))
+(declare-function xml-node-children "xml" (node))
+(declare-function xml-get-children "xml" (node child-name))
+(declare-function xml-get-attribute "xml" (node attribute))
+(declare-function xml-get-attribute-or-nil "xml" (node attribute))
+(declare-function xml-substitute-special "xml" (string))
+
+(declare-function org-capture-escaped-% "org-capture" ())
+(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
+(declare-function org-capture-expand-embedded-elisp "org-capture" ())
+
+(defgroup org-feed nil
+ "Options concerning RSS feeds as inputs for Org files."
+ :tag "Org Feed"
+ :group 'org)
+
+(defcustom org-feed-alist nil
+ "Alist specifying RSS feeds that should create inputs for Org.
+Each entry in this list specified an RSS feed tat should be queried
+to create inbox items in Org. Each entry is a list with the following items:
+
+name a custom name for this feed
+URL the Feed URL
+file the target Org file where entries should be listed
+headline the headline under which entries should be listed
+
+Additional arguments can be given using keyword-value pairs. Many of these
+specify functions that receive one or a list of \"entries\" as their single
+argument. An entry is a property list that describes a feed item. The
+property list has properties for each field in the item, for example `:title'
+for the `<title>' field and `:pubDate' for the publication date. In addition,
+it contains the following properties:
+
+`:item-full-text' the full text in the <item> tag
+`:guid-permalink' t when the guid property is a permalink
+
+Here are the keyword-value pair allows in `org-feed-alist'.
+
+:drawer drawer-name
+ The name of the drawer for storing feed information. The default is
+ \"FEEDSTATUS\". Using different drawers for different feeds allows
+ several feeds to target the same inbox heading.
+
+:filter filter-function
+ A function to select interesting entries in the feed. It gets a single
+ entry as parameter. It should return the entry if it is relevant, or
+ nil if it is not.
+
+:template template-string
+ The default action on new items in the feed is to add them as children
+ under the headline for the feed. The template describes how the entry
+ should be formatted. If not given, it defaults to
+ `org-feed-default-template'.
+
+:formatter formatter-function
+ Instead of relying on a template, you may specify a function to format
+ the outline node to be inserted as a child. This function gets passed
+ a property list describing a single feed item, and it should return a
+ string that is a properly formatted Org outline node of level 1.
+
+:new-handler function
+ If adding new items as children to the outline is not what you want
+ to do with new items, define a handler function that is called with
+ a list of all new items in the feed, each one represented as a property
+ list. The handler should do what needs to be done, and org-feed will
+ mark all items given to this handler as \"handled\", i.e. they will not
+ be passed to this handler again in future readings of the feed.
+ When the handler is called, point will be at the feed headline.
+
+:changed-handler function
+ This function gets passed a list of all entries that have been
+ handled before, but are now still in the feed and have *changed*
+ since last handled (as evidenced by a different sha1 hash).
+ When the handler is called, point will be at the feed headline.
+
+:parse-feed function
+ This function gets passed a buffer, and should return a list
+ of entries, each being a property list containing the
+ `:guid' and `:item-full-text' keys. The default is
+ `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an
+ alternative.
+
+:parse-entry function
+ This function gets passed an entry as returned by the parse-feed
+ function, and should return the entry with interesting properties added.
+ The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry'
+ is an alternative."
+ :group 'org-feed
+ :type '(repeat
+ (list :value ("" "http://" "" "")
+ (string :tag "Name")
+ (string :tag "Feed URL")
+ (file :tag "File for inbox")
+ (string :tag "Headline for inbox")
+ (repeat :inline t
+ (choice
+ (list :inline t :tag "Filter"
+ (const :filter)
+ (symbol :tag "Filter Function"))
+ (list :inline t :tag "Template"
+ (const :template)
+ (string :tag "Template"))
+ (list :inline t :tag "Formatter"
+ (const :formatter)
+ (symbol :tag "Formatter Function"))
+ (list :inline t :tag "New items handler"
+ (const :new-handler)
+ (symbol :tag "Handler Function"))
+ (list :inline t :tag "Changed items"
+ (const :changed-handler)
+ (symbol :tag "Handler Function"))
+ (list :inline t :tag "Parse Feed"
+ (const :parse-feed)
+ (symbol :tag "Parse Feed Function"))
+ (list :inline t :tag "Parse Entry"
+ (const :parse-entry)
+ (symbol :tag "Parse Entry Function"))
+ )))))
+
+(defcustom org-feed-drawer "FEEDSTATUS"
+ "The name of the drawer for feed status information.
+Each feed may also specify its own drawer name using the `:drawer'
+parameter in `org-feed-alist'.
+Note that in order to make these drawers behave like drawers, they must
+be added to the variable `org-drawers' or configured with a #+DRAWERS
+line."
+ :group 'org-feed
+ :type '(string :tag "Drawer Name"))
+
+(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n"
+ "Template for the Org node created from RSS feed items.
+This is just the default, each feed can specify its own.
+Any fields from the feed item can be interpolated into the template with
+%name, for example %title, %description, %pubDate etc. In addition, the
+following special escapes are valid as well:
+
+%h The title, or the first line of the description
+%t The date as a stamp, either from <pubDate> (if present), or
+ the current date
+%T Date and time
+%u,%U Like %t,%T, but inactive time stamps
+%a A link, from <guid> if that is a permalink, else from <link>
+%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple
+ %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")"
+ :group 'org-feed
+ :type '(string :tag "Template"))
+
+(defcustom org-feed-save-after-adding t
+ "Non-nil means save buffer after adding new feed items."
+ :group 'org-feed
+ :type 'boolean)
+
+(defcustom org-feed-retrieve-method 'url-retrieve-synchronously
+ "The method to be used to retrieve a feed URL.
+This can be `curl' or `wget' to call these external programs, or it can be
+an Emacs Lisp function that will return a buffer containing the content
+of the file pointed to by the URL."
+ :group 'org-feed
+ :type '(choice
+ (const :tag "Internally with url.el" url-retrieve-synchronously)
+ (const :tag "Externally with curl" curl)
+ (const :tag "Externally with wget" wget)
+ (function :tag "Function")))
+
+(defcustom org-feed-before-adding-hook nil
+ "Hook that is run before adding new feed items to a file.
+You might want to commit the file in its current state to version control,
+for example."
+ :group 'org-feed
+ :type 'hook)
+
+(defcustom org-feed-after-adding-hook nil
+ "Hook that is run after new items have been added to a file.
+Depending on `org-feed-save-after-adding', the buffer will already
+have been saved."
+ :group 'org-feed
+ :type 'hook)
+
+(defvar org-feed-buffer "*Org feed*"
+ "The buffer used to retrieve a feed.")
+
+;;;###autoload
+(defun org-feed-update-all ()
+ "Get inbox items from all feeds in `org-feed-alist'."
+ (interactive)
+ (let ((nfeeds (length org-feed-alist))
+ (nnew (apply '+ (mapcar 'org-feed-update org-feed-alist))))
+ (message "%s from %d %s"
+ (cond ((= nnew 0) "No new entries")
+ ((= nnew 1) "1 new entry")
+ (t (format "%d new entries" nnew)))
+ nfeeds
+ (if (= nfeeds 1) "feed" "feeds"))))
+
+;;;###autoload
+(defun org-feed-update (feed &optional retrieve-only)
+ "Get inbox items from FEED.
+FEED can be a string with an association in `org-feed-alist', or
+it can be a list structured like an entry in `org-feed-alist'."
+ (interactive (list (org-completing-read "Feed name: " org-feed-alist)))
+ (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
+ (unless feed
+ (error "No such feed in `org-feed-alist"))
+ (catch 'exit
+ (let ((name (car feed))
+ (url (nth 1 feed))
+ (file (nth 2 feed))
+ (headline (nth 3 feed))
+ (filter (nth 1 (memq :filter feed)))
+ (formatter (nth 1 (memq :formatter feed)))
+ (new-handler (nth 1 (memq :new-handler feed)))
+ (changed-handler (nth 1 (memq :changed-handler feed)))
+ (template (or (nth 1 (memq :template feed))
+ org-feed-default-template))
+ (drawer (or (nth 1 (memq :drawer feed))
+ org-feed-drawer))
+ (parse-feed (or (nth 1 (memq :parse-feed feed))
+ 'org-feed-parse-rss-feed))
+ (parse-entry (or (nth 1 (memq :parse-entry feed))
+ 'org-feed-parse-rss-entry))
+ feed-buffer inbox-pos new-formatted
+ entries old-status status new changed guid-alist e guid olds)
+ (setq feed-buffer (org-feed-get-feed url))
+ (unless (and feed-buffer (bufferp (get-buffer feed-buffer)))
+ (error "Cannot get feed %s" name))
+ (when retrieve-only
+ (throw 'exit feed-buffer))
+ (setq entries (funcall parse-feed feed-buffer))
+ (ignore-errors (kill-buffer feed-buffer))
+ (save-excursion
+ (save-window-excursion
+ (setq inbox-pos (org-feed-goto-inbox-internal file headline))
+ (setq old-status (org-feed-read-previous-status inbox-pos drawer))
+ ;; Add the "handled" status to the appropriate entries
+ (setq entries (mapcar (lambda (e)
+ (setq e
+ (plist-put e :handled
+ (nth 1 (assoc
+ (plist-get e :guid)
+ old-status)))))
+ entries))
+ ;; Find out which entries are new and which are changed
+ (dolist (e entries)
+ (if (not (plist-get e :handled))
+ (push e new)
+ (setq olds (nth 2 (assoc (plist-get e :guid) old-status)))
+ (if (and olds
+ (not (string= (sha1
+ (plist-get e :item-full-text))
+ olds)))
+ (push e changed))))
+
+ ;; Parse the relevant entries fully
+ (setq new (mapcar parse-entry new)
+ changed (mapcar parse-entry changed))
+
+ ;; Run the filter
+ (when filter
+ (setq new (delq nil (mapcar filter new))
+ changed (delq nil (mapcar filter new))))
+
+ (when (not (or new changed))
+ (message "No new items in feed %s" name)
+ (throw 'exit 0))
+
+ ;; Get alist based on guid, to look up entries
+ (setq guid-alist
+ (append
+ (mapcar (lambda (e) (list (plist-get e :guid) e)) new)
+ (mapcar (lambda (e) (list (plist-get e :guid) e)) changed)))
+
+ ;; Construct the new status
+ (setq status
+ (mapcar
+ (lambda (e)
+ (setq guid (plist-get e :guid))
+ (list guid
+ ;; things count as handled if we handle them now,
+ ;; or if they were handled previously
+ (if (assoc guid guid-alist) t (plist-get e :handled))
+ ;; A hash, to detect changes
+ (sha1 (plist-get e :item-full-text))))
+ entries))
+
+ ;; Handle new items in the feed
+ (when new
+ (if new-handler
+ (progn
+ (goto-char inbox-pos)
+ (funcall new-handler new))
+ ;; No custom handler, do the default adding
+ ;; Format the new entries into an alist with GUIDs in the car
+ (setq new-formatted
+ (mapcar
+ (lambda (e) (org-feed-format-entry e template formatter))
+ new)))
+
+ ;; Insert the new items
+ (org-feed-add-items inbox-pos new-formatted))
+
+ ;; Handle changed items in the feed
+ (when (and changed-handler changed)
+ (goto-char inbox-pos)
+ (funcall changed-handler changed))
+
+ ;; Write the new status
+ ;; We do this only now, in case something goes wrong above, so
+ ;; that would would end up with a status that does not reflect
+ ;; which items truely have been handled
+ (org-feed-write-status inbox-pos drawer status)
+
+ ;; Normalize the visibility of the inbox tree
+ (goto-char inbox-pos)
+ (hide-subtree)
+ (show-children)
+ (org-cycle-hide-drawers 'children)
+
+ ;; Hooks and messages
+ (when org-feed-save-after-adding (save-buffer))
+ (message "Added %d new item%s from feed %s to file %s, heading %s"
+ (length new) (if (> (length new) 1) "s" "")
+ name
+ (file-name-nondirectory file) headline)
+ (run-hooks 'org-feed-after-adding-hook)
+ (length new))))))
+
+;;;###autoload
+(defun org-feed-goto-inbox (feed)
+ "Go to the inbox that captures the feed named FEED."
+ (interactive
+ (list (if (= (length org-feed-alist) 1)
+ (car org-feed-alist)
+ (org-completing-read "Feed name: " org-feed-alist))))
+ (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
+ (unless feed
+ (error "No such feed in `org-feed-alist"))
+ (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed)))
+
+;;;###autoload
+(defun org-feed-show-raw-feed (feed)
+ "Show the raw feed buffer of a feed."
+ (interactive
+ (list (if (= (length org-feed-alist) 1)
+ (car org-feed-alist)
+ (org-completing-read "Feed name: " org-feed-alist))))
+ (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
+ (unless feed
+ (error "No such feed in `org-feed-alist"))
+ (org-pop-to-buffer-same-window
+ (org-feed-update feed 'retrieve-only))
+ (goto-char (point-min)))
+
+(defun org-feed-goto-inbox-internal (file heading)
+ "Find or create HEADING in FILE.
+Switch to that buffer, and return the position of that headline."
+ (find-file file)
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$")
+ nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))
+ (insert "\n\n* " heading "\n\n")
+ (org-back-to-heading t))
+ (point))
+
+(defun org-feed-read-previous-status (pos drawer)
+ "Get the alist of old GUIDs from the entry at POS.
+This will find DRAWER and extract the alist."
+ (save-excursion
+ (goto-char pos)
+ (let ((end (save-excursion (org-end-of-subtree t t))))
+ (if (re-search-forward
+ (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:")
+ end t)
+ (read (match-string 1))
+ nil))))
+
+(defun org-feed-write-status (pos drawer status)
+ "Write the feed STATUS to DRAWER in entry at POS."
+ (save-excursion
+ (goto-char pos)
+ (let ((end (save-excursion (org-end-of-subtree t t)))
+ guid)
+ (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n")
+ end t)
+ (progn
+ (goto-char (match-end 0))
+ (delete-region (point)
+ (save-excursion
+ (and (re-search-forward "^[ \t]*:END:" nil t)
+ (match-beginning 0)))))
+ (outline-next-heading)
+ (insert " :" drawer ":\n :END:\n")
+ (beginning-of-line 0))
+ (insert (pp-to-string status)))))
+
+(defun org-feed-add-items (pos entries)
+ "Add the formatted items to the headline as POS."
+ (let (entry level)
+ (save-excursion
+ (goto-char pos)
+ (unless (looking-at org-complex-heading-regexp)
+ (error "Wrong position"))
+ (setq level (org-get-valid-level (length (match-string 1)) 1))
+ (org-end-of-subtree t t)
+ (skip-chars-backward " \t\n")
+ (beginning-of-line 2)
+ (setq pos (point))
+ (while (setq entry (pop entries))
+ (org-paste-subtree level entry 'yank))
+ (org-mark-ring-push pos))))
+
+(defun org-feed-format-entry (entry template formatter)
+ "Format ENTRY so that it can be inserted into an Org file.
+ENTRY is a property list. This function adds a `:formatted-for-org' property
+and returns the full property list.
+If that property is already present, nothing changes."
+ (require 'org-capture)
+ (if formatter
+ (funcall formatter entry)
+ (let (dlines time escape name tmp
+ v-h v-t v-T v-u v-U v-a)
+ (setq dlines (org-split-string (or (plist-get entry :description) "???")
+ "\n")
+ v-h (or (plist-get entry :title) (car dlines) "???")
+ time (or (if (plist-get entry :pubDate)
+ (org-read-date t t (plist-get entry :pubDate)))
+ (current-time))
+ v-t (format-time-string (org-time-stamp-format nil nil) time)
+ v-T (format-time-string (org-time-stamp-format t nil) time)
+ v-u (format-time-string (org-time-stamp-format nil t) time)
+ v-U (format-time-string (org-time-stamp-format t t) time)
+ v-a (if (setq tmp (or (and (plist-get entry :guid-permalink)
+ (plist-get entry :guid))
+ (plist-get entry :link)))
+ (concat "[[" tmp "]]\n")
+ ""))
+ (with-temp-buffer
+ (insert template)
+
+ ;; Simple %-escapes
+ ;; before embedded elisp to support simple %-escapes as
+ ;; arguments for embedded elisp
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (setq name (match-string 1)
+ escape (org-capture-inside-embedded-elisp-p))
+ (cond
+ ((member name '("h" "t" "T" "u" "U" "a"))
+ (setq tmp (symbol-value (intern (concat "v-" name)))))
+ ((setq tmp (plist-get entry (intern (concat ":" name))))
+ (save-excursion
+ (save-match-data
+ (beginning-of-line 1)
+ (when (looking-at
+ (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
+ (setq tmp (org-feed-make-indented-block
+ tmp (org-get-indentation))))))))
+ (when tmp
+ ;; escape string delimiters `"' when inside %() embedded lisp
+ (when escape
+ (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
+ (replace-match tmp t t))))
+
+ ;; %() embedded elisp
+ (org-capture-expand-embedded-elisp)
+
+ (decode-coding-string
+ (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
+
+(defun org-feed-make-indented-block (s n)
+ "Add indentation of N spaces to a multiline string S."
+ (if (not (string-match "\n" s))
+ s
+ (mapconcat 'identity
+ (org-split-string s "\n")
+ (concat "\n" (make-string n ?\ )))))
+
+(defun org-feed-skip-http-headers (buffer)
+ "Remove HTTP headers from BUFFER, and return it.
+Assumes headers are indeed present!"
+ (with-current-buffer buffer
+ (widen)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (delete-region (point-min) (point))
+ buffer))
+
+(defun org-feed-get-feed (url)
+ "Get the RSS feed file at URL and return the buffer."
+ (cond
+ ((eq org-feed-retrieve-method 'url-retrieve-synchronously)
+ (org-feed-skip-http-headers (url-retrieve-synchronously url)))
+ ((eq org-feed-retrieve-method 'curl)
+ (ignore-errors (kill-buffer org-feed-buffer))
+ (call-process "curl" nil org-feed-buffer nil "--silent" url)
+ org-feed-buffer)
+ ((eq org-feed-retrieve-method 'wget)
+ (ignore-errors (kill-buffer org-feed-buffer))
+ (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url)
+ org-feed-buffer)
+ ((functionp org-feed-retrieve-method)
+ (funcall org-feed-retrieve-method url))))
+
+(defun org-feed-parse-rss-feed (buffer)
+ "Parse BUFFER for RSS feed entries.
+Returns a list of entries, with each entry a property list,
+containing the properties `:guid' and `:item-full-text'."
+ (let ((case-fold-search t)
+ entries beg end item guid entry)
+ (with-current-buffer buffer
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward "<item\\>.*?>" nil t)
+ (setq beg (point)
+ end (and (re-search-forward "</item>" nil t)
+ (match-beginning 0)))
+ (setq item (buffer-substring beg end)
+ guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item)
+ (org-match-string-no-properties 1 item)))
+ (setq entry (list :guid guid :item-full-text item))
+ (push entry entries)
+ (widen)
+ (goto-char end))
+ (nreverse entries))))
+
+(defun org-feed-parse-rss-entry (entry)
+ "Parse the `:item-full-text' field for xml tags and create new properties."
+ (require 'xml)
+ (with-temp-buffer
+ (insert (plist-get entry :item-full-text))
+ (goto-char (point-min))
+ (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>"
+ nil t)
+ (setq entry (plist-put entry
+ (intern (concat ":" (match-string 1)))
+ (xml-substitute-special (match-string 2)))))
+ (goto-char (point-min))
+ (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t)
+ (setq entry (plist-put entry :guid-permalink t))))
+ entry)
+
+(defun org-feed-parse-atom-feed (buffer)
+ "Parse BUFFER for Atom feed entries.
+Returns a list of entries, with each entry a property list,
+containing the properties `:guid' and `:item-full-text'.
+
+The `:item-full-text' property actually contains the sexp
+formatted as a string, not the original XML data."
+ (require 'xml)
+ (with-current-buffer buffer
+ (widen)
+ (let ((feed (car (xml-parse-region (point-min) (point-max)))))
+ (mapcar
+ (lambda (entry)
+ (list
+ :guid (car (xml-node-children (car (xml-get-children entry 'id))))
+ :item-full-text (prin1-to-string entry)))
+ (xml-get-children feed 'entry)))))
+
+(defun org-feed-parse-atom-entry (entry)
+ "Parse the `:item-full-text' as a sexp and create new properties."
+ (let ((xml (car (read-from-string (plist-get entry :item-full-text)))))
+ ;; Get first <link href='foo'/>.
+ (setq entry (plist-put entry :link
+ (xml-get-attribute
+ (car (xml-get-children xml 'link))
+ 'href)))
+ ;; Add <title/> as :title.
+ (setq entry (plist-put entry :title
+ (xml-substitute-special
+ (car (xml-node-children
+ (car (xml-get-children xml 'title)))))))
+ (let* ((content (car (xml-get-children xml 'content)))
+ (type (xml-get-attribute-or-nil content 'type)))
+ (when content
+ (cond
+ ((string= type "text")
+ ;; We like plain text.
+ (setq entry (plist-put entry :description
+ (xml-substitute-special
+ (car (xml-node-children content))))))
+ ((string= type "html")
+ ;; TODO: convert HTML to Org markup.
+ (setq entry (plist-put entry :description
+ (xml-substitute-special
+ (car (xml-node-children content))))))
+ ((string= type "xhtml")
+ ;; TODO: convert XHTML to Org markup.
+ (setq entry (plist-put entry :description
+ (prin1-to-string
+ (xml-node-children content)))))
+ (t
+ (setq entry (plist-put entry :description
+ (format "Unknown '%s' content." type)))))))
+ entry))
+
+(provide 'org-feed)
+
+;;; org-feed.el ends here
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
new file mode 100644
index 0000000..3aaa44b
--- /dev/null
+++ b/lisp/org-footnote.el
@@ -0,0 +1,951 @@
+;;; org-footnote.el --- Footnote support in Org and elsewhere
+;;
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code dealing with footnotes in Org-mode.
+;; The code can also be used in arbitrary text modes to provide
+;; footnotes. Compared to Steven L Baur's footnote.el it provides
+;; better support for resuming editing. It is less configurable than
+;; Steve's code, though.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org-macs)
+(require 'org-compat)
+
+(declare-function message-point-in-header-p "message" ())
+(declare-function org-back-over-empty-lines "org" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-combine-plists "org" (&rest plists))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-export-preprocess-string "org-exp"
+ (string &rest parameters))
+(declare-function org-fill-paragraph "org" (&optional justify))
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-id-uuid "org-id" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-in-commented-line "org" ())
+(declare-function org-in-indented-comment-line "org" ())
+(declare-function org-in-regexp "org" (re &optional nlines visually))
+(declare-function org-in-verbatim-emphasis "org" ())
+(declare-function org-inside-LaTeX-fragment-p "org" ())
+(declare-function org-inside-latex-macro-p "org" ())
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function org-show-context "org" (&optional key))
+(declare-function org-trim "org" (s))
+(declare-function org-skip-whitespace "org" ())
+(declare-function outline-next-heading "outline")
+(declare-function org-skip-whitespace "org" ())
+
+(defvar org-outline-regexp-bol) ; defined in org.el
+(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-bracket-link-regexp) ; defined in org.el
+(defvar message-cite-prefix-regexp) ; defined in message.el
+(defvar message-signature-separator) ; defined in message.el
+
+(defconst org-footnote-re
+ ;; Only [1]-like footnotes are closed in this regexp, as footnotes
+ ;; from other types might contain square brackets (i.e. links) in
+ ;; their definition.
+ ;;
+ ;; `org-re' is used for regexp compatibility with XEmacs.
+ (concat "\\[\\(?:"
+ ;; Match inline footnotes.
+ (org-re "fn:\\([-_[:word:]]+\\)?:\\|")
+ ;; Match other footnotes.
+ "\\(?:\\([0-9]+\\)\\]\\)\\|"
+ (org-re "\\(fn:[-_[:word:]]+\\)")
+ "\\)")
+ "Regular expression for matching footnotes.")
+
+(defconst org-footnote-definition-re
+ (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
+ "Regular expression matching the definition of a footnote.")
+
+(defconst org-footnote-forbidden-blocks
+ '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src")
+ "Names of blocks where footnotes are not allowed.")
+
+(defgroup org-footnote nil
+ "Footnotes in Org-mode."
+ :tag "Org Footnote"
+ :group 'org)
+
+(defcustom org-footnote-section "Footnotes"
+ "Outline heading containing footnote definitions before export.
+This can be nil, to place footnotes locally at the end of the current
+outline node. If can also be the name of a special outline heading
+under which footnotes should be put.
+This variable defines the place where Org puts the definition
+automatically, i.e. when creating the footnote, and when sorting the notes.
+However, by hand you may place definitions *anywhere*.
+If this is a string, during export, all subtrees starting with this
+heading will be removed after extracting footnote definitions."
+ :group 'org-footnote
+ :type '(choice
+ (string :tag "Collect footnotes under heading")
+ (const :tag "Define footnotes locally" nil)))
+
+(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
+ "Tag marking the beginning of footnote section.
+The Org footnote engine can be used in arbitrary text files as well
+as in Org-mode. Outside Org mode, new footnotes are always placed at
+the end of the file. When you normalize the notes, any line containing
+only this tag will be removed, a new one will be inserted at the end
+of the file, followed by the collected and normalized footnotes.
+
+If you don't want any tag in such buffers, set this variable to nil."
+ :group 'org-footnote
+ :type '(choice
+ (string :tag "Collect footnotes under tag")
+ (const :tag "Don't use a tag" nil)))
+
+(defcustom org-footnote-define-inline nil
+ "Non-nil means define footnotes inline, at reference location.
+When nil, footnotes will be defined in a special section near
+the end of the document. When t, the [fn:label:definition] notation
+will be used to define the footnote at the reference position."
+ :group 'org-footnote
+ :type 'boolean)
+
+(defcustom org-footnote-auto-label t
+ "Non-nil means define automatically new labels for footnotes.
+Possible values are:
+
+nil prompt the user for each label
+t create unique labels of the form [fn:1], [fn:2], ...
+confirm like t, but let the user edit the created value. In particular,
+ the label can be removed from the minibuffer, to create
+ an anonymous footnote.
+random Automatically generate a unique, random label.
+plain Automatically create plain number labels like [1]"
+ :group 'org-footnote
+ :type '(choice
+ (const :tag "Prompt for label" nil)
+ (const :tag "Create automatic [fn:N]" t)
+ (const :tag "Offer automatic [fn:N] for editing" confirm)
+ (const :tag "Create a random label" random)
+ (const :tag "Create automatic [N]" plain)))
+
+(defcustom org-footnote-auto-adjust nil
+ "Non-nil means automatically adjust footnotes after insert/delete.
+When this is t, after each insertion or deletion of a footnote,
+simple fn:N footnotes will be renumbered, and all footnotes will be sorted.
+If you want to have just sorting or just renumbering, set this variable
+to `sort' or `renumber'.
+
+The main values of this variable can be set with in-buffer options:
+
+#+STARTUP: fnadjust
+#+STARTUP: nofnadjust"
+ :group 'org-footnote
+ :type '(choice
+ (const :tag "Renumber" renumber)
+ (const :tag "Sort" sort)
+ (const :tag "Renumber and Sort" t)))
+
+(defcustom org-footnote-fill-after-inline-note-extraction nil
+ "Non-nil means fill paragraphs after extracting footnotes.
+When extracting inline footnotes, the lengths of lines can change a lot.
+When this option is set, paragraphs from which an inline footnote has been
+extracted will be filled again."
+ :group 'org-footnote
+ :type 'boolean)
+
+(defun org-footnote-in-valid-context-p ()
+ "Is point in a context where footnotes are allowed?"
+ (save-match-data
+ (not (or (org-in-commented-line)
+ (org-in-indented-comment-line)
+ (org-inside-LaTeX-fragment-p)
+ ;; Avoid protected environments (LaTeX export)
+ (get-text-property (point) 'org-protected)
+ ;; Avoid literal example.
+ (org-in-verbatim-emphasis)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*:[ \t]+"))
+ ;; Avoid cited text and headers in message-mode.
+ (and (derived-mode-p 'message-mode)
+ (or (save-excursion
+ (beginning-of-line)
+ (looking-at message-cite-prefix-regexp))
+ (message-point-in-header-p)))
+ ;; Avoid forbidden blocks.
+ (org-in-block-p org-footnote-forbidden-blocks)))))
+
+(defun org-footnote-at-reference-p ()
+ "Is the cursor at a footnote reference?
+
+If so, return a list containing its label, beginning and ending
+positions, and the definition, when inlined."
+ (when (and (org-footnote-in-valid-context-p)
+ (or (looking-at org-footnote-re)
+ (org-in-regexp org-footnote-re)
+ (save-excursion (re-search-backward org-footnote-re nil t)))
+ (/= (match-beginning 0) (point-at-bol)))
+ (let* ((beg (match-beginning 0))
+ (label (or (org-match-string-no-properties 2)
+ (org-match-string-no-properties 3)
+ ;; Anonymous footnotes don't have labels
+ (and (match-string 1)
+ (concat "fn:" (org-match-string-no-properties 1)))))
+ ;; Inline footnotes don't end at (match-end 0) as
+ ;; `org-footnote-re' stops just after the second colon.
+ ;; Find the real ending with `scan-sexps', so Org doesn't
+ ;; get fooled by unrelated closing square brackets.
+ (end (ignore-errors (scan-sexps beg 1))))
+ ;; Point is really at a reference if it's located before true
+ ;; ending of the footnote.
+ (when (and end (< (point) end)
+ ;; Verify match isn't a part of a link.
+ (not (save-excursion
+ (goto-char beg)
+ (let ((linkp
+ (save-match-data
+ (org-in-regexp org-bracket-link-regexp))))
+ (and linkp (< (point) (cdr linkp))))))
+ ;; Verify point doesn't belong to a LaTeX macro.
+ ;; Beware though, when two footnotes are side by
+ ;; side, once the first one is changed into LaTeX,
+ ;; the second one might then be considered as an
+ ;; optional argument of the command. Thus, check
+ ;; the `org-protected' property of that command.
+ (or (not (org-inside-latex-macro-p))
+ (get-text-property (1- beg) 'org-protected)))
+ (list label beg end
+ ;; Definition: ensure this is an inline footnote first.
+ (and (or (not label) (match-string 1))
+ (org-trim (buffer-substring-no-properties
+ (match-end 0) (1- end)))))))))
+
+(defun org-footnote-at-definition-p ()
+ "Is point within a footnote definition?
+
+This matches only pure definitions like [1] or [fn:name] at the
+beginning of a line. It does not match references like
+\[fn:name:definition], where the footnote text is included and
+defined locally.
+
+The return value will be nil if not at a footnote definition, and
+a list with label, start, end and definition of the footnote
+otherwise."
+ (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p))
+ (save-excursion
+ (end-of-line)
+ ;; Footnotes definitions are separated by new headlines or blank
+ ;; lines.
+ (let ((lim (save-excursion (re-search-backward
+ (concat org-outline-regexp-bol
+ "\\|^[ \t]*$") nil t))))
+ (when (re-search-backward org-footnote-definition-re lim t)
+ (let ((label (org-match-string-no-properties 1))
+ (beg (match-beginning 0))
+ (beg-def (match-end 0))
+ ;; In message-mode, do not search after signature.
+ (end (let ((bound (and (derived-mode-p 'message-mode)
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward
+ message-signature-separator nil t)))))
+ (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^[ \t]*$") bound 'move))
+ (match-beginning 0)
+ (point)))))
+ (list label beg end
+ (org-trim (buffer-substring-no-properties beg-def end)))))))))
+
+(defun org-footnote-get-next-reference (&optional label backward limit)
+ "Return complete reference of the next footnote.
+
+If LABEL is provided, get the next reference of that footnote. If
+BACKWARD is non-nil, find previous reference instead. LIMIT is
+the buffer position bounding the search.
+
+Return value is a list like those provided by `org-footnote-at-reference-p'.
+If no footnote is found, return nil."
+ (save-excursion
+ (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re)))
+ (catch 'exit
+ (while t
+ (unless (funcall (if backward #'re-search-backward #'re-search-forward)
+ label-fmt limit t)
+ (throw 'exit nil))
+ (unless backward (backward-char))
+ (let ((ref (org-footnote-at-reference-p)))
+ (when ref (throw 'exit ref))))))))
+
+(defun org-footnote-next-reference-or-definition (limit)
+ "Move point to next footnote reference or definition.
+
+LIMIT is the buffer position bounding the search.
+
+Return value is a list like those provided by
+`org-footnote-at-reference-p' or `org-footnote-at-definition-p'.
+If no footnote is found, return nil."
+ (let* (ref (origin (point)))
+ (catch 'exit
+ (while t
+ (unless (re-search-forward org-footnote-re limit t)
+ (goto-char origin)
+ (throw 'exit nil))
+ ;; Beware: with [1]-like footnotes point will be just after
+ ;; the closing square bracket.
+ (backward-char)
+ (cond
+ ((setq ref (org-footnote-at-reference-p))
+ (throw 'exit ref))
+ ;; Definition: also grab the last square bracket, only
+ ;; matched in `org-footnote-re' for [1]-like footnotes.
+ ((save-match-data (org-footnote-at-definition-p))
+ (let ((end (match-end 0)))
+ (throw 'exit
+ (list nil (match-beginning 0)
+ (if (eq (char-before end) 93) end (1+ end)))))))))))
+
+(defun org-footnote-get-definition (label)
+ "Return label, boundaries and definition of the footnote LABEL."
+ (let* ((label (regexp-quote (org-footnote-normalize-label label)))
+ (re (format "^\\[%s\\]\\|.\\[%s:" label label))
+ pos)
+ (save-excursion
+ (save-restriction
+ (when (or (re-search-forward re nil t)
+ (and (goto-char (point-min))
+ (re-search-forward re nil t))
+ (and (progn (widen) t)
+ (goto-char (point-min))
+ (re-search-forward re nil t)))
+ (let ((refp (org-footnote-at-reference-p)))
+ (cond
+ ((and (nth 3 refp) refp))
+ ((org-footnote-at-definition-p)))))))))
+
+(defun org-footnote-goto-definition (label)
+ "Move point to the definition of the footnote LABEL.
+Return a non-nil value when a definition has been found."
+ (interactive "sLabel: ")
+ (org-mark-ring-push)
+ (let ((def (org-footnote-get-definition label)))
+ (if (not def)
+ (error "Cannot find definition of footnote %s" label)
+ (goto-char (nth 1 def))
+ (looking-at (format "\\[%s\\]\\|\\[%s:" label label))
+ (goto-char (match-end 0))
+ (org-show-context 'link-search)
+ (when (derived-mode-p 'org-mode)
+ (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
+ t)))
+
+(defun org-footnote-goto-previous-reference (label)
+ "Find the first closest (to point) reference of footnote with label LABEL."
+ (interactive "sLabel: ")
+ (org-mark-ring-push)
+ (let* ((label (org-footnote-normalize-label label)) ref)
+ (save-excursion
+ (setq ref (or (org-footnote-get-next-reference label t)
+ (org-footnote-get-next-reference label)
+ (save-restriction
+ (widen)
+ (or
+ (org-footnote-get-next-reference label t)
+ (org-footnote-get-next-reference label))))))
+ (if (not ref)
+ (error "Cannot find reference of footnote %s" label)
+ (goto-char (nth 1 ref))
+ (org-show-context 'link-search))))
+
+(defun org-footnote-normalize-label (label)
+ "Return LABEL as an appropriate string."
+ (cond
+ ((numberp label) (number-to-string label))
+ ((equal "" label) nil)
+ ((not (string-match "^[0-9]+$\\|^fn:" label))
+ (concat "fn:" label))
+ (t label)))
+
+(defun org-footnote-all-labels (&optional with-defs)
+ "Return list with all defined foot labels used in the buffer.
+
+If WITH-DEFS is non-nil, also associate the definition to each
+label. The function will then return an alist whose key is label
+and value definition."
+ (let* (rtn
+ (push-to-rtn
+ (function
+ ;; Depending on WITH-DEFS, store label or (label . def) of
+ ;; footnote reference/definition given as argument in RTN.
+ (lambda (el)
+ (let ((lbl (car el)))
+ (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn))))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ ;; Find all labels found in definitions.
+ (goto-char (point-min))
+ (let (def)
+ (while (re-search-forward org-footnote-definition-re nil t)
+ (when (setq def (org-footnote-at-definition-p))
+ (funcall push-to-rtn def))))
+ ;; Find all labels found in references.
+ (goto-char (point-min))
+ (let (ref)
+ (while (setq ref (org-footnote-get-next-reference))
+ (goto-char (nth 2 ref))
+ (and (car ref) ; ignore anonymous footnotes
+ (not (funcall (if with-defs #'assoc #'member) (car ref) rtn))
+ (funcall push-to-rtn ref))))))
+ rtn))
+
+(defun org-footnote-unique-label (&optional current)
+ "Return a new unique footnote label.
+
+The function returns the first \"fn:N\" or \"N\" label that is
+currently not used.
+
+Optional argument CURRENT is the list of labels active in the
+buffer."
+ (unless current (setq current (org-footnote-all-labels)))
+ (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d"))
+ (cnt 1))
+ (while (member (format fmt cnt) current)
+ (incf cnt))
+ (format fmt cnt)))
+
+(defun org-footnote-new ()
+ "Insert a new footnote.
+This command prompts for a label. If this is a label referencing an
+existing label, only insert the label. If the footnote label is empty
+or new, let the user edit the definition of the footnote."
+ (interactive)
+ (unless (org-footnote-in-valid-context-p)
+ (error "Cannot insert a footnote here"))
+ (let* ((lbls (and (not (equal org-footnote-auto-label 'random))
+ (org-footnote-all-labels)))
+ (propose (and (not (equal org-footnote-auto-label 'random))
+ (org-footnote-unique-label lbls)))
+ (label
+ (org-footnote-normalize-label
+ (cond
+ ((member org-footnote-auto-label '(t plain))
+ propose)
+ ((equal org-footnote-auto-label 'random)
+ (require 'org-id)
+ (substring (org-id-uuid) 0 8))
+ (t
+ (org-icompleting-read
+ "Label (leave empty for anonymous): "
+ (mapcar 'list lbls) nil nil
+ (if (eq org-footnote-auto-label 'confirm) propose nil)))))))
+ (cond
+ ((bolp) (error "Cannot create a footnote reference at left margin"))
+ ((not label)
+ (insert "[fn:: ]")
+ (backward-char 1))
+ ((member label lbls)
+ (insert "[" label "]")
+ (message "New reference to existing note"))
+ (org-footnote-define-inline
+ (insert "[" label ": ]")
+ (backward-char 1)
+ (org-footnote-auto-adjust-maybe))
+ (t
+ (insert "[" label "]")
+ (org-footnote-create-definition label)
+ (org-footnote-auto-adjust-maybe)))))
+
+(defvar org-blank-before-new-entry) ; silence byte-compiler
+(defun org-footnote-create-definition (label)
+ "Start the definition of a footnote with label LABEL."
+ (interactive "sLabel: ")
+ (let ((label (org-footnote-normalize-label label)))
+ (cond
+ ;; In an Org file.
+ ((derived-mode-p 'org-mode)
+ ;; If `org-footnote-section' is defined, find it, or create it
+ ;; at the end of the buffer.
+ (when org-footnote-section
+ (goto-char (point-min))
+ (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")))
+ (unless (or (re-search-forward re nil t)
+ (and (progn (widen) t)
+ (re-search-forward re nil t)))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\r\n")
+ (unless (bolp) (newline))
+ ;; Insert new section. Separate it from the previous one
+ ;; with a blank line, unless `org-blank-before-new-entry'
+ ;; explicitly says no.
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
+ (insert "* " org-footnote-section "\n"))))
+ ;; Move to the end of this entry (which may be
+ ;; `org-footnote-section' or the current one).
+ (org-footnote-goto-local-insertion-point)
+ (org-show-context 'link-search))
+ (t
+ ;; In a non-Org file. Search for footnote tag, or create it if
+ ;; specified (at the end of buffer, or before signature if in
+ ;; Message mode). Set point after any definition already there.
+ (let ((tag (and org-footnote-tag-for-non-org-mode-files
+ (concat "^" (regexp-quote
+ org-footnote-tag-for-non-org-mode-files)
+ "[ \t]*$")))
+ (max (if (and (derived-mode-p 'message-mode)
+ (goto-char (point-max))
+ (re-search-backward
+ message-signature-separator nil t))
+ (progn
+ ;; Ensure one blank line separates last
+ ;; footnote from signature.
+ (beginning-of-line)
+ (open-line 2)
+ (point-marker))
+ (point-max-marker))))
+ (set-marker-insertion-type max t)
+ (goto-char max)
+ ;; Check if the footnote tag is defined but missing. In this
+ ;; case, insert it, before any footnote or one blank line
+ ;; after any previous text.
+ (when (and tag (not (re-search-backward tag nil t)))
+ (skip-chars-backward " \t\r\n")
+ (while (re-search-backward org-footnote-definition-re nil t))
+ (unless (bolp) (newline 2))
+ (insert org-footnote-tag-for-non-org-mode-files "\n\n"))
+ ;; Remove superfluous white space and clear marker.
+ (goto-char max)
+ (skip-chars-backward " \t\r\n")
+ (delete-region (point) max)
+ (unless (bolp) (newline))
+ (set-marker max nil))))
+ ;; Insert footnote label.
+ (when (zerop (org-back-over-empty-lines)) (newline))
+ (insert "[" label "] \n")
+ (backward-char)
+ ;; Only notify user about next possible action when in an Org
+ ;; buffer, as the bindings may have different meanings otherwise.
+ (when (derived-mode-p 'org-mode)
+ (message
+ "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
+
+;;;###autoload
+(defun org-footnote-action (&optional special)
+ "Do the right thing for footnotes.
+
+When at a footnote reference, jump to the definition.
+
+When at a definition, jump to the references if they exist, offer
+to create them otherwise.
+
+When neither at definition or reference, create a new footnote,
+interactively.
+
+With prefix arg SPECIAL, offer additional commands in a menu."
+ (interactive "P")
+ (let (tmp c)
+ (cond
+ (special
+ (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete")
+ (setq c (read-char-exclusive))
+ (cond
+ ((eq c ?s) (org-footnote-normalize 'sort))
+ ((eq c ?r) (org-footnote-renumber-fn:N))
+ ((eq c ?S)
+ (org-footnote-renumber-fn:N)
+ (org-footnote-normalize 'sort))
+ ((eq c ?n) (org-footnote-normalize))
+ ((eq c ?d) (org-footnote-delete))
+ (t (error "No such footnote command %c" c))))
+ ((setq tmp (org-footnote-at-reference-p))
+ (cond
+ ;; Anonymous footnote: move point at the beginning of its
+ ;; definition.
+ ((not (car tmp))
+ (goto-char (nth 1 tmp))
+ (forward-char 5))
+ ;; A definition exists: move to it.
+ ((ignore-errors (org-footnote-goto-definition (car tmp))))
+ ;; No definition exists: offer to create it.
+ ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp)))
+ (org-footnote-create-definition (car tmp)))))
+ ((setq tmp (org-footnote-at-definition-p))
+ (org-footnote-goto-previous-reference (car tmp)))
+ (t (org-footnote-new)))))
+
+(defvar org-footnote-insert-pos-for-preprocessor 'point-max
+ "See `org-footnote-normalize'.")
+
+(defvar org-export-footnotes-seen) ; silence byte-compiler
+(defvar org-export-footnotes-data) ; silence byte-compiler
+
+;;;###autoload
+(defun org-footnote-normalize (&optional sort-only export-props)
+ "Collect the footnotes in various formats and normalize them.
+
+This finds the different sorts of footnotes allowed in Org, and
+normalizes them to the usual [N] format that is understood by the
+Org-mode exporters.
+
+When SORT-ONLY is set, only sort the footnote definitions into the
+referenced sequence.
+
+If Org is amidst an export process, EXPORT-PROPS will hold the
+export properties of the buffer.
+
+When EXPORT-PROPS is non-nil, the default action is to insert
+normalized footnotes towards the end of the pre-processing
+buffer. Some exporters (docbook, odt...) expect footnote
+definitions to be available before any references to them. Such
+exporters can let bind `org-footnote-insert-pos-for-preprocessor'
+to symbol `point-min' to achieve the desired behaviour.
+
+Additional note on `org-footnote-insert-pos-for-preprocessor':
+1. This variable has not effect when FOR-PREPROCESSOR is nil.
+2. This variable (potentially) obviates the need for extra scan
+ of pre-processor buffer as witnessed in
+ `org-export-docbook-get-footnotes'."
+ ;; This is based on Paul's function, but rewritten.
+ ;;
+ ;; Re-create `org-with-limited-levels', but not limited to Org
+ ;; buffers.
+ (let* ((limit-level
+ (and (boundp 'org-inlinetask-min-level)
+ org-inlinetask-min-level
+ (1- org-inlinetask-min-level)))
+ (nstars (and limit-level
+ (if org-odd-levels-only
+ (and limit-level (1- (* limit-level 2)))
+ limit-level)))
+ (org-outline-regexp
+ (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
+ ;; Determine the highest marker used so far.
+ (ref-table (when export-props org-export-footnotes-seen))
+ (count (if (and export-props ref-table)
+ (apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table))
+ 0))
+ ins-point ref)
+ (save-excursion
+ ;; 1. Find every footnote reference, extract the definition, and
+ ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
+ ;; normalize references.
+ (goto-char (point-min))
+ (while (setq ref (org-footnote-get-next-reference))
+ (let* ((lbl (car ref))
+ (pos (nth 1 ref))
+ ;; When footnote isn't anonymous, check if it's label
+ ;; (REF) is already stored in REF-TABLE. In that case,
+ ;; extract number used to identify it (MARKER). If
+ ;; footnote is unknown, increment the global counter
+ ;; (COUNT) to create an unused identifier.
+ (a (and lbl (assoc lbl ref-table)))
+ (marker (or (nth 1 a) (incf count)))
+ ;; Is the reference inline or pointing to an inline
+ ;; footnote?
+ (inlinep (or (stringp (nth 3 ref)) (nth 3 a))))
+ ;; Replace footnote reference with [MARKER]. Maybe fill
+ ;; paragraph once done. If SORT-ONLY is non-nil, only move
+ ;; to the end of reference found to avoid matching it twice.
+ ;; If EXPORT-PROPS isn't nil, also add `org-footnote'
+ ;; property to it, so it can be easily recognized by
+ ;; exporters.
+ (if sort-only (goto-char (nth 2 ref))
+ (delete-region (nth 1 ref) (nth 2 ref))
+ (goto-char (nth 1 ref))
+ (let ((new-ref (format "[%d]" marker)))
+ (when export-props (org-add-props new-ref '(org-footnote t)))
+ (insert new-ref))
+ (and inlinep
+ org-footnote-fill-after-inline-note-extraction
+ (org-fill-paragraph)))
+ ;; Add label (REF), identifier (MARKER), definition (DEF)
+ ;; type (INLINEP) and position (POS) to REF-TABLE if data
+ ;; was unknown.
+ (unless a
+ (let ((def (or (nth 3 ref) ; inline
+ (and export-props
+ (cdr (assoc lbl org-export-footnotes-data)))
+ (nth 3 (org-footnote-get-definition lbl)))))
+ (push (list lbl marker
+ ;; When exporting, each definition goes
+ ;; through `org-export-preprocess-string' so
+ ;; it is ready to insert in the
+ ;; backend-specific buffer.
+ (if (and export-props def)
+ (let ((parameters
+ (org-combine-plists
+ export-props
+ '(:todo-keywords t :tags t :priority t))))
+ (apply #'org-export-preprocess-string def parameters))
+ def)
+ ;; Reference beginning position is a marker
+ ;; to preserve it during further buffer
+ ;; modifications.
+ inlinep (copy-marker pos)) ref-table)))))
+ ;; 2. Find and remove the footnote section, if any. Also
+ ;; determine where footnotes shall be inserted (INS-POINT).
+ (cond
+ ((and org-footnote-section (derived-mode-p 'org-mode))
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
+ "[ \t]*$") nil t)
+ (delete-region (match-beginning 0) (org-end-of-subtree t t)))
+ ;; A new footnote section is inserted by default at the end of
+ ;; the buffer.
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (unless (bolp) (newline)))
+ ;; No footnote section set: Footnotes will be added at the end
+ ;; of the section containing their first reference.
+ ;; Nevertheless, in an export situation, set insertion point to
+ ;; `point-max' by default.
+ ((derived-mode-p 'org-mode)
+ (when export-props
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (delete-region (point) (point-max))))
+ (t
+ ;; Remove any left-over tag in the buffer, if one is set up.
+ (when org-footnote-tag-for-non-org-mode-files
+ (let ((tag (concat "^" (regexp-quote
+ org-footnote-tag-for-non-org-mode-files)
+ "[ \t]*$")))
+ (goto-char (point-min))
+ (while (re-search-forward tag nil t)
+ (replace-match "")
+ (delete-region (point) (progn (forward-line) (point))))))
+ ;; In Message mode, ensure footnotes are inserted before the
+ ;; signature.
+ (if (and (derived-mode-p 'message-mode)
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator nil t))
+ (beginning-of-line)
+ (goto-char (point-max)))))
+ ;; During export, `org-footnote-insert-pos-for-preprocessor' has
+ ;; precedence over previously found position.
+ (setq ins-point
+ (copy-marker
+ (if (and export-props
+ (eq org-footnote-insert-pos-for-preprocessor 'point-min))
+ (point-min)
+ (point))))
+ ;; 3. Clean-up REF-TABLE.
+ (setq ref-table
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond
+ ;; When only sorting, ignore inline footnotes.
+ ;; Also clear position marker.
+ ((and sort-only (nth 3 x))
+ (set-marker (nth 4 x) nil) nil)
+ ;; No definition available: provide one.
+ ((not (nth 2 x))
+ (append
+ (list (car x) (nth 1 x)
+ (format "DEFINITION NOT FOUND: %s" (car x)))
+ (nthcdr 3 x)))
+ (t x)))
+ ref-table)))
+ (setq ref-table (nreverse ref-table))
+ ;; 4. Remove left-over definitions in the buffer.
+ (mapc (lambda (x)
+ (unless (nth 3 x) (org-footnote-delete-definitions (car x))))
+ ref-table)
+ ;; 5. Insert the footnotes again in the buffer, at the
+ ;; appropriate spot.
+ (goto-char ins-point)
+ (cond
+ ;; No footnote: exit.
+ ((not ref-table))
+ ;; Cases when footnotes should be inserted in one place.
+ ((or (not (derived-mode-p 'org-mode))
+ org-footnote-section
+ export-props)
+ ;; Insert again the section title, if any. Ensure that title,
+ ;; or the subsequent footnotes, will be separated by a blank
+ ;; lines from the rest of the document. In an Org buffer,
+ ;; separate section with a blank line, unless explicitly
+ ;; stated in `org-blank-before-new-entry'.
+ (cond
+ ((not (derived-mode-p 'org-mode))
+ (skip-chars-backward " \t\n\r")
+ (delete-region (point) ins-point)
+ (unless (bolp) (newline))
+ (when org-footnote-tag-for-non-org-mode-files
+ (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
+ ((and org-footnote-section (not export-props))
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
+ (insert "* " org-footnote-section "\n")))
+ (set-marker ins-point nil)
+ ;; Insert the footnotes, separated by a blank line.
+ (insert
+ (mapconcat
+ (lambda (x)
+ ;; Clean markers.
+ (set-marker (nth 4 x) nil)
+ (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x)))
+ ref-table "\n"))
+ (unless (eobp) (insert "\n\n"))
+ ;; When exporting, add newly inserted markers along with their
+ ;; associated definition to `org-export-footnotes-seen'.
+ (when export-props (setq org-export-footnotes-seen ref-table)))
+ ;; Each footnote definition has to be inserted at the end of
+ ;; the section where its first reference belongs.
+ (t
+ (mapc
+ (lambda (x)
+ (let ((pos (nth 4 x)))
+ (goto-char pos)
+ ;; Clean marker.
+ (set-marker pos nil))
+ (org-footnote-goto-local-insertion-point)
+ (insert (format "\n[%s] %s\n"
+ (if sort-only (car x) (nth 1 x))
+ (nth 2 x))))
+ ref-table))))))
+
+(defun org-footnote-goto-local-insertion-point ()
+ "Find insertion point for footnote, just before next outline heading."
+ (org-with-limited-levels (outline-next-heading))
+ (or (bolp) (newline))
+ (beginning-of-line 0)
+ (while (and (not (bobp)) (= (char-after) ?#))
+ (beginning-of-line 0))
+ (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2))
+ (end-of-line 1)
+ (skip-chars-backward "\n\r\t ")
+ (forward-line))
+
+(defun org-footnote-delete-references (label)
+ "Delete every reference to footnote LABEL.
+Return the number of footnotes removed."
+ (save-excursion
+ (goto-char (point-min))
+ (let (ref (nref 0))
+ (while (setq ref (org-footnote-get-next-reference label))
+ (goto-char (nth 1 ref))
+ (delete-region (nth 1 ref) (nth 2 ref))
+ (incf nref))
+ nref)))
+
+(defun org-footnote-delete-definitions (label)
+ "Delete every definition of the footnote LABEL.
+Return the number of footnotes removed."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((def-re (concat "^\\[" (regexp-quote label) "\\]"))
+ (ndef 0))
+ (while (re-search-forward def-re nil t)
+ (let ((full-def (org-footnote-at-definition-p)))
+ (when full-def
+ ;; Remove the footnote, and all blank lines before it.
+ (goto-char (nth 1 full-def))
+ (skip-chars-backward " \r\t\n")
+ (unless (bolp) (forward-line))
+ (delete-region (point) (nth 2 full-def))
+ (incf ndef))))
+ ndef)))
+
+(defun org-footnote-delete (&optional label)
+ "Delete the footnote at point.
+This will remove the definition (even multiple definitions if they exist)
+and all references of a footnote label.
+
+If LABEL is non-nil, delete that footnote instead."
+ (catch 'done
+ (let* ((nref 0) (ndef 0) x
+ ;; 1. Determine LABEL of footnote at point.
+ (label (cond
+ ;; LABEL is provided as argument.
+ (label)
+ ;; Footnote reference at point. If the footnote is
+ ;; anonymous, delete it and exit instead.
+ ((setq x (org-footnote-at-reference-p))
+ (or (car x)
+ (progn
+ (delete-region (nth 1 x) (nth 2 x))
+ (message "Anonymous footnote removed")
+ (throw 'done t))))
+ ;; Footnote definition at point.
+ ((setq x (org-footnote-at-definition-p))
+ (car x))
+ (t (error "Don't know which footnote to remove")))))
+ ;; 2. Now that LABEL is non-nil, find every reference and every
+ ;; definition, and delete them.
+ (setq nref (org-footnote-delete-references label)
+ ndef (org-footnote-delete-definitions label))
+ ;; 3. Verify consistency of footnotes and notify user.
+ (org-footnote-auto-adjust-maybe)
+ (message "%d definition(s) of and %d reference(s) of footnote %s removed"
+ ndef nref label))))
+
+(defun org-footnote-renumber-fn:N ()
+ "Renumber the simple footnotes like fn:17 into a sequence in the document."
+ (interactive)
+ (let (map (n 0))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ ;; Ensure match is a footnote reference or definition.
+ (when (save-match-data (if (bolp)
+ (org-footnote-at-definition-p)
+ (org-footnote-at-reference-p)))
+ (let ((new-val (or (cdr (assoc (match-string 1) map))
+ (number-to-string (incf n)))))
+ (unless (assoc (match-string 1) map)
+ (push (cons (match-string 1) new-val) map))
+ (replace-match new-val nil nil nil 1))))))))
+
+(defun org-footnote-auto-adjust-maybe ()
+ "Renumber and/or sort footnotes according to user settings."
+ (when (memq org-footnote-auto-adjust '(t renumber))
+ (org-footnote-renumber-fn:N))
+ (when (memq org-footnote-auto-adjust '(t sort))
+ (let ((label (car (org-footnote-at-definition-p))))
+ (org-footnote-normalize 'sort)
+ (when label
+ (goto-char (point-min))
+ (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]")
+ nil t)
+ (progn (insert " ")
+ (just-one-space)))))))
+
+(provide 'org-footnote)
+
+;;; org-footnote.el ends here
diff --git a/lisp/org-freemind.el b/lisp/org-freemind.el
new file mode 100644
index 0000000..a05cb55
--- /dev/null
+++ b/lisp/org-freemind.el
@@ -0,0 +1,1226 @@
+;;; org-freemind.el --- Export Org files to freemind
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; --------------------------------------------------------------------
+;; Features that might be required by this library:
+;;
+;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
+;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
+;; `org-list', `org-macs', `org-src', `outline', `syntax',
+;; `time-date', `xml'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file tries to implement some functions useful for
+;; transformation between org-mode and FreeMind files.
+;;
+;; Here are the commands you can use:
+;;
+;; M-x `org-freemind-from-org-mode'
+;; M-x `org-freemind-from-org-mode-node'
+;; M-x `org-freemind-from-org-sparse-tree'
+;;
+;; M-x `org-freemind-to-org-mode'
+;;
+;; M-x `org-freemind-show'
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change log:
+;;
+;; 2009-02-15: Added check for next level=current+1
+;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
+;; 2009-10-25: Added support for `org-odd-levels-only'.
+;; Added y/n question before showing in FreeMind.
+;; 2009-11-04: Added support for #+BEGIN_HTML.
+;;
+;;; Code:
+
+(require 'xml)
+(require 'org)
+ ;(require 'rx)
+(require 'org-exp)
+(eval-when-compile (require 'cl))
+
+(defgroup org-freemind nil
+ "Customization group for org-freemind export/import."
+ :group 'org)
+
+;; Fix-me: I am not sure these are useful:
+;;
+;; (defcustom org-freemind-main-fgcolor "black"
+;; "Color of main node's text."
+;; :type 'color
+;; :group 'org-freemind)
+
+;; (defcustom org-freemind-main-color "black"
+;; "Background color of main node."
+;; :type 'color
+;; :group 'org-freemind)
+
+;; (defcustom org-freemind-child-fgcolor "black"
+;; "Color of child nodes' text."
+;; :type 'color
+;; :group 'org-freemind)
+
+;; (defcustom org-freemind-child-color "black"
+;; "Background color of child nodes."
+;; :type 'color
+;; :group 'org-freemind)
+
+(defvar org-freemind-node-style nil "Internal use.")
+
+(defcustom org-freemind-node-styles nil
+ "Styles to apply to node.
+NOT READY YET."
+ :type '(repeat
+ (list :tag "Node styles for file"
+ (regexp :tag "File name")
+ (repeat
+ (list :tag "Node"
+ (regexp :tag "Node name regexp")
+ (set :tag "Node properties"
+ (list :format "%v" (const :format "" node-style)
+ (choice :tag "Style"
+ :value bubble
+ (const bubble)
+ (const fork)))
+ (list :format "%v" (const :format "" color)
+ (color :tag "Color" :value "red"))
+ (list :format "%v" (const :format "" background-color)
+ (color :tag "Background color" :value "yellow"))
+ (list :format "%v" (const :format "" edge-color)
+ (color :tag "Edge color" :value "green"))
+ (list :format "%v" (const :format "" edge-style)
+ (choice :tag "Edge style" :value bezier
+ (const :tag "Linear" linear)
+ (const :tag "Bezier" bezier)
+ (const :tag "Sharp Linear" sharp-linear)
+ (const :tag "Sharp Bezier" sharp-bezier)))
+ (list :format "%v" (const :format "" edge-width)
+ (choice :tag "Edge width" :value thin
+ (const :tag "Parent" parent)
+ (const :tag "Thin" thin)
+ (const 1)
+ (const 2)
+ (const 4)
+ (const 8)))
+ (list :format "%v" (const :format "" italic)
+ (const :tag "Italic font" t))
+ (list :format "%v" (const :format "" bold)
+ (const :tag "Bold font" t))
+ (list :format "%v" (const :format "" font-name)
+ (string :tag "Font name" :value "SansSerif"))
+ (list :format "%v" (const :format "" font-size)
+ (integer :tag "Font size" :value 12)))))))
+ :group 'org-freemind)
+
+;;;###autoload
+(defun org-export-as-freemind (&optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the current buffer as a Freemind file.
+If there is an active region, export only the region. HIDDEN is
+obsolete and does nothing. EXT-PLIST is a property list with
+external parameters overriding org-mode's default settings, but
+still inferior to file-local settings. When TO-BUFFER is
+non-nil, create a buffer with that name and export to that
+buffer. If TO-BUFFER is the symbol `string', don't leave any
+buffer behind but just return the resulting HTML as a string.
+When BODY-ONLY is set, don't produce the file header and footer,
+simply return the content of the document (all top level
+sections). When PUB-DIR is set, use this as the publishing
+directory.
+
+See `org-freemind-from-org-mode' for more information."
+ (interactive "P")
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist)))
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
+ (filename (concat (file-name-as-directory
+ (or pub-dir
+ (org-export-directory :ascii opt-plist)))
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory bfname)))
+ ".mm")))
+ (when (file-exists-p filename)
+ (delete-file filename))
+ (cond
+ (subtree-p
+ (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
+ filename))
+ (t (org-freemind-from-org-mode bfname filename)))))
+
+;;;###autoload
+(defun org-freemind-show (mm-file)
+ "Show file MM-FILE in Freemind."
+ (interactive
+ (list
+ (save-match-data
+ (let ((name (read-file-name "FreeMind file: "
+ nil nil nil
+ (if (buffer-file-name)
+ (let* ((name-ext (file-name-nondirectory (buffer-file-name)))
+ (name (file-name-sans-extension name-ext))
+ (ext (file-name-extension name-ext)))
+ (cond
+ ((string= "mm" ext)
+ name-ext)
+ ((string= "org" ext)
+ (let ((name-mm (concat name ".mm")))
+ (if (file-exists-p name-mm)
+ name-mm
+ (message "Not exported to Freemind format yet")
+ "")))
+ (t
+ "")))
+ "")
+ ;; Fix-me: Is this an Emacs bug?
+ ;; This predicate function is never
+ ;; called.
+ (lambda (fn)
+ (string-match "^mm$" (file-name-extension fn))))))
+ (setq name (expand-file-name name))
+ name))))
+ (org-open-file mm-file))
+
+(defconst org-freemind-org-nfix "--org-mode: ")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Format converters
+
+(defun org-freemind-escape-str-from-org (org-str)
+ "Do some html-escaping of ORG-STR and return the result.
+The characters \"&<> will be escaped."
+ (let ((chars (append org-str nil))
+ (fm-str ""))
+ (dolist (cc chars)
+ (setq fm-str
+ (concat fm-str
+ (if (< cc 160)
+ (cond
+ ((= cc ?\") "&quot;")
+ ((= cc ?\&) "&amp;")
+ ((= cc ?\<) "&lt;")
+ ((= cc ?\>) "&gt;")
+ (t (char-to-string cc)))
+ ;; Formatting as &#number; is maybe needed
+ ;; according to a bug report from kazuo
+ ;; fujimoto, but I have now instead added a xml
+ ;; processing instruction saying that the mm
+ ;; file is utf-8:
+ ;;
+ ;; (format "&#x%x;" (- cc ;; ?\x800))
+ (format "&#x%x;" (encode-char cc 'ucs))
+ ))))
+ fm-str))
+
+;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
+;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
+(defun org-freemind-unescape-str-to-org (fm-str)
+ "Do some html-unescaping of FM-STR and return the result.
+This is the opposite of `org-freemind-escape-str-from-org' but it
+will also unescape &#nn;."
+ (let ((org-str fm-str))
+ (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
+ (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
+ (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
+ (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
+ (setq org-str (replace-regexp-in-string
+ "&#x\\([a-f0-9]\\{2,4\\}\\);"
+ (lambda (m)
+ (char-to-string
+ (+ (string-to-number (match-string 1 m) 16)
+ 0 ;?\x800 ;; What is this for? Encoding?
+ )))
+ org-str))))
+
+;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: ")
+;; (str2 (org-freemind-escape-str-from-org str1))
+;; (str3 (org-freemind-unescape-str-to-org str2)))
+;; (unless (string= str1 str3)
+;; (error "Error str3=%s" str3)))
+
+(defun org-freemind-convert-links-helper (matched)
+ "Helper for `org-freemind-convert-links-from-org'.
+MATCHED is the link just matched."
+ (let* ((link (match-string 1 matched))
+ (text (match-string 2 matched))
+ (ext (file-name-extension link))
+ (col-pos (org-string-match-p ":" link))
+ (is-img (and (image-type-from-file-name link)
+ (let ((url-type (substring link 0 col-pos)))
+ (member url-type '("file" "http" "https")))))
+ )
+ (if is-img
+ ;; Fix-me: I can't find a way to get the border to "shrink
+ ;; wrap" around the image using <div>.
+ ;;
+ ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
+ ;; "<img src=\"" link "\" alt=\"" text "\" />"
+ ;; "<br />"
+ ;; "<i>" text "</i>"
+ ;; "</div>")
+ (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
+ "<img src=\"" link "\" alt=\"" text "\" />"
+ "<br />"
+ "<i>" text "</i>"
+ "</td></tr></table>")
+ (concat "<a href=\"" link "\">" text "</a>"))))
+
+(defun org-freemind-convert-links-from-org (org-str)
+ "Convert org links in ORG-STR to freemind links and return the result."
+ (let ((fm-str (replace-regexp-in-string
+ ;;(rx (not (any "[\""))
+ ;; (submatch
+ ;; "http"
+ ;; (opt ?\s)
+ ;; "://"
+ ;; (1+
+ ;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
+ "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
+ "[[\\1][\\1]]"
+ org-str
+ nil ;; fixedcase
+ nil ;; literal
+ 1 ;; subexp
+ )))
+ (replace-regexp-in-string
+ ;;(rx "[["
+ ;; (submatch (*? nonl))
+ ;; "]["
+ ;; (submatch (*? nonl))
+ ;; "]]")
+ "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
+ ;;"<a href=\"\\1\">\\2</a>"
+ 'org-freemind-convert-links-helper
+ fm-str t t)))
+
+;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
+(defun org-freemind-convert-links-to-org (fm-str)
+ "Convert freemind links in FM-STR to org links and return the result."
+ (let ((org-str (replace-regexp-in-string
+ ;;(rx "<a"
+ ;; space
+ ;; (0+
+ ;; (0+ (not (any ">")))
+ ;; space)
+ ;; "href=\""
+ ;; (submatch (0+ (not (any "\""))))
+ ;; "\""
+ ;; (0+ (not (any ">")))
+ ;; ">"
+ ;; (submatch (0+ (not (any "<"))))
+ ;; "</a>")
+ "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
+ "[[\\1][\\2]]"
+ fm-str)))
+ org-str))
+
+;; Fix-me:
+;;(defun org-freemind-convert-drawers-from-org (text)
+;; )
+
+;; (let* ((str1 "[[http://www.somewhere/][link-text]")
+;; (str2 (org-freemind-convert-links-from-org str1))
+;; (str3 (org-freemind-convert-links-to-org str2)))
+;; (unless (string= str1 str3)
+;; (error "Error str3=%s" str3)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Org => FreeMind
+
+(defvar org-freemind-bol-helper-base-indent nil)
+
+(defun org-freemind-bol-helper (matched)
+ "Helper for `org-freemind-convert-text-p'.
+MATCHED is the link just matched."
+ (let ((res "")
+ (bi org-freemind-bol-helper-base-indent))
+ (dolist (cc (append matched nil))
+ (if (= 32 cc)
+ ;;(setq res (concat res "&nbsp;"))
+ ;; We need to use the numerical version. Otherwise Freemind
+ ;; ver 0.9.0 RC9 can not export to html/javascript.
+ (progn
+ (if (< 0 bi)
+ (setq bi (1- bi))
+ (setq res (concat res "&#160;"))))
+ (setq res (concat res (char-to-string cc)))))
+ res))
+;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
+
+(defun org-freemind-convert-text-p (text)
+ "Convert TEXT to html with <p> paragraphs."
+ ;; (string-match-p "[^ ]" " a")
+ (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
+ (setq text (org-freemind-escape-str-from-org text))
+
+ (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
+ (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text))
+
+ (setq text (concat "<p>" text))
+ (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text))
+ (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text))
+ (setq text (replace-regexp-in-string "\n" "<br />" text))
+ (setq text (concat text "</p>"))
+
+ (org-freemind-convert-links-from-org text))
+
+(defcustom org-freemind-node-css-style
+ "p { margin-top: 3px; margin-bottom: 3px; }"
+ "CSS style for Freemind nodes."
+ ;; Fix-me: I do not understand this. It worked to export from Freemind
+ ;; with this setting now, but not before??? Was this perhaps a java
+ ;; bug or is it a windows xp bug (some resource gets exhausted if you
+ ;; use sticky keys which I do).
+ :version "24.1"
+ :group 'org-freemind)
+
+(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
+ "Convert text part of org node to freemind subnode or note.
+Convert the text part of the org node named NODE-NAME. The text
+is in the current buffer between START and END. Drawers matching
+DRAWERS-REGEXP are converted to freemind notes."
+ ;; fix-me: doc
+ (let ((text (buffer-substring-no-properties start end))
+ (node-res "")
+ (note-res ""))
+ (save-match-data
+ ;;(setq text (org-freemind-escape-str-from-org text))
+ ;; First see if there is something that should be moved to the
+ ;; note part:
+ (let (drawers)
+ (while (string-match drawers-regexp text)
+ (setq drawers (cons (match-string 0 text) drawers))
+ (setq text
+ (concat (substring text 0 (match-beginning 0))
+ (substring text (match-end 0))))
+ )
+ (when drawers
+ (dolist (drawer drawers)
+ (let ((lines (split-string drawer "\n")))
+ (dolist (line lines)
+ (setq note-res (concat
+ note-res
+ org-freemind-org-nfix line "<br />\n")))
+ ))))
+
+ (when (> (length note-res) 0)
+ (setq note-res (concat
+ "<richcontent TYPE=\"NOTE\"><html>\n"
+ "<head>\n"
+ "</head>\n"
+ "<body>\n"
+ note-res
+ "</body>\n"
+ "</html>\n"
+ "</richcontent>\n")))
+
+ ;; There is always an LF char:
+ (when (> (length text) 1)
+ (setq node-res (concat
+ "<node style=\"bubble\" background_color=\"#eeee00\">\n"
+ "<richcontent TYPE=\"NODE\"><html>\n"
+ "<head>\n"
+ (if (= 0 (length org-freemind-node-css-style))
+ ""
+ (concat
+ "<style type=\"text/css\">\n"
+ "<!--\n"
+ org-freemind-node-css-style
+ "-->\n"
+ "</style>\n"))
+ "</head>\n"
+ "<body>\n"))
+ (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
+ (end-html-mark (regexp-quote "#+END_HTML"))
+ head
+ end-pos
+ end-pos-match
+ )
+ ;; Take care of #+BEGIN_HTML - #+END_HTML
+ (while (string-match begin-html-mark text)
+ (setq head (substring text 0 (match-beginning 0)))
+ (setq end-pos-match (match-end 0))
+ (setq node-res (concat node-res
+ (org-freemind-convert-text-p head)))
+ (setq text (substring text end-pos-match))
+ (setq end-pos (string-match end-html-mark text))
+ (if end-pos
+ (setq end-pos-match (match-end 0))
+ (message "org-freemind: Missing #+END_HTML")
+ (setq end-pos (length text))
+ (setq end-pos-match end-pos))
+ (setq node-res (concat node-res
+ (substring text 0 end-pos)))
+ (setq text (substring text end-pos-match)))
+ (setq node-res (concat node-res
+ (org-freemind-convert-text-p text))))
+ (setq node-res (concat
+ node-res
+ "</body>\n"
+ "</html>\n"
+ "</richcontent>\n"
+ ;; Put a note that this is for the parent node
+ ;; "<richcontent TYPE=\"NOTE\"><html>"
+ ;; "<head>"
+ ;; "</head>"
+ ;; "<body>"
+ ;; "<p>"
+ ;; "-- This is more about \"" node-name "\" --"
+ ;; "</p>"
+ ;; "</body>"
+ ;; "</html>"
+ ;; "</richcontent>\n"
+ note-res
+ "</node>\n" ;; ok
+ )))
+ (list node-res note-res))))
+
+(defun org-freemind-write-node (mm-buffer drawers-regexp
+ num-left-nodes base-level
+ current-level next-level this-m2
+ this-node-end
+ this-children-visible
+ next-node-start
+ next-has-some-visible-child)
+ (let* (this-icons
+ this-bg-color
+ this-m2-link
+ this-m2-escaped
+ this-rich-node
+ this-rich-note
+ )
+ (when (string-match "TODO" this-m2)
+ (setq this-m2 (replace-match "" nil nil this-m2))
+ (add-to-list 'this-icons "button_cancel")
+ (setq this-bg-color "#ffff88")
+ (when (string-match "\\[#\\(.\\)\\]" this-m2)
+ (let ((prior (string-to-char (match-string 1 this-m2))))
+ (setq this-m2 (replace-match "" nil nil this-m2))
+ (cond
+ ((= prior ?A)
+ (add-to-list 'this-icons "full-1")
+ (setq this-bg-color "#ff0000"))
+ ((= prior ?B)
+ (add-to-list 'this-icons "full-2")
+ (setq this-bg-color "#ffaa00"))
+ ((= prior ?C)
+ (add-to-list 'this-icons "full-3")
+ (setq this-bg-color "#ffdd00"))
+ ((= prior ?D)
+ (add-to-list 'this-icons "full-4")
+ (setq this-bg-color "#ffff00"))
+ ((= prior ?E)
+ (add-to-list 'this-icons "full-5"))
+ ((= prior ?F)
+ (add-to-list 'this-icons "full-6"))
+ ((= prior ?G)
+ (add-to-list 'this-icons "full-7"))
+ ))))
+ (setq this-m2 (org-trim this-m2))
+ (when (string-match org-bracket-link-analytic-regexp this-m2)
+ (setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
+ (match-string 3 this-m2) "\" ")
+ this-m2 (replace-match "\\5" nil nil this-m2 0)))
+ (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
+ (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
+ this-m2-escaped
+ this-node-end
+ (1- next-node-start)
+ drawers-regexp)))
+ (setq this-rich-node (nth 0 node-notes))
+ (setq this-rich-note (nth 1 node-notes)))
+ (with-current-buffer mm-buffer
+ (insert "<node " (if this-m2-link this-m2-link "")
+ "text=\"" this-m2-escaped "\"")
+ (org-freemind-get-node-style this-m2)
+ (when (> next-level current-level)
+ (unless (or this-children-visible
+ next-has-some-visible-child)
+ (insert " folded=\"true\"")))
+ (when (and (= current-level (1+ base-level))
+ (> num-left-nodes 0))
+ (setq num-left-nodes (1- num-left-nodes))
+ (insert " position=\"left\""))
+ (when this-bg-color
+ (insert " background_color=\"" this-bg-color "\""))
+ (insert ">\n")
+ (when this-icons
+ (dolist (icon this-icons)
+ (insert "<icon builtin=\"" icon "\"/>\n")))
+ )
+ (with-current-buffer mm-buffer
+ ;;(when this-rich-note (insert this-rich-note))
+ (when this-rich-node (insert this-rich-node))))
+ num-left-nodes)
+
+(defun org-freemind-check-overwrite (file interactively)
+ "Check if file FILE already exists.
+If FILE does not exists return t.
+
+If INTERACTIVELY is non-nil ask if the file should be replaced
+and return t/nil if it should/should not be replaced.
+
+Otherwise give an error say the file exists."
+ (if (file-exists-p file)
+ (if interactively
+ (y-or-n-p (format "File %s exists, replace it? " file))
+ (error "File %s already exists" file))
+ t))
+
+(defvar org-freemind-node-pattern
+ ;;(rx bol
+ ;; (submatch (1+ "*"))
+ ;; (1+ space)
+ ;; (submatch (*? nonl))
+ ;; eol)
+ "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
+
+(defun org-freemind-look-for-visible-child (node-level)
+ (save-excursion
+ (save-match-data
+ (let ((found-visible-child nil))
+ (while (and (not found-visible-child)
+ (re-search-forward org-freemind-node-pattern nil t))
+ (let* ((m1 (match-string-no-properties 1))
+ (level (length m1)))
+ (if (>= node-level level)
+ (setq found-visible-child 'none)
+ (unless (get-char-property (line-beginning-position) 'invisible)
+ (setq found-visible-child 'found)))))
+ (eq found-visible-child 'found)
+ ))))
+
+(defun org-freemind-goto-line (line)
+ "Go to line number LINE."
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
+ (with-current-buffer org-buffer
+ (dolist (node-style org-freemind-node-styles)
+ (when (org-string-match-p (car node-style) buffer-file-name)
+ (setq org-freemind-node-style (cadr node-style))))
+ ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
+ (save-match-data
+ (let* ((drawers (copy-sequence org-drawers))
+ drawers-regexp
+ (num-top1-nodes 0)
+ (num-top2-nodes 0)
+ num-left-nodes
+ (unclosed-nodes 0)
+ (odd-only org-odd-levels-only)
+ (first-time t)
+ (current-level 1)
+ base-level
+ prev-node-end
+ rich-text
+ unfinished-tag
+ node-at-line-level
+ node-at-line-last)
+ (with-current-buffer mm-buffer
+ (erase-buffer)
+ (setq buffer-file-coding-system 'utf-8)
+ ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this:
+ ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
+ (insert "<map version=\"0.9.0\">\n")
+ (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
+ (save-excursion
+ ;; Get special buffer vars:
+ (goto-char (point-min))
+ (message "Writing Freemind file...")
+ (while (re-search-forward "^#\\+DRAWERS:" nil t)
+ (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
+ (setq drawers (append drawers (split-string dr-txt) nil))))
+ (setq drawers-regexp
+ (concat "^[[:blank:]]*:"
+ (regexp-opt drawers)
+ ;;(rx ":" (0+ blank)
+ ;; "\n"
+ ;; (*? anything)
+ ;; "\n"
+ ;; (0+ blank)
+ ;; ":END:"
+ ;; (0+ blank)
+ ;; eol)
+ ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
+ ))
+
+ (if node-at-line
+ ;; Get number of top nodes and last line for this node
+ (progn
+ (org-freemind-goto-line node-at-line)
+ (unless (looking-at org-freemind-node-pattern)
+ (error "No node at line %s" node-at-line))
+ (setq node-at-line-level (length (match-string-no-properties 1)))
+ (forward-line)
+ (setq node-at-line-last
+ (catch 'last-line
+ (while (re-search-forward org-freemind-node-pattern nil t)
+ (let* ((m1 (match-string-no-properties 1))
+ (level (length m1)))
+ (if (<= level node-at-line-level)
+ (progn
+ (beginning-of-line)
+ (throw 'last-line (1- (point))))
+ (if (= level (1+ node-at-line-level))
+ (setq num-top2-nodes (1+ num-top2-nodes))))))))
+ (setq current-level node-at-line-level)
+ (setq num-top1-nodes 1)
+ (org-freemind-goto-line node-at-line))
+
+ ;; First get number of top nodes
+ (goto-char (point-min))
+ (while (re-search-forward org-freemind-node-pattern nil t)
+ (let* ((m1 (match-string-no-properties 1))
+ (level (length m1)))
+ (if (= level 1)
+ (setq num-top1-nodes (1+ num-top1-nodes))
+ (if (= level 2)
+ (setq num-top2-nodes (1+ num-top2-nodes))))))
+ ;; If there is more than one top node we need to insert a node
+ ;; to keep them together.
+ (goto-char (point-min))
+ (when (> num-top1-nodes 1)
+ (setq num-top2-nodes num-top1-nodes)
+ (setq current-level 0)
+ (let ((orig-name (if buffer-file-name
+ (file-name-nondirectory (buffer-file-name))
+ (buffer-name))))
+ (with-current-buffer mm-buffer
+ (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n"
+ ;; Put a note that this is for the parent node
+ "<richcontent TYPE=\"NOTE\"><html>"
+ "<head>"
+ "</head>"
+ "<body>"
+ "<p>"
+ org-freemind-org-nfix "WHOLE FILE"
+ "</p>"
+ "</body>"
+ "</html>"
+ "</richcontent>\n")))))
+
+ (setq num-left-nodes (floor num-top2-nodes 2))
+ (setq base-level current-level)
+ (let (this-m2
+ this-node-end
+ this-children-visible
+ next-m2
+ next-node-start
+ next-level
+ next-has-some-visible-child
+ next-children-visible
+ )
+ (while (and
+ (re-search-forward org-freemind-node-pattern nil t)
+ (if node-at-line-last (<= (point) node-at-line-last) t)
+ )
+ (let* ((next-m1 (match-string-no-properties 1))
+ (next-node-end (match-end 0))
+ )
+ (setq next-node-start (match-beginning 0))
+ (setq next-m2 (match-string-no-properties 2))
+ (setq next-level (length next-m1))
+ (setq next-children-visible
+ (not (eq 'outline
+ (get-char-property (line-end-position) 'invisible))))
+ (setq next-has-some-visible-child
+ (if next-children-visible t
+ (org-freemind-look-for-visible-child next-level)))
+ (when this-m2
+ (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)))
+ (when (if (= num-top1-nodes 1) (> current-level base-level) t)
+ (while (>= current-level next-level)
+ (with-current-buffer mm-buffer
+ (insert "</node>\n")
+ (setq current-level
+ (- current-level (if odd-only 2 1))))))
+ (setq this-node-end (1+ next-node-end))
+ (setq this-m2 next-m2)
+ (setq current-level next-level)
+ (setq this-children-visible next-children-visible)
+ (forward-char)
+ ))
+;;; (unless (if node-at-line-last
+;;; (>= (point) node-at-line-last)
+;;; nil)
+ ;; Write last node:
+ (setq this-m2 next-m2)
+ (setq current-level next-level)
+ (setq next-node-start (if node-at-line-last
+ (1+ node-at-line-last)
+ (point-max)))
+ (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
+ (with-current-buffer mm-buffer (insert "</node>\n"))
+ ;)
+ )
+ (with-current-buffer mm-buffer
+ (while (> current-level base-level)
+ (insert "</node>\n")
+ (setq current-level
+ (- current-level (if odd-only 2 1)))
+ ))
+ (with-current-buffer mm-buffer
+ (insert "</map>")
+ (delete-trailing-whitespace)
+ (goto-char (point-min))
+ ))))))
+
+(defun org-freemind-get-node-style (node-name)
+ "NOT READY YET."
+ ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
+ ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
+ (let (node-styles
+ node-style)
+ (dolist (style-list org-freemind-node-style)
+ (let ((node-regexp (car style-list)))
+ (message "node-regexp=%s node-name=%s" node-regexp node-name)
+ (when (org-string-match-p node-regexp node-name)
+ ;;(setq node-style (org-freemind-do-apply-node-style style-list))
+ (setq node-style (cadr style-list))
+ (when node-style
+ (message "node-style=%s" node-style)
+ (setq node-styles (append node-styles node-style)))
+ )))))
+
+(defun org-freemind-do-apply-node-style (style-list)
+ (message "style-list=%S" style-list)
+ (let ((node-style 'fork)
+ (color "red")
+ (background-color "yellow")
+ (edge-color "green")
+ (edge-style 'bezier)
+ (edge-width 'thin)
+ (italic t)
+ (bold t)
+ (font-name "SansSerif")
+ (font-size 12))
+ (dolist (style (cadr style-list))
+ (message " style=%s" style)
+ (let ((what (car style)))
+ (cond
+ ((eq what 'node-style)
+ (setq node-style (cadr style)))
+ ((eq what 'color)
+ (setq color (cadr style)))
+ ((eq what 'background-color)
+ (setq background-color (cadr style)))
+
+ ((eq what 'edge-color)
+ (setq edge-color (cadr style)))
+
+ ((eq what 'edge-style)
+ (setq edge-style (cadr style)))
+
+ ((eq what 'edge-width)
+ (setq edge-width (cadr style)))
+
+ ((eq what 'italic)
+ (setq italic (cadr style)))
+
+ ((eq what 'bold)
+ (setq bold (cadr style)))
+
+ ((eq what 'font-name)
+ (setq font-name (cadr style)))
+
+ ((eq what 'font-size)
+ (setq font-size (cadr style)))
+ )
+ (insert (format " style=\"%s\"" node-style))
+ (insert (format " color=\"%s\"" color))
+ (insert (format " background_color=\"%s\"" background-color))
+ (insert ">\n")
+ (insert "<edge")
+ (insert (format " color=\"%s\"" edge-color))
+ (insert (format " style=\"%s\"" edge-style))
+ (insert (format " width=\"%s\"" edge-width))
+ (insert "/>\n")
+ (insert "<font")
+ (insert (format " italic=\"%s\"" italic))
+ (insert (format " bold=\"%s\"" bold))
+ (insert (format " name=\"%s\"" font-name))
+ (insert (format " size=\"%s\"" font-size))
+ ))))
+
+;;;###autoload
+(defun org-freemind-from-org-mode-node (node-line mm-file)
+ "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
+See `org-freemind-from-org-mode' for more information."
+ (interactive
+ (progn
+ (unless (org-back-to-heading nil)
+ (error "Can't find org-mode node start"))
+ (let* ((line (line-number-at-pos))
+ (default-mm-file (concat (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ "nofile")
+ "-line-" (number-to-string line)
+ ".mm"))
+ (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
+ (list line mm-file))))
+ (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
+ (let ((org-buffer (current-buffer))
+ (mm-buffer (find-file-noselect mm-file)))
+ (org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
+ (with-current-buffer mm-buffer
+ (basic-save-buffer)
+ (when (org-called-interactively-p 'any)
+ (switch-to-buffer-other-window mm-buffer)
+ (when (y-or-n-p "Show in FreeMind? ")
+ (org-freemind-show buffer-file-name)))))))
+
+;;;###autoload
+(defun org-freemind-from-org-mode (org-file mm-file)
+ "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
+All the nodes will be opened or closed in Freemind just as you
+have them in `org-mode'.
+
+Note that exporting to Freemind also gives you an alternative way
+to export from `org-mode' to html. You can create a dynamic html
+version of the your org file, by first exporting to Freemind and
+then exporting from Freemind to html. The 'As
+XHTML (JavaScript)' version in Freemind works very well \(and you
+can use a CSS stylesheet to style it)."
+ ;; Fix-me: better doc, include recommendations etc.
+ (interactive
+ (let* ((org-file buffer-file-name)
+ (default-mm-file (concat
+ (if org-file
+ (file-name-nondirectory org-file)
+ "nofile")
+ ".mm"))
+ (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
+ (list org-file mm-file)))
+ (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
+ (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
+ (mm-buffer (find-file-noselect mm-file)))
+ (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
+ (with-current-buffer mm-buffer
+ (basic-save-buffer)
+ (when (org-called-interactively-p 'any)
+ (switch-to-buffer-other-window mm-buffer)
+ (when (y-or-n-p "Show in FreeMind? ")
+ (org-freemind-show buffer-file-name)))))))
+
+;;;###autoload
+(defun org-freemind-from-org-sparse-tree (org-buffer mm-file)
+ "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
+ (interactive
+ (let* ((org-file buffer-file-name)
+ (default-mm-file (concat
+ (if org-file
+ (file-name-nondirectory org-file)
+ "nofile")
+ "-sparse.mm"))
+ (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
+ (list (current-buffer) mm-file)))
+ (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
+ (let (org-buffer
+ (mm-buffer (find-file-noselect mm-file)))
+ (save-window-excursion
+ (org-export-visible ?\ nil)
+ (setq org-buffer (current-buffer)))
+ (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
+ (with-current-buffer mm-buffer
+ (basic-save-buffer)
+ (when (org-called-interactively-p 'any)
+ (switch-to-buffer-other-window mm-buffer)
+ (when (y-or-n-p "Show in FreeMind? ")
+ (org-freemind-show buffer-file-name)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; FreeMind => Org
+
+;; (sort '(b a c) 'org-freemind-lt-symbols)
+(defun org-freemind-lt-symbols (sym-a sym-b)
+ (string< (symbol-name sym-a) (symbol-name sym-b)))
+;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
+(defun org-freemind-lt-xml-attrs (attr-a attr-b)
+ (string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
+
+;; xml-parse-region gives things like
+;; ((p nil "\n"
+;; (a
+;; ((href . "link"))
+;; "text")
+;; "\n"
+;; (b nil "hej")
+;; "\n"))
+
+;; '(a . nil)
+
+;; (org-freemind-symbols= 'a (car '(A B)))
+(defsubst org-freemind-symbols= (sym-a sym-b)
+ "Return t if downcased names of SYM-A and SYM-B are equal.
+SYM-A and SYM-B should be symbols."
+ (or (eq sym-a sym-b)
+ (string= (downcase (symbol-name sym-a))
+ (downcase (symbol-name sym-b)))))
+
+(defun org-freemind-get-children (parent path)
+ "Find children node to PARENT from PATH.
+PATH should be a list of steps, where each step has the form
+
+ '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
+ ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
+ ;; Fix-me: case insensitive version for children?
+ (let* ((children (if (not (listp (car parent)))
+ (cddr parent)
+ (let (cs)
+ (dolist (p parent)
+ (dolist (c (cddr p))
+ (add-to-list 'cs c)))
+ cs)
+ ))
+ (step (car path))
+ (step-node (if (listp step) (car step) step))
+ (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
+ (path-tail (cdr path))
+ path-children)
+ (dolist (child children)
+ ;; skip xml.el formatting nodes
+ (unless (stringp child)
+ ;; compare node name
+ (when (if (not step-node)
+ t ;; any node name
+ (org-freemind-symbols= step-node (car child)))
+ (if (not step-attr-list)
+ ;;(throw 'path-child child) ;; no attr to care about
+ (add-to-list 'path-children child)
+ (let* ((child-attr-list (cadr child))
+ (step-attr-copy (copy-sequence step-attr-list)))
+ (dolist (child-attr child-attr-list)
+ ;; Compare attr names:
+ (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
+ ;; Compare values:
+ (let ((step-val (cdar step-attr-copy))
+ (child-val (cdr child-attr)))
+ (when (if (not step-val)
+ t ;; any value
+ (string= step-val child-val))
+ (setq step-attr-copy (cdr step-attr-copy))))))
+ ;; Did we find all?
+ (unless step-attr-copy
+ ;;(throw 'path-child child)
+ (add-to-list 'path-children child)
+ ))))))
+ (if path-tail
+ (org-freemind-get-children path-children path-tail)
+ path-children)))
+
+(defun org-freemind-get-richcontent-node (node)
+ (let ((rc-nodes
+ (org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
+ (when (> (length rc-nodes) 1)
+ (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>"))
+ (car rc-nodes)))
+
+(defun org-freemind-get-richcontent-note (node)
+ (let ((rc-notes
+ (org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
+ (when (> (length rc-notes) 1)
+ (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
+ (car rc-notes)))
+
+(defun org-freemind-test-get-tree-text ()
+ (let ((node '(p nil "\n"
+ (a
+ ((href . "link"))
+ "text")
+ "\n"
+ (b nil "hej")
+ "\n")))
+ (org-freemind-get-tree-text node)))
+;; (org-freemind-test-get-tree-text)
+
+(defun org-freemind-get-tree-text (node)
+ (when node
+ (let ((ntxt "")
+ (link nil)
+ (lf-after nil))
+ (dolist (n node)
+ (case n
+ ;;(a (setq is-link t) )
+ ((h1 h2 h3 h4 h5 h6 p)
+ ;;(setq ntxt (concat "\n" ntxt))
+ (setq lf-after 2))
+ (br
+ (setq lf-after 1))
+ (t
+ (cond
+ ((stringp n)
+ (when (string= n "\n") (setq n ""))
+ (if link
+ (setq ntxt (concat ntxt
+ "[[" link "][" n "]]"))
+ (setq ntxt (concat ntxt n))))
+ ((and n (listp n))
+ (if (symbolp (car n))
+ (setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
+ ;; This should be the attributes:
+ (dolist (att-val n)
+ (let ((att (car att-val))
+ (val (cdr att-val)))
+ (when (eq att 'href)
+ (setq link val))))))))))
+ (if lf-after
+ (setq ntxt (concat ntxt (make-string lf-after ?\n)))
+ (setq ntxt (concat ntxt " ")))
+ ;;(setq ntxt (concat ntxt (format "{%s}" n)))
+ ntxt)))
+
+(defun org-freemind-get-richcontent-node-text (node)
+ "Get the node text as from the richcontent node NODE."
+ (save-match-data
+ (let* ((rc (org-freemind-get-richcontent-node node))
+ (txt (org-freemind-get-tree-text rc)))
+ ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
+ txt
+ )))
+
+(defun org-freemind-get-richcontent-note-text (node)
+ "Get the node text as from the richcontent note NODE."
+ (save-match-data
+ (let* ((rc (org-freemind-get-richcontent-note node))
+ (txt (when rc (org-freemind-get-tree-text rc))))
+ ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
+ txt
+ )))
+
+(defun org-freemind-get-icon-names (node)
+ (let* ((icon-nodes (org-freemind-get-children node '((icon ))))
+ names)
+ (dolist (icn icon-nodes)
+ (setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
+ ;; (icon (builtin . "full-1"))
+ names))
+
+(defun org-freemind-node-to-org (node level skip-levels)
+ (let ((qname (car node))
+ (attributes (cadr node))
+ text
+ ;; Fix-me: note is never inserted
+ (note (org-freemind-get-richcontent-note-text node))
+ (mark "-- This is more about ")
+ (icons (org-freemind-get-icon-names node))
+ (children (cddr node)))
+ (when (< 0 (- level skip-levels))
+ (dolist (attrib attributes)
+ (case (car attrib)
+ ('TEXT (setq text (cdr attrib)))
+ ('text (setq text (cdr attrib)))))
+ (unless text
+ ;; There should be a richcontent node holding the text:
+ (setq text (org-freemind-get-richcontent-node-text node)))
+ (when icons
+ (when (member "full-1" icons) (setq text (concat "[#A] " text)))
+ (when (member "full-2" icons) (setq text (concat "[#B] " text)))
+ (when (member "full-3" icons) (setq text (concat "[#C] " text)))
+ (when (member "full-4" icons) (setq text (concat "[#D] " text)))
+ (when (member "full-5" icons) (setq text (concat "[#E] " text)))
+ (when (member "full-6" icons) (setq text (concat "[#F] " text)))
+ (when (member "full-7" icons) (setq text (concat "[#G] " text)))
+ (when (member "button_cancel" icons) (setq text (concat "TODO " text)))
+ )
+ (if (and note
+ (string= mark (substring note 0 (length mark))))
+ (progn
+ (setq text (replace-regexp-in-string "\n $" "" text))
+ (insert text))
+ (case qname
+ ('node
+ (insert (make-string (- level skip-levels) ?*) " " text "\n")
+ (when note
+ (insert ":COMMENT:\n" note "\n:END:\n"))
+ ))))
+ (dolist (child children)
+ (unless (or (null child)
+ (stringp child))
+ (org-freemind-node-to-org child (1+ level) skip-levels)))))
+
+;; Fix-me: put back special things, like drawers that are stored in
+;; the notes. Should maybe all notes contents be put in drawers?
+;;;###autoload
+(defun org-freemind-to-org-mode (mm-file org-file)
+ "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
+ (interactive
+ (save-match-data
+ (let* ((mm-file (buffer-file-name))
+ (default-org-file (concat (file-name-nondirectory mm-file) ".org"))
+ (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
+ (list mm-file org-file))))
+ (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
+ (let ((mm-buffer (find-file-noselect mm-file))
+ (org-buffer (find-file-noselect org-file)))
+ (with-current-buffer mm-buffer
+ (let* ((xml-list (xml-parse-file mm-file))
+ (top-node (cadr (cddar xml-list)))
+ (note (org-freemind-get-richcontent-note-text top-node))
+ (skip-levels
+ (if (and note
+ (string-match "^--org-mode: WHOLE FILE$" note))
+ 1
+ 0)))
+ (with-current-buffer org-buffer
+ (erase-buffer)
+ (org-freemind-node-to-org top-node 1 skip-levels)
+ (goto-char (point-min))
+ (org-set-tags t t) ;; Align all tags
+ )
+ (switch-to-buffer-other-window org-buffer)
+ )))))
+
+(provide 'org-freemind)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; org-freemind.el ends here
diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el
new file mode 100644
index 0000000..77f9c0b
--- /dev/null
+++ b/lisp/org-gnus.el
@@ -0,0 +1,295 @@
+;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Tassilo Horn <tassilo at member dot fsf dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to Gnus groups and messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+(require 'gnus-util)
+(eval-when-compile (require 'gnus-sum))
+
+;; Declare external functions and variables
+(declare-function message-fetch-field "message" (header &optional not-all))
+(declare-function message-narrow-to-head-1 "message" nil)
+(declare-function nnimap-group-overview-filename "nnimap" (group server))
+;; The following line suppresses a compiler warning stemming from gnus-sum.el
+(declare-function gnus-summary-last-subject "gnus-sum" nil)
+;; Customization variables
+
+(when (fboundp 'defvaralias)
+ (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links))
+
+(defcustom org-gnus-prefer-web-links nil
+ "If non-nil, `org-store-link' creates web links to Google groups or Gmane.
+When nil, Gnus will be used for such links.
+Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+negates this setting for the duration of the command."
+ :group 'org-link-store
+ :type 'boolean)
+
+(defcustom org-gnus-nnimap-query-article-no-from-file nil
+ "If non-nil, `org-gnus-follow-link' will try to translate
+Message-Ids to article numbers by querying the .overview file.
+Normally, this translation is done by querying the IMAP server,
+which is usually very fast. Unfortunately, some (maybe badly
+configured) IMAP servers don't support this operation quickly.
+So if following a link to a Gnus article takes ages, try setting
+this variable to `t'."
+ :group 'org-link-store
+ :version "24.1"
+ :type 'boolean)
+
+
+;; Install the link type
+(org-add-link-type "gnus" 'org-gnus-open)
+(add-hook 'org-store-link-functions 'org-gnus-store-link)
+
+;; Implementation
+
+(defun org-gnus-nnimap-cached-article-number (group server message-id)
+ "Return cached article number (uid) of message in GROUP on SERVER.
+MESSAGE-ID is the message-id header field that identifies the
+message. If the uid is not cached, return nil."
+ (with-temp-buffer
+ (let ((nov (nnimap-group-overview-filename group server)))
+ (when (file-exists-p nov)
+ (mm-insert-file-contents nov)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min))
+ (catch 'found
+ (while (search-forward message-id nil t)
+ (let ((hdr (split-string (thing-at-point 'line) "\t")))
+ (if (string= (nth 4 hdr) message-id)
+ (throw 'found (nth 0 hdr))))))))))
+
+(defun org-gnus-group-link (group)
+ "Create a link to the Gnus group GROUP.
+If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
+non-nil, create a link to groups.google.com or gmane.org.
+Otherwise create a link to the group inside Gnus.
+
+If `org-store-link' was called with a prefix arg the meaning of
+`org-gnus-prefer-web-links' is reversed."
+ (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group)))
+ (if (and (string-match "^nntp" group) ;; Only for nntp groups
+ (org-xor current-prefix-arg
+ org-gnus-prefer-web-links))
+ (concat (if (string-match "gmane" unprefixed-group)
+ "http://news.gmane.org/"
+ "http://groups.google.com/group/")
+ unprefixed-group)
+ (concat "gnus:" group))))
+
+(defun org-gnus-article-link (group newsgroups message-id x-no-archive)
+ "Create a link to a Gnus article.
+The article is specified by its MESSAGE-ID. Additional
+parameters are the Gnus GROUP, the NEWSGROUPS the article was
+posted to and the X-NO-ARCHIVE header value of that article.
+
+If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
+non-nil, create a link to groups.google.com or gmane.org.
+Otherwise create a link to the article inside Gnus.
+
+If `org-store-link' was called with a prefix arg the meaning of
+`org-gnus-prefer-web-links' is reversed."
+ (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links)
+ newsgroups ;; Make web links only for nntp groups
+ (not x-no-archive)) ;; and if X-No-Archive isn't set.
+ (format (if (string-match "gmane\\." newsgroups)
+ "http://mid.gmane.org/%s"
+ "http://groups.google.com/groups/search?as_umsgid=%s")
+ (org-fixup-message-id-for-http message-id))
+ (concat "gnus:" group "#" message-id)))
+
+(defun org-gnus-store-link ()
+ "Store a link to a Gnus folder or message."
+ (cond
+ ((eq major-mode 'gnus-group-mode)
+ (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
+ (gnus-group-group-name)) ; version
+ ((fboundp 'gnus-group-name)
+ (gnus-group-name))
+ (t "???")))
+ desc link)
+ (when group
+ (org-store-link-props :type "gnus" :group group)
+ (setq desc (org-gnus-group-link group)
+ link desc)
+ (org-add-link-props :link link :description desc)
+ link)))
+
+ ((memq major-mode '(gnus-summary-mode gnus-article-mode))
+ (let* ((group gnus-newsgroup-name)
+ (header (with-current-buffer gnus-summary-buffer
+ (gnus-summary-article-header)))
+ (from (mail-header-from header))
+ (message-id (org-remove-angle-brackets (mail-header-id header)))
+ (date (org-trim (mail-header-date header)))
+ (date-ts (and date
+ (ignore-errors
+ (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time date)))))
+ (date-ts-ia (and date
+ (ignore-errors
+ (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date)))))
+ (subject (copy-sequence (mail-header-subject header)))
+ (to (cdr (assq 'To (mail-header-extra header))))
+ newsgroups x-no-archive desc link)
+ ;; Remove text properties of subject string to avoid Emacs bug
+ ;; #3506
+ (set-text-properties 0 (length subject) nil subject)
+
+ ;; Fetching an article is an expensive operation; newsgroup and
+ ;; x-no-archive are only needed for web links.
+ (when (org-xor current-prefix-arg org-gnus-prefer-web-links)
+ ;; Make sure the original article buffer is up-to-date
+ (save-window-excursion (gnus-summary-select-article))
+ (setq to (or to (gnus-fetch-original-field "To"))
+ newsgroups (gnus-fetch-original-field "Newsgroups")
+ x-no-archive (gnus-fetch-original-field "x-no-archive")))
+ (org-store-link-props :type "gnus" :from from :subject subject
+ :message-id message-id :group group :to to)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq desc (org-email-link-description)
+ link (org-gnus-article-link
+ group newsgroups message-id x-no-archive))
+ (org-add-link-props :link link :description desc)
+ link))
+ ((eq major-mode 'message-mode)
+ (setq org-store-link-plist nil) ; reset
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (and (not (message-fetch-field "Message-ID"))
+ (message-generate-headers '(Message-ID)))
+ (goto-char (point-min))
+ (re-search-forward "^Message-ID: *.*$" nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
+ (let ((gcc (car (last
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
+ (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
+ (to (mail-fetch-field "To"))
+ (from (mail-fetch-field "From"))
+ (subject (mail-fetch-field "Subject"))
+ desc link
+ newsgroup xarchive) ; those are always nil for gcc
+ (and (not gcc)
+ (error "Can not create link: No Gcc header found"))
+ (org-store-link-props :type "gnus" :from from :subject subject
+ :message-id id :group gcc :to to)
+ (setq desc (org-email-link-description)
+ link (org-gnus-article-link
+ gcc newsgroup id xarchive))
+ (org-add-link-props :link link :description desc)
+ link))))))
+
+(defun org-gnus-open-nntp (path)
+ "Follow the nntp: link specified by PATH."
+ (let* ((spec (split-string path "/"))
+ (server (split-string (nth 2 spec) "@"))
+ (group (nth 3 spec))
+ (article (nth 4 spec)))
+ (org-gnus-follow-link
+ (format "nntp+%s:%s" (or (cdr server) (car server)) group)
+ article)))
+
+(defun org-gnus-open (path)
+ "Follow the Gnus message or folder link specified by PATH."
+ (let (group article)
+ (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in Gnus link"))
+ (setq group (match-string 1 path)
+ article (match-string 3 path))
+ (when group
+ (setq group (org-no-properties group)))
+ (when article
+ (setq article (org-no-properties article)))
+ (org-gnus-follow-link group article)))
+
+(defun org-gnus-follow-link (&optional group article)
+ "Follow a Gnus link to GROUP and ARTICLE."
+ (require 'gnus)
+ (funcall (cdr (assq 'gnus org-link-frame-setup)))
+ (if gnus-other-frame-object (select-frame gnus-other-frame-object))
+ (when group
+ (setq group (org-no-properties group)))
+ (when article
+ (setq article (org-no-properties article)))
+ (cond ((and group article)
+ (gnus-activate-group group)
+ (condition-case nil
+ (let* ((method (gnus-find-method-for-group group))
+ (backend (car method))
+ (server (cadr method)))
+ (cond
+ ((eq backend 'nndoc)
+ (if (gnus-group-read-group t nil group)
+ (gnus-summary-goto-article article nil t)
+ (message "Couldn't follow gnus link. %s"
+ "The summary couldn't be opened.")))
+ (t
+ (let ((articles 1)
+ group-opened)
+ (when (and (eq backend 'nnimap)
+ org-gnus-nnimap-query-article-no-from-file)
+ (setq article
+ (or (org-gnus-nnimap-cached-article-number
+ (nth 1 (split-string group ":"))
+ server (concat "<" article ">")) article)))
+ (while (and (not group-opened)
+ ;; stop on integer overflows
+ (> articles 0))
+ (setq group-opened (gnus-group-read-group
+ articles t group)
+ articles (if (< articles 16)
+ (1+ articles)
+ (* articles 2))))
+ (if group-opened
+ (gnus-summary-goto-article article nil t)
+ (message "Couldn't follow gnus link. %s"
+ "The summary couldn't be opened."))))))
+ (quit (message "Couldn't follow gnus link. %s"
+ "The linked group is empty."))))
+ (group (gnus-group-jump-to-group group))))
+
+(defun org-gnus-no-new-news ()
+ "Like `M-x gnus' but doesn't check for new news."
+ (if (not (gnus-alive-p)) (gnus)))
+
+(provide 'org-gnus)
+
+
+;;; org-gnus.el ends here
diff --git a/lisp/org-habit.el b/lisp/org-habit.el
new file mode 100644
index 0000000..5b68ac3
--- /dev/null
+++ b/lisp/org-habit.el
@@ -0,0 +1,386 @@
+;;; org-habit.el --- The habit tracking code for Org-mode
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw at gnu dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the habit tracking code for Org-mode
+
+;;; Code:
+
+(require 'org)
+(require 'org-agenda)
+
+(eval-when-compile
+ (require 'cl))
+
+(defgroup org-habit nil
+ "Options concerning habit tracking in Org-mode."
+ :tag "Org Habit"
+ :group 'org-progress)
+
+(defcustom org-habit-graph-column 40
+ "The absolute column at which to insert habit consistency graphs.
+Note that consistency graphs will overwrite anything else in the buffer."
+ :group 'org-habit
+ :type 'integer)
+
+(defcustom org-habit-preceding-days 21
+ "Number of days before today to appear in consistency graphs."
+ :group 'org-habit
+ :type 'integer)
+
+(defcustom org-habit-following-days 7
+ "Number of days after today to appear in consistency graphs."
+ :group 'org-habit
+ :type 'integer)
+
+(defcustom org-habit-show-habits t
+ "If non-nil, show habits in agenda buffers."
+ :group 'org-habit
+ :type 'boolean)
+
+(defcustom org-habit-show-habits-only-for-today t
+ "If non-nil, only show habits on today's agenda, and not for future days.
+Note that even when shown for future days, the graph is always
+relative to the current effective date."
+ :group 'org-habit
+ :type 'boolean)
+
+(defcustom org-habit-show-all-today nil
+ "If non-nil, will show the consistency graph of all habits on
+today's agenda, even if they are not scheduled."
+ :group 'org-habit
+ :type 'boolean)
+
+(defcustom org-habit-today-glyph ?!
+ "Glyph character used to identify today."
+ :group 'org-habit
+ :version "24.1"
+ :type 'character)
+
+(defcustom org-habit-completed-glyph ?*
+ "Glyph character used to show completed days on which a task was done."
+ :group 'org-habit
+ :version "24.1"
+ :type 'character)
+
+(defface org-habit-clear-face
+ '((((background light)) (:background "#8270f9"))
+ (((background dark)) (:background "blue")))
+ "Face for days on which a task shouldn't be done yet."
+ :group 'org-habit
+ :group 'org-faces)
+(defface org-habit-clear-future-face
+ '((((background light)) (:background "#d6e4fc"))
+ (((background dark)) (:background "midnightblue")))
+ "Face for future days on which a task shouldn't be done yet."
+ :group 'org-habit
+ :group 'org-faces)
+
+(defface org-habit-ready-face
+ '((((background light)) (:background "#4df946"))
+ (((background dark)) (:background "forestgreen")))
+ "Face for days on which a task should start to be done."
+ :group 'org-habit
+ :group 'org-faces)
+(defface org-habit-ready-future-face
+ '((((background light)) (:background "#acfca9"))
+ (((background dark)) (:background "darkgreen")))
+ "Face for days on which a task should start to be done."
+ :group 'org-habit
+ :group 'org-faces)
+
+(defface org-habit-alert-face
+ '((((background light)) (:background "#f5f946"))
+ (((background dark)) (:background "gold")))
+ "Face for days on which a task is due."
+ :group 'org-habit
+ :group 'org-faces)
+(defface org-habit-alert-future-face
+ '((((background light)) (:background "#fafca9"))
+ (((background dark)) (:background "darkgoldenrod")))
+ "Face for days on which a task is due."
+ :group 'org-habit
+ :group 'org-faces)
+
+(defface org-habit-overdue-face
+ '((((background light)) (:background "#f9372d"))
+ (((background dark)) (:background "firebrick")))
+ "Face for days on which a task is overdue."
+ :group 'org-habit
+ :group 'org-faces)
+(defface org-habit-overdue-future-face
+ '((((background light)) (:background "#fc9590"))
+ (((background dark)) (:background "darkred")))
+ "Face for days on which a task is overdue."
+ :group 'org-habit
+ :group 'org-faces)
+
+(defun org-habit-duration-to-days (ts)
+ (if (string-match "\\([0-9]+\\)\\([dwmy]\\)" ts)
+ ;; lead time is specified.
+ (floor (* (string-to-number (match-string 1 ts))
+ (cdr (assoc (match-string 2 ts)
+ '(("d" . 1) ("w" . 7)
+ ("m" . 30.4) ("y" . 365.25))))))
+ (error "Invalid duration string: %s" ts)))
+
+(defun org-is-habit-p (&optional pom)
+ "Is the task at POM or point a habit?"
+ (string= "habit" (org-entry-get (or pom (point)) "STYLE")))
+
+(defun org-habit-parse-todo (&optional pom)
+ "Parse the TODO surrounding point for its habit-related data.
+Returns a list with the following elements:
+
+ 0: Scheduled date for the habit (may be in the past)
+ 1: \".+\"-style repeater for the schedule, in days
+ 2: Optional deadline (nil if not present)
+ 3: If deadline, the repeater for the deadline, otherwise nil
+ 4: A list of all the past dates this todo was mark closed
+
+This list represents a \"habit\" for the rest of this module."
+ (save-excursion
+ (if pom (goto-char pom))
+ (assert (org-is-habit-p (point)))
+ (let* ((scheduled (org-get-scheduled-time (point)))
+ (scheduled-repeat (org-get-repeat org-scheduled-string))
+ (end (org-entry-end-position))
+ (habit-entry (org-no-properties (nth 4 (org-heading-components))))
+ closed-dates deadline dr-days sr-days)
+ (if scheduled
+ (setq scheduled (time-to-days scheduled))
+ (error "Habit %s has no scheduled date" habit-entry))
+ (unless scheduled-repeat
+ (error
+ "Habit '%s' has no scheduled repeat period or has an incorrect one"
+ habit-entry))
+ (setq sr-days (org-habit-duration-to-days scheduled-repeat))
+ (unless (> sr-days 0)
+ (error "Habit %s scheduled repeat period is less than 1d" habit-entry))
+ (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
+ (setq dr-days (org-habit-duration-to-days
+ (match-string-no-properties 1 scheduled-repeat)))
+ (if (<= dr-days sr-days)
+ (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)"
+ habit-entry scheduled-repeat))
+ (setq deadline (+ scheduled (- dr-days sr-days))))
+ (org-back-to-heading t)
+ (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days))
+ (reversed org-log-states-order-reversed)
+ (search (if reversed 're-search-forward 're-search-backward))
+ (limit (if reversed end (point)))
+ (count 0))
+ (unless reversed (goto-char end))
+ (while (and (< count maxdays)
+ (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t))
+ (push (time-to-days
+ (org-time-string-to-time (match-string-no-properties 1)))
+ closed-dates)
+ (setq count (1+ count))))
+ (list scheduled sr-days deadline dr-days closed-dates))))
+
+(defsubst org-habit-scheduled (habit)
+ (nth 0 habit))
+(defsubst org-habit-scheduled-repeat (habit)
+ (nth 1 habit))
+(defsubst org-habit-deadline (habit)
+ (let ((deadline (nth 2 habit)))
+ (or deadline
+ (if (nth 3 habit)
+ (+ (org-habit-scheduled habit)
+ (1- (org-habit-scheduled-repeat habit)))
+ (org-habit-scheduled habit)))))
+(defsubst org-habit-deadline-repeat (habit)
+ (or (nth 3 habit)
+ (org-habit-scheduled-repeat habit)))
+(defsubst org-habit-done-dates (habit)
+ (nth 4 habit))
+
+(defsubst org-habit-get-priority (habit &optional moment)
+ "Determine the relative priority of a habit.
+This must take into account not just urgency, but consistency as well."
+ (let ((pri 1000)
+ (now (if moment (time-to-days moment) (org-today)))
+ (scheduled (org-habit-scheduled habit))
+ (deadline (org-habit-deadline habit)))
+ ;; add 10 for every day past the scheduled date, and subtract for every
+ ;; day before it
+ (setq pri (+ pri (* (- now scheduled) 10)))
+ ;; add 50 if the deadline is today
+ (if (and (/= scheduled deadline)
+ (= now deadline))
+ (setq pri (+ pri 50)))
+ ;; add 100 for every day beyond the deadline date, and subtract 10 for
+ ;; every day before it
+ (let ((slip (- now (1- deadline))))
+ (if (> slip 0)
+ (setq pri (+ pri (* slip 100)))
+ (setq pri (+ pri (* slip 10)))))
+ pri))
+
+(defun org-habit-get-faces (habit &optional now-days scheduled-days donep)
+ "Return faces for HABIT relative to NOW-DAYS and SCHEDULED-DAYS.
+NOW-DAYS defaults to the current time's days-past-the-epoch if nil.
+SCHEDULED-DAYS defaults to the habit's actual scheduled days if nil.
+
+Habits are assigned colors on the following basis:
+ Blue Task is before the scheduled date.
+ Green Task is on or after scheduled date, but before the
+ end of the schedule's repeat period.
+ Yellow If the task has a deadline, then it is after schedule's
+ repeat period, but before the deadline.
+ Orange The task has reached the deadline day, or if there is
+ no deadline, the end of the schedule's repeat period.
+ Red The task has gone beyond the deadline day or the
+ schedule's repeat period."
+ (let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
+ (s-repeat (org-habit-scheduled-repeat habit))
+ (scheduled-end (+ scheduled (1- s-repeat)))
+ (d-repeat (org-habit-deadline-repeat habit))
+ (deadline (if scheduled-days
+ (+ scheduled-days (- d-repeat s-repeat))
+ (org-habit-deadline habit)))
+ (m-days (or now-days (time-to-days (current-time)))))
+ (cond
+ ((< m-days scheduled)
+ '(org-habit-clear-face . org-habit-clear-future-face))
+ ((< m-days deadline)
+ '(org-habit-ready-face . org-habit-ready-future-face))
+ ((= m-days deadline)
+ (if donep
+ '(org-habit-ready-face . org-habit-ready-future-face)
+ '(org-habit-alert-face . org-habit-alert-future-face)))
+ (t
+ '(org-habit-overdue-face . org-habit-overdue-future-face)))))
+
+(defun org-habit-build-graph (habit starting current ending)
+ "Build a graph for the given HABIT, from STARTING to ENDING.
+CURRENT gives the current time between STARTING and ENDING, for
+the purpose of drawing the graph. It need not be the actual
+current time."
+ (let* ((done-dates (sort (org-habit-done-dates habit) '<))
+ (scheduled (org-habit-scheduled habit))
+ (s-repeat (org-habit-scheduled-repeat habit))
+ (start (time-to-days starting))
+ (now (time-to-days current))
+ (end (time-to-days ending))
+ (graph (make-string (1+ (- end start)) ?\ ))
+ (index 0)
+ last-done-date)
+ (while (and done-dates (< (car done-dates) start))
+ (setq last-done-date (car done-dates)
+ done-dates (cdr done-dates)))
+ (while (< start end)
+ (let* ((in-the-past-p (< start now))
+ (todayp (= start now))
+ (donep (and done-dates
+ (= start (car done-dates))))
+ (faces (if (and in-the-past-p
+ (not last-done-date)
+ (not (< scheduled now)))
+ '(org-habit-clear-face . org-habit-clear-future-face)
+ (org-habit-get-faces
+ habit start (and in-the-past-p
+ (if last-done-date
+ (+ last-done-date s-repeat)
+ scheduled))
+ donep)))
+ markedp face)
+ (if donep
+ (let ((done-time (time-add
+ starting
+ (days-to-time
+ (- start (time-to-days starting))))))
+
+ (aset graph index org-habit-completed-glyph)
+ (setq markedp t)
+ (put-text-property
+ index (1+ index) 'help-echo
+ (format-time-string (org-time-stamp-format) done-time) graph)
+ (while (and done-dates
+ (= start (car done-dates)))
+ (setq last-done-date (car done-dates)
+ done-dates (cdr done-dates))))
+ (if todayp
+ (aset graph index org-habit-today-glyph)))
+ (setq face (if (or in-the-past-p todayp)
+ (car faces)
+ (cdr faces)))
+ (if (and in-the-past-p
+ (not (eq face 'org-habit-overdue-face))
+ (not markedp))
+ (setq face (cdr faces)))
+ (put-text-property index (1+ index) 'face face graph))
+ (setq start (1+ start)
+ index (1+ index)))
+ graph))
+
+(defun org-habit-insert-consistency-graphs (&optional line)
+ "Insert consistency graph for any habitual tasks."
+ (let ((inhibit-read-only t) l c
+ (buffer-invisibility-spec '(org-link))
+ (moment (time-subtract (current-time)
+ (list 0 (* 3600 org-extend-today-until) 0)))
+ disabled-overlays)
+ ;; Disable filters; this helps with alignment if there are links.
+ (mapc (lambda (ol)
+ (when (overlay-get ol 'invisible)
+ (overlay-put ol 'invisible nil)
+ (setq disabled-overlays (cons ol disabled-overlays))))
+ (overlays-in (point-min) (point-max)))
+ (save-excursion
+ (goto-char (if line (point-at-bol) (point-min)))
+ (while (not (eobp))
+ (let ((habit (get-text-property (point) 'org-habit-p)))
+ (when habit
+ (move-to-column org-habit-graph-column t)
+ (delete-char (min (+ 1 org-habit-preceding-days
+ org-habit-following-days)
+ (- (line-end-position) (point))))
+ (insert-before-markers
+ (org-habit-build-graph
+ habit
+ (time-subtract moment (days-to-time org-habit-preceding-days))
+ moment
+ (time-add moment (days-to-time org-habit-following-days))))))
+ (forward-line)))
+ (mapc (lambda (ol) (overlay-put ol 'invisible t))
+ disabled-overlays)))
+
+(defun org-habit-toggle-habits ()
+ "Toggle display of habits in an agenda buffer."
+ (interactive)
+ (org-agenda-check-type t 'agenda)
+ (setq org-habit-show-habits (not org-habit-show-habits))
+ (org-agenda-redo)
+ (org-agenda-set-mode-name)
+ (message "Habits turned %s"
+ (if org-habit-show-habits "on" "off")))
+
+(org-defkey org-agenda-mode-map "K" 'org-habit-toggle-habits)
+
+(provide 'org-habit)
+
+;;; org-habit.el ends here
diff --git a/lisp/org-html.el b/lisp/org-html.el
new file mode 100644
index 0000000..79b0286
--- /dev/null
+++ b/lisp/org-html.el
@@ -0,0 +1,2752 @@
+;;; org-html.el --- HTML export for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-exp)
+(require 'format-spec)
+
+(eval-when-compile (require 'cl))
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function htmlize-region "ext:htmlize" (beg end))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+(defgroup org-export-html nil
+ "Options specific for HTML export of Org-mode files."
+ :tag "Org Export HTML"
+ :group 'org-export)
+
+(defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
+<h2 class=\"footnotes\">%s: </h2>
+<div id=\"text-footnotes\">
+%s
+</div>
+</div>"
+ "Format for the footnotes section.
+Should contain a two instances of %s. The first will be replaced with the
+language-specific word for \"Footnotes\", the second one will be replaced
+by the footnotes themselves."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-footnote-format "<sup>%s</sup>"
+ "The format for the footnote reference.
+%s will be replaced by the footnote reference itself."
+ :group 'org-export-html
+ :type 'string)
+
+
+(defcustom org-export-html-footnote-separator "<sup>, </sup>"
+ "Text used to separate footnotes."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-html-coding-system nil
+ "Coding system for HTML export, defaults to `buffer-file-coding-system'."
+ :group 'org-export-html
+ :type 'coding-system)
+
+(defcustom org-export-html-extension "html"
+ "The extension for exported HTML files."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-xml-declaration
+ '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
+ ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
+ "The extension for exported HTML files.
+%s will be replaced with the charset of the exported file.
+This may be a string, or an alist with export extensions
+and corresponding declarations."
+ :group 'org-export-html
+ :type '(choice
+ (string :tag "Single declaration")
+ (repeat :tag "Dependent on extension"
+ (cons (string :tag "Extension")
+ (string :tag "Declaration")))))
+
+(defcustom org-export-html-style-include-scripts t
+ "Non-nil means include the JavaScript snippets in exported HTML files.
+The actual script is defined in `org-export-html-scripts' and should
+not be modified."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defvar org-export-html-scripts
+ "<script type=\"text/javascript\">
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+<!--/*--><![CDATA[/*><!--*/
+ function CodeHighlightOn(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.cacheClassElem = elem.className;
+ elem.cacheClassTarget = target.className;
+ target.className = \"code-highlighted\";
+ elem.className = \"code-highlighted\";
+ }
+ }
+ function CodeHighlightOff(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(elem.cacheClassElem)
+ elem.className = elem.cacheClassElem;
+ if(elem.cacheClassTarget)
+ target.className = elem.cacheClassTarget;
+ }
+/*]]>*///-->
+</script>"
+ "Basic JavaScript that is needed by HTML files produced by Org-mode.")
+
+(defconst org-export-html-style-default
+ "<style type=\"text/css\">
+ <!--/*--><![CDATA[/*><!--*/
+ html { font-family: Times, serif; font-size: 12pt; }
+ .title { text-align: center; }
+ .todo { color: red; }
+ .done { color: green; }
+ .tag { background-color: #add8e6; font-weight:normal }
+ .target { }
+ .timestamp { color: #bebebe; }
+ .timestamp-kwd { color: #5f9ea0; }
+ .right {margin-left:auto; margin-right:0px; text-align:right;}
+ .left {margin-left:0px; margin-right:auto; text-align:left;}
+ .center {margin-left:auto; margin-right:auto; text-align:center;}
+ p.verse { margin-left: 3% }
+ pre {
+ border: 1pt solid #AEBDCC;
+ background-color: #F3F5F7;
+ padding: 5pt;
+ font-family: courier, monospace;
+ font-size: 90%;
+ overflow:auto;
+ }
+ table { border-collapse: collapse; }
+ td, th { vertical-align: top; }
+ th.right { text-align:center; }
+ th.left { text-align:center; }
+ th.center { text-align:center; }
+ td.right { text-align:right; }
+ td.left { text-align:left; }
+ td.center { text-align:center; }
+ dt { font-weight: bold; }
+ div.figure { padding: 0.5em; }
+ div.figure p { text-align: center; }
+ div.inlinetask {
+ padding:10px;
+ border:2px solid gray;
+ margin:10px;
+ background: #ffffcc;
+ }
+ textarea { overflow-x: auto; }
+ .linenr { font-size:smaller }
+ .code-highlighted {background-color:#ffff00;}
+ .org-info-js_info-navigation { border-style:none; }
+ #org-info-js_console-label { font-size:10px; font-weight:bold;
+ white-space:nowrap; }
+ .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
+ font-weight:bold; }
+ /*]]>*/-->
+</style>"
+ "The default style specification for exported HTML files.
+Please use the variables `org-export-html-style' and
+`org-export-html-style-extra' to add to this style. If you wish to not
+have the default style included, customize the variable
+`org-export-html-style-include-default'.")
+
+(defcustom org-export-html-style-include-default t
+ "Non-nil means include the default style in exported HTML files.
+The actual style is defined in `org-export-html-style-default' and should
+not be modified. Use the variables `org-export-html-style' to add
+your own style information."
+ :group 'org-export-html
+ :type 'boolean)
+;;;###autoload
+(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
+
+(defcustom org-export-html-style ""
+ "Org-wide style definitions for exported HTML files.
+
+This variable needs to contain the full HTML structure to provide a style,
+including the surrounding HTML tags. If you set the value of this variable,
+you should consider to include definitions for the following classes:
+ title, todo, done, timestamp, timestamp-kwd, tag, target.
+
+For example, a valid value would be:
+
+ <style type=\"text/css\">
+ <![CDATA[
+ p { font-weight: normal; color: gray; }
+ h1 { color: black; }
+ .title { text-align: center; }
+ .todo, .timestamp-kwd { color: red; }
+ .done { color: green; }
+ ]]>
+ </style>
+
+If you'd like to refer to an external style file, use something like
+
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
+
+As the value of this option simply gets inserted into the HTML <head> header,
+you can \"misuse\" it to add arbitrary text to the header.
+See also the variable `org-export-html-style-extra'."
+ :group 'org-export-html
+ :type 'string)
+;;;###autoload
+(put 'org-export-html-style 'safe-local-variable 'stringp)
+
+(defcustom org-export-html-style-extra ""
+ "Additional style information for HTML export.
+The value of this variable is inserted into the HTML buffer right after
+the value of `org-export-html-style'. Use this variable for per-file
+settings of style information, and do not forget to surround the style
+settings with <style>...</style> tags."
+ :group 'org-export-html
+ :type 'string)
+;;;###autoload
+(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
+
+(defcustom org-export-html-mathjax-options
+ '((path "http://orgmode.org/mathjax/MathJax.js")
+ (scale "100")
+ (align "center")
+ (indent "2em")
+ (mathml nil))
+ "Options for MathJax setup.
+
+path The path where to find MathJax
+scale Scaling for the HTML-CSS backend, usually between 100 and 133
+align How to align display math: left, center, or right
+indent If align is not center, how far from the left/right side?
+mathml Should a MathML player be used if available?
+ This is faster and reduces bandwidth use, but currently
+ sometimes has lower spacing quality. Therefore, the default is
+ nil. When browsers get better, this switch can be flipped.
+
+You can also customize this for each buffer, using something like
+
+#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+ :group 'org-export-html
+ :version "24.1"
+ :type '(list :greedy t
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "mathml (should MathML display be used is possible)"
+ (const :format " " mathml) (boolean))))
+
+(defun org-export-html-mathjax-config (template options in-buffer)
+ "Insert the user setup into the matchjax template."
+ (let (name val (yes " ") (no "// ") x)
+ (mapc
+ (lambda (e)
+ (setq name (car e) val (nth 1 e))
+ (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ (if (not (stringp val)) (setq val (format "%s" val)))
+ (setq template
+ (replace-regexp-in-string
+ (concat "%" (upcase (symbol-name name))) val template t t)))
+ options)
+ (setq val (nth 1 (assq 'mathml options)))
+ (if (string-match (concat "\\<mathml:") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ ;; Exchange prefixes depending on mathml setting
+ (if (not val) (setq x yes yes no no x))
+ ;; Replace cookies to turn on or off the config/jax lines
+ (if (string-match ":MMLYES:" template)
+ (setq template (replace-match yes t t template)))
+ (if (string-match ":MMLNO:" template)
+ (setq template (replace-match no t t template)))
+ ;; Return the modified template
+ template))
+
+(defcustom org-export-html-mathjax-template
+ "<script type=\"text/javascript\" src=\"%PATH\">
+/**
+ *
+ * @source: %PATH
+ *
+ * @licstart The following is the entire license notice for the
+ * JavaScript code in %PATH.
+ *
+ * Copyright (C) 2012 MathJax
+ *
+ * Licensed under the Apache License, Version 2.0 (the \"License\");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an \"AS IS\" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * @licend The above is the entire license notice
+ * for the JavaScript code in %PATH.
+ *
+ */
+
+/*
+@licstart The following is the entire license notice for the
+JavaScript code below.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code below is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code below.
+*/
+<!--/*--><![CDATA[/*><!--*/
+ MathJax.Hub.Config({
+ // Only one of the two following lines, depending on user settings
+ // First allows browser-native MathML display, second forces HTML/CSS
+ :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
+ :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
+ extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
+ \"TeX/noUndefined.js\"],
+ tex2jax: {
+ inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
+ displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
+ skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
+ ignoreClass: \"tex2jax_ignore\",
+ processEscapes: false,
+ processEnvironments: true,
+ preview: \"TeX\"
+ },
+ showProcessingMessages: true,
+ displayAlign: \"%ALIGN\",
+ displayIndent: \"%INDENT\",
+
+ \"HTML-CSS\": {
+ scale: %SCALE,
+ availableFonts: [\"STIX\",\"TeX\"],
+ preferredFont: \"TeX\",
+ webFont: \"TeX\",
+ imageFont: \"TeX\",
+ showMathMenu: true,
+ },
+ MMLorHTML: {
+ prefer: {
+ MSIE: \"MML\",
+ Firefox: \"MML\",
+ Opera: \"HTML\",
+ other: \"HTML\"
+ }
+ }
+ });
+/*]]>*///-->
+</script>"
+ "The MathJax setup for XHTML files."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-html-tag-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each tag gets a class given by the tag itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-todo-kwd-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each TODO keyword gets a class given by the keyword itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>"
+ "Format for anchors in HTML headlines.
+It requires to %s: both will be replaced by the anchor referring
+to the headline (e.g. \"sec-2\"). When set to `nil', don't insert
+HTML anchors in headlines."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-html-preamble t
+ "Non-nil means insert a preamble in HTML export.
+
+When `t', insert a string as defined by one of the formatting
+strings in `org-export-html-preamble-format'. When set to a
+string, this string overrides `org-export-html-preamble-format'.
+When set to a function, apply this function and insert the
+returned string. The function takes no argument, but you can
+use `opt-plist' to access the current export options.
+
+Setting :html-preamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No preamble" nil)
+ (const :tag "Default preamble" t)
+ (string :tag "Custom format string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-export-html-preamble-format '(("en" ""))
+ "Alist of languages and format strings for the HTML preamble.
+
+The first element of each list is the language code, as used for
+the #+LANGUAGE keyword.
+
+The second element of each list is a format string to format the
+preamble itself. This format string can contain these elements:
+
+%t stands for the title.
+%a stands for the author's name.
+%e stands for the author's email.
+%d stands for the date.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-html-postamble 'auto
+ "Non-nil means insert a postamble in HTML export.
+
+When `t', insert a string as defined by the format string in
+`org-export-html-postamble-format'. When set to a string, this
+string overrides `org-export-html-postamble-format'. When set to
+'auto, discard `org-export-html-postamble-format' and honor
+`org-export-author/email/creator-info' variables. When set to a
+function, apply this function and insert the returned string.
+The function takes no argument, but you can use `opt-plist' to
+access the current export options.
+
+Setting :html-postamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No postamble" nil)
+ (const :tag "Auto preamble" 'auto)
+ (const :tag "Default format string" t)
+ (string :tag "Custom format string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-export-html-postamble-format
+ '(("en" "<p class=\"author\">Author: %a (%e)</p>
+<p class=\"date\">Date: %d</p>
+<p class=\"creator\">Generated by %c</p>
+<p class=\"xhtml-validation\">%v</p>
+"))
+ "Alist of languages and format strings for the HTML postamble.
+
+The first element of each list is the language code, as used for
+the #+LANGUAGE keyword.
+
+The second element of each list is a format string to format the
+postamble itself. This format string can contain these elements:
+
+%a stands for the author's name.
+%e stands for the author's email.
+%d stands for the date.
+%c will be replaced by information about Org/Emacs versions.
+%v will be replaced by `org-export-html-validation-link'.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-html-home/up-format
+ "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
+ <a accesskey=\"h\" href=\"%s\"> UP </a>
+ |
+ <a accesskey=\"H\" href=\"%s\"> HOME </a>
+</div>"
+ "Snippet used to insert the HOME and UP links.
+This is a format string, the first %s will receive the UP link,
+the second the HOME link. If both `org-export-html-link-up' and
+`org-export-html-link-home' are empty, the entire snippet will be
+ignored."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-toplevel-hlevel 2
+ "The <H> level for level 1 headings in HTML export.
+This is also important for the classes that will be wrapped around headlines
+and outline structure. If this variable is 1, the top-level headlines will
+be <h1>, and the corresponding classes will be outline-1, section-number-1,
+and outline-text-1. If this is 2, all of these will get a 2 instead.
+The default for this variable is 2, because we use <h1> for formatting the
+document title."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-html-link-org-files-as-html t
+ "Non-nil means make file links to `file.org' point to `file.html'.
+When org-mode is exporting an org-mode file to HTML, links to
+non-html files are directly put into a href tag in HTML.
+However, links to other Org-mode files (recognized by the
+extension `.org.) should become links to the corresponding html
+file, assuming that the linked org-mode file will also be
+converted to HTML.
+When nil, the links still point to the plain `.org' file."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defcustom org-export-html-inline-images 'maybe
+ "Non-nil means inline images into exported HTML pages.
+This is done using an <img> tag. When nil, an anchor with href is used to
+link to the image. If this option is `maybe', then images in links with
+an empty description will be inlined, while images with a description will
+be linked only."
+ :group 'org-export-html
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "When there is no description" maybe)))
+
+(defcustom org-export-html-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif" "svg")
+ "Extensions of image files that can be inlined into HTML."
+ :group 'org-export-html
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-html-table-tag
+ "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
+ "The HTML tag that is used to start a table.
+This must be a <table> tag, but you may change the options like
+borders and spacing."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
+ "The opening tag for table header fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-export-html-table-use-header-tags-for-first-column'.
+See also the variable `org-export-html-table-align-individual-fields'."
+ :group 'org-export-tables
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-export-table-data-tags '("<td%s>" . "</td>")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-export-html-table-align-individual-fields'."
+ :group 'org-export-tables
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-export-table-row-tags '("<tr>" . "</tr>")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+Instead of strings, these can be Lisp forms that will be evaluated
+for each row in order to construct the table row tags. During evaluation,
+the variable `head' will be true when this is a header line, nil when this
+is a body line. And the variable `nline' will contain the line number,
+starting from 1 in the first header line. For example
+
+ (setq org-export-table-row-tags
+ (cons '(if head
+ \"<tr>\"
+ (if (= (mod nline 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\"))
+ \"</tr>\"))
+
+will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
+ :group 'org-export-tables
+ :type '(cons
+ (choice :tag "Opening tag"
+ (string :tag "Specify")
+ (sexp))
+ (choice :tag "Closing tag"
+ (string :tag "Specify")
+ (sexp))))
+
+(defcustom org-export-html-table-align-individual-fields t
+ "Non-nil means attach style attributes for alignment to each table field.
+When nil, alignment will only be specified in the column tags, but this
+is ignored by some browsers (like Firefox, Safari). Opera does it right
+though."
+ :group 'org-export-tables
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-html-table-use-header-tags-for-first-column nil
+ "Non-nil means format column one in tables with header tags.
+When nil, also column one will use data tags."
+ :group 'org-export-tables
+ :type 'boolean)
+
+(defcustom org-export-html-validation-link
+ "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
+ "Link to HTML validation service."
+ :group 'org-export-html
+ :type 'string)
+
+;; FIXME Obsolete since Org 7.7
+;; Use the :timestamp option or `org-export-time-stamp-file' instead
+(defvar org-export-html-with-timestamp nil
+ "If non-nil, write container for HTML-helper-mode timestamp.")
+
+;; FIXME Obsolete since Org 7.7
+(defvar org-export-html-html-helper-timestamp
+ "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n"
+ "The HTML tag used as timestamp delimiter for HTML-helper-mode.")
+
+(defcustom org-export-html-protect-char-alist
+ '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;"))
+ "Alist of characters to be converted by `org-html-protect'."
+ :group 'org-export-html
+ :version "24.1"
+ :type '(repeat (cons (string :tag "Character")
+ (string :tag "HTML equivalent"))))
+
+(defgroup org-export-htmlize nil
+ "Options for processing examples with htmlize.el."
+ :tag "Org Export Htmlize"
+ :group 'org-export-html)
+
+(defcustom org-export-htmlize-output-type 'inline-css
+ "Output type to be used by htmlize when formatting code snippets.
+Choices are `css', to export the CSS selectors only, or `inline-css', to
+export the CSS attribute values inline in the HTML. We use as default
+`inline-css', in order to make the resulting HTML self-containing.
+
+However, this will fail when using Emacs in batch mode for export, because
+then no rich font definitions are in place. It will also not be good if
+people with different Emacs setup contribute HTML files to a website,
+because the fonts will represent the individual setups. In these cases,
+it is much better to let Org/Htmlize assign classes only, and to use
+a style file to define the look of these classes.
+To get a start for your css file, start Emacs session and make sure that
+all the faces you are interested in are defined, for example by loading files
+in all modes you want. Then, use the command
+\\[org-export-htmlize-generate-css] to extract class definitions."
+ :group 'org-export-htmlize
+ :type '(choice (const css) (const inline-css)))
+
+(defcustom org-export-htmlize-css-font-prefix "org-"
+ "The prefix for CSS class names for htmlize font specifications."
+ :group 'org-export-htmlize
+ :type 'string)
+
+(defcustom org-export-htmlized-org-css-url nil
+ "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer, htmlize will
+create CSS to define the font colors. However, this does not work when
+converting in batch mode, and it also can look bad if different people
+with different fontification setup work on the same website.
+When this variable is non-nil, creating an htmlized version of an Org buffer
+using `org-export-as-org' will remove the internal CSS section and replace it
+with a link to this URL."
+ :group 'org-export-htmlize
+ :type '(choice
+ (const :tag "Keep internal css" nil)
+ (string :tag "URL or local href")))
+
+;; FIXME: The following variable is obsolete since Org 7.7 but is
+;; still declared and checked within code for compatibility reasons.
+;; Use the custom variables `org-export-html-divs' instead.
+(defvar org-export-html-content-div "content"
+ "The name of the container DIV that holds all the page contents.
+
+This variable is obsolete since Org version 7.7.
+Please set `org-export-html-divs' instead.")
+
+(defcustom org-export-html-divs '("preamble" "content" "postamble")
+ "The name of the main divs for HTML export.
+This is a list of three strings, the first one for the preamble
+DIV, the second one for the content DIV and the third one for the
+postamble DIV."
+ :group 'org-export-html
+ :version "24.1"
+ :type '(list
+ (string :tag " Div for the preamble:")
+ (string :tag " Div for the content:")
+ (string :tag "Div for the postamble:")))
+
+(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z"
+ "Format string to format the date and time.
+
+The default is an extended format of the ISO 8601 specification."
+ :group 'org-export-html
+ :version "24.1"
+ :type 'string)
+
+;;; Hooks
+
+(defvar org-export-html-after-blockquotes-hook nil
+ "Hook run during HTML export, after blockquote, verse, center are done.")
+
+(defvar org-export-html-final-hook nil
+ "Hook run at the end of HTML export, in the new buffer.")
+
+;;; HTML export
+
+(defun org-export-html-preprocess (parameters)
+ "Convert LaTeX fragments to images."
+ (when (and org-current-export-file
+ (plist-get parameters :LaTeX-fragments))
+ (org-format-latex
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
+ (file-name-nondirectory
+ org-current-export-file)))
+ org-current-export-dir nil "Creating LaTeX image %s"
+ nil nil
+ (cond
+ ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
+ ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
+ ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
+ ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick)
+ ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng))))
+ (goto-char (point-min))
+ (let (label l1)
+ (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (setq label (match-string 1))
+ (save-match-data
+ (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label)
+ (setq l1 (substring label (match-beginning 1)))
+ (setq l1 label)))
+ (replace-match (format "[[#%s][%s]]" label l1) t t)))))
+
+;;;###autoload
+(defun org-export-as-html-and-open (arg)
+ "Export the outline as HTML and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists."
+ (interactive "P")
+ (org-export-as-html arg 'hidden)
+ (org-open-file buffer-file-name)
+ (when org-export-kill-product-buffer-when-displayed
+ (kill-buffer (current-buffer))))
+
+;;;###autoload
+(defun org-export-as-html-batch ()
+ "Call the function `org-export-as-html'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-html-batch"
+ (org-export-as-html org-export-headline-levels 'hidden))
+
+;;;###autoload
+(defun org-export-as-html-to-buffer (arg)
+ "Call `org-export-as-html` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-html'."
+ (interactive "P")
+ (org-export-as-html arg nil nil "*Org HTML Export*")
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window "*Org HTML Export*")))
+
+;;;###autoload
+(defun org-replace-region-by-html (beg end)
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use this
+command to convert it."
+ (interactive "r")
+ (let (reg html buf pop-up-frames)
+ (save-window-excursion
+ (if (derived-mode-p 'org-mode)
+ (setq html (org-export-region-as-html
+ beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq html (org-export-region-as-html
+ (point-min) (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert html)))
+
+;;;###autoload
+(defun org-export-region-as-html (beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-export-region-as-html beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "r\nP")
+ (when (org-called-interactively-p 'any)
+ (setq buffer "*Org HTML Export*"))
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-export-as-html
+ nil nil ext-plist
+ buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+(defvar html-table-tag nil) ; dynamically scoped into this.
+(defvar org-par-open nil)
+
+;;; org-html-cvt-link-fn
+(defconst org-html-cvt-link-fn
+ nil
+ "Function to convert link URLs to exportable URLs.
+Takes two arguments, TYPE and PATH.
+Returns exportable url as (TYPE PATH), or nil to signal that it
+didn't handle this case.
+Intended to be locally bound around a call to `org-export-as-html'." )
+
+(defun org-html-cvt-org-as-html (opt-plist type path)
+ "Convert an org filename to an equivalent html filename.
+If TYPE is not file, just return `nil'.
+See variable `org-export-html-link-org-files-as-html'"
+
+ (save-match-data
+ (and
+ org-export-html-link-org-files-as-html
+ (string= type "file")
+ (string-match "\\.org$" path)
+ (progn
+ (list
+ "file"
+ (concat
+ (substring path 0 (match-beginning 0))
+ "."
+ (plist-get opt-plist :html-extension)))))))
+
+
+;;; org-html-should-inline-p
+(defun org-html-should-inline-p (filename descp)
+ "Return non-nil if link FILENAME should be inlined.
+The decision to inline the FILENAME link is based on the current
+settings. DESCP is the boolean of whether there was a link
+description. See variables `org-export-html-inline-images' and
+`org-export-html-inline-image-extensions'."
+ (declare (special
+ org-export-html-inline-images
+ org-export-html-inline-image-extensions))
+ (and (or (eq t org-export-html-inline-images)
+ (and org-export-html-inline-images (not descp)))
+ (org-file-image-p
+ filename org-export-html-inline-image-extensions)))
+
+;;; org-html-make-link
+(defun org-html-make-link (opt-plist type path fragment desc attr
+ may-inline-p)
+ "Make an HTML link.
+OPT-PLIST is an options list.
+TYPE is the device-type of the link (THIS://foo.html).
+PATH is the path of the link (http://THIS#location).
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
+DESC is the link description, if any.
+ATTR is a string of other attributes of the \"a\" element.
+MAY-INLINE-P allows inlining it as an image."
+
+ (declare (special org-par-open))
+ (save-match-data
+ (let* ((filename path)
+ ;;First pass. Just sanity stuff.
+ (components-1
+ (cond
+ ((string= type "file")
+ (list
+ type
+ ;;Substitute just if original path was absolute.
+ ;;(Otherwise path must remain relative)
+ (if (file-name-absolute-p path)
+ (concat "file://" (expand-file-name path))
+ path)))
+ ((string= type "")
+ (list nil path))
+ (t (list type path))))
+
+ ;;Second pass. Components converted so they can refer
+ ;;to a remote site.
+ (components-2
+ (or
+ (and org-html-cvt-link-fn
+ (apply org-html-cvt-link-fn
+ opt-plist components-1))
+ (apply #'org-html-cvt-org-as-html
+ opt-plist components-1)
+ components-1))
+ (type (first components-2))
+ (thefile (second components-2)))
+
+
+ ;;Third pass. Build final link except for leading type
+ ;;spec.
+ (cond
+ ((or
+ (not type)
+ (string= type "http")
+ (string= type "https")
+ (string= type "file")
+ (string= type "coderef"))
+ (if fragment
+ (setq thefile (concat thefile "#" fragment))))
+
+ (t))
+
+ ;;Final URL-build, for all types.
+ (setq thefile
+ (let
+ ((str (org-export-html-format-href thefile)))
+ (if (and type (not (or (string= "file" type)
+ (string= "coderef" type))))
+ (concat type ":" str)
+ str)))
+
+ (if (and
+ may-inline-p
+ ;;Can't inline a URL with a fragment.
+ (not fragment))
+ (progn
+ (message "image %s %s" thefile org-par-open)
+ (org-export-html-format-image thefile org-par-open))
+ (concat
+ "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
+ (org-export-html-format-desc desc)
+ "</a>")))))
+
+(defun org-html-handle-links (org-line opt-plist)
+ "Return ORG-LINE with markup of Org mode links.
+OPT-PLIST is the export options list."
+ (let ((start 0)
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (link-validate (plist-get opt-plist :link-validation-function))
+ type id-file fnc
+ rpl path attr desc descp desc1 desc2 link)
+ (while (string-match org-bracket-link-analytic-regexp++ org-line start)
+ (setq start (match-beginning 0))
+ (setq path (save-match-data (org-link-unescape
+ (match-string 3 org-line))))
+ (setq type (cond
+ ((match-end 2) (match-string 2 org-line))
+ ((save-match-data
+ (or (file-name-absolute-p path)
+ (string-match "^\\.\\.?/" path)))
+ "file")
+ (t "internal")))
+ (setq path (org-extract-attributes path))
+ (setq attr (get-text-property 0 'org-attributes path))
+ (setq desc1 (if (match-end 5) (match-string 5 org-line))
+ desc2 (if (match-end 2) (concat type ":" path) path)
+ descp (and desc1 (not (equal desc1 desc2)))
+ desc (or desc1 desc2))
+ ;; Make an image out of the description if that is so wanted
+ (when (and descp (org-file-image-p
+ desc org-export-html-inline-image-extensions))
+ (save-match-data
+ (if (string-match "^file:" desc)
+ (setq desc (substring desc (match-end 0)))))
+ (setq desc (org-add-props
+ (concat "<img src=\"" desc "\" alt=\""
+ (file-name-nondirectory desc) "\"/>")
+ '(org-protected t))))
+ (cond
+ ((equal type "internal")
+ (let
+ ((frag-0
+ (if (= (string-to-char path) ?#)
+ (substring path 1)
+ path)))
+ (setq rpl
+ (org-html-make-link
+ opt-plist
+ ""
+ ""
+ (org-solidify-link-text
+ (save-match-data (org-link-unescape frag-0))
+ nil)
+ desc attr nil))))
+ ((and (equal type "id")
+ (setq id-file (org-id-find-id-file path)))
+ ;; This is an id: link to another file (if it was the same file,
+ ;; it would have become an internal link...)
+ (save-match-data
+ (setq id-file (file-relative-name
+ id-file
+ (file-name-directory org-current-export-file)))
+ (setq rpl
+ (org-html-make-link opt-plist
+ "file" id-file
+ (concat (if (org-uuidgen-p path) "ID-") path)
+ desc
+ attr
+ nil))))
+ ((member type '("http" "https"))
+ ;; standard URL, can inline as image
+ (setq rpl
+ (org-html-make-link opt-plist
+ type path nil
+ desc
+ attr
+ (org-html-should-inline-p path descp))))
+ ((member type '("ftp" "mailto" "news"))
+ ;; standard URL, can't inline as image
+ (setq rpl
+ (org-html-make-link opt-plist
+ type path nil
+ desc
+ attr
+ nil)))
+
+ ((string= type "coderef")
+ (let*
+ ((coderef-str (format "coderef-%s" path))
+ (attr-1
+ (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
+ coderef-str coderef-str)))
+ (setq rpl
+ (org-html-make-link opt-plist
+ type "" coderef-str
+ (format
+ (org-export-get-coderef-format
+ path
+ (and descp desc))
+ (cdr (assoc path org-export-code-refs)))
+ attr-1
+ nil))))
+
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for format the link
+ (setq rpl
+ (save-match-data
+ (funcall fnc (org-link-unescape path) desc1 'html))))
+
+ ((string= type "file")
+ ;; FILE link
+ (save-match-data
+ (let*
+ ((components
+ (if
+ (string-match "::\\(.*\\)" path)
+ (list
+ (replace-match "" t nil path)
+ (match-string 1 path))
+ (list path nil)))
+
+ ;;The proper path, without a fragment
+ (path-1
+ (first components))
+
+ ;;The raw fragment
+ (fragment-0
+ (second components))
+
+ ;;Check the fragment. If it can't be used as
+ ;;target fragment we'll pass nil instead.
+ (fragment-1
+ (if
+ (and fragment-0
+ (not (string-match "^[0-9]*$" fragment-0))
+ (not (string-match "^\\*" fragment-0))
+ (not (string-match "^/.*/$" fragment-0)))
+ (org-solidify-link-text
+ (org-link-unescape fragment-0))
+ nil))
+ (desc-2
+ ;;Description minus "file:" and ".org"
+ (if (string-match "^file:" desc)
+ (let
+ ((desc-1 (replace-match "" t t desc)))
+ (if (string-match "\\.org$" desc-1)
+ (replace-match "" t t desc-1)
+ desc-1))
+ desc)))
+
+ (setq rpl
+ (if
+ (and
+ (functionp link-validate)
+ (not (funcall link-validate path-1 current-dir)))
+ desc
+ (org-html-make-link opt-plist
+ "file" path-1 fragment-1 desc-2 attr
+ (org-html-should-inline-p path-1 descp)))))))
+
+ (t
+ ;; just publish the path, as default
+ (setq rpl (concat "<i>&lt;" type ":"
+ (save-match-data (org-link-unescape path))
+ "&gt;</i>"))))
+ (setq org-line (replace-match rpl t t org-line)
+ start (+ start (length rpl))))
+ org-line))
+
+;;; org-export-as-html
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+
+;;;###autoload
+(defun org-export-as-html (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline as a pretty HTML file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting HTML as a string. When BODY-ONLY is set, don't produce
+the file header and footer, simply return the content of
+<body>...</body>, without even the body tags themselves. When
+PUB-DIR is set, use this as the publishing directory."
+ (interactive "P")
+ (run-hooks 'org-export-first-hook)
+
+ ;; Make sure we have a file name when we need it.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (message "Exporting...")
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (setq-default org-deadline-line-regexp org-deadline-line-regexp)
+ (setq-default org-done-keywords org-done-keywords)
+ (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
+ (let* ((opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (body-only (or body-only (plist-get opt-plist :body-only)))
+ (style (concat (if (plist-get opt-plist :style-include-default)
+ org-export-html-style-default)
+ (plist-get opt-plist :style)
+ (plist-get opt-plist :style-extra)
+ "\n"
+ (if (plist-get opt-plist :style-include-scripts)
+ org-export-html-scripts)))
+ (html-extension (plist-get opt-plist :html-extension))
+ valid thetoc have-headings first-heading-pos
+ (odd org-odd-levels-only)
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-export-directory :html opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (level 0) (org-line "") (origline "") txt todo
+ (umax nil)
+ (umax-toc nil)
+ (filename (if to-buffer nil
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory buffer-file-name)))
+ "." html-extension)
+ (file-name-as-directory
+ (or pub-dir (org-export-directory :html opt-plist))))))
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect filename)))
+ (org-levels-open (make-vector org-level-max nil))
+ (date (org-html-expand (plist-get opt-plist :date)))
+ (author (org-html-expand (plist-get opt-plist :author)))
+ (html-validation-link (or org-export-html-validation-link ""))
+ (title (org-html-expand
+ (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not body-only)
+ (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED")))
+ (link-up (and (plist-get opt-plist :link-up)
+ (string-match "\\S-" (plist-get opt-plist :link-up))
+ (plist-get opt-plist :link-up)))
+ (link-home (and (plist-get opt-plist :link-home)
+ (string-match "\\S-" (plist-get opt-plist :link-home))
+ (plist-get opt-plist :link-home)))
+ (dummy (setq opt-plist (plist-put opt-plist :title title)))
+ (html-table-tag (plist-get opt-plist :html-table-tag))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (inquote nil)
+ (infixed nil)
+ (inverse nil)
+ (email (plist-get opt-plist :email))
+ (language (plist-get opt-plist :language))
+ (keywords (org-html-expand (plist-get opt-plist :keywords)))
+ (description (org-html-expand (plist-get opt-plist :description)))
+ (num (plist-get opt-plist :section-numbers))
+ (lang-words nil)
+ (head-count 0) cnt
+ (start 0)
+ (coding-system (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system))
+ (coding-system-for-write (or org-export-html-coding-system
+ coding-system))
+ (save-buffer-coding-system (or org-export-html-coding-system
+ coding-system))
+ (charset (and coding-system-for-write
+ (fboundp 'coding-system-get)
+ (coding-system-get coding-system-for-write
+ 'mime-charset)))
+ (region
+ (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (org-export-have-math nil)
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (custom-id (or (org-entry-get nil "CUSTOM_ID" t) ""))
+ (footnote-def-prefix (format "fn-%s" custom-id))
+ (footnote-ref-prefix (format "fnr-%s" custom-id))
+ (lines
+ (org-split-string
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend 'html
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :add-text
+ (plist-get opt-plist :text)
+ :LaTeX-fragments
+ (plist-get opt-plist :LaTeX-fragments))
+ "[\r\n]"))
+ (mathjax
+ (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax)
+ (and org-export-have-math
+ (eq (plist-get opt-plist :LaTeX-fragments) t)))
+
+ (org-export-html-mathjax-config
+ org-export-html-mathjax-template
+ org-export-html-mathjax-options
+ (or (plist-get opt-plist :mathjax) ""))
+ ""))
+ table-open
+ table-buffer table-orig-buffer
+ ind
+ rpl path attr desc descp desc1 desc2 link
+ snumber fnc
+ footnotes footref-seen
+ href)
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (message "Exporting...")
+
+ (setq org-min-level (org-get-min-level lines level-offset))
+ (setq org-last-level org-min-level)
+ (org-init-section-numbers)
+
+ (cond
+ ((and date (string-match "%" date))
+ (setq date (format-time-string date)))
+ (date)
+ (t (setq date (format-time-string org-export-html-date-format-string))))
+
+ ;; Get the language-dependent settings
+ (setq lang-words (or (assoc language org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+
+ ;; Switch to the output buffer
+ (set-buffer buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ (let ((case-fold-search nil)
+ (org-odd-levels-only odd))
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc (if (integerp org-export-with-toc)
+ (min org-export-with-toc umax)
+ umax))
+ (unless body-only
+ ;; File header
+ (insert (format
+ "%s
+<!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\" lang=\"%s\" xml:lang=\"%s\">
+<head>
+<title>%s</title>
+<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
+<meta name=\"title\" content=\"%s\"/>
+<meta name=\"generator\" content=\"Org-mode\"/>
+<meta name=\"generated\" content=\"%s\"/>
+<meta name=\"author\" content=\"%s\"/>
+<meta name=\"description\" content=\"%s\"/>
+<meta name=\"keywords\" content=\"%s\"/>
+%s
+%s
+</head>
+<body>
+%s
+"
+ (format
+ (or (and (stringp org-export-html-xml-declaration)
+ org-export-html-xml-declaration)
+ (cdr (assoc html-extension org-export-html-xml-declaration))
+ (cdr (assoc "html" org-export-html-xml-declaration))
+
+ "")
+ (or charset "iso-8859-1"))
+ language language
+ title
+ (or charset "iso-8859-1")
+ title date author description keywords
+ style
+ mathjax
+ (if (or link-up link-home)
+ (concat
+ (format org-export-html-home/up-format
+ (or link-up link-home)
+ (or link-home link-up))
+ "\n")
+ "")))
+
+ ;; insert html preamble
+ (when (plist-get opt-plist :html-preamble)
+ (let ((html-pre (plist-get opt-plist :html-preamble))
+ (html-pre-real-contents ""))
+ (cond ((stringp html-pre)
+ (setq html-pre-real-contents
+ (format-spec html-pre `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email)))))
+ ((functionp html-pre)
+ (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
+ (if (stringp (funcall html-pre)) (insert (funcall html-pre)))
+ (insert "\n</div>\n"))
+ (t
+ (setq html-pre-real-contents
+ (format-spec
+ (or (cadr (assoc (nth 0 lang-words)
+ org-export-html-preamble-format))
+ (cadr (assoc "en" org-export-html-preamble-format)))
+ `((?t . ,title) (?a . ,author)
+ (?d . ,date) (?e . ,email))))))
+ ;; don't output an empty preamble DIV
+ (unless (and (functionp html-pre)
+ (equal html-pre-real-contents ""))
+ (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
+ (insert html-pre-real-contents)
+ (insert "\n</div>\n"))))
+
+ ;; begin wrap around body
+ (insert (format "\n<div id=\"%s\">"
+ ;; FIXME org-export-html-content-div is obsolete since 7.7
+ (or org-export-html-content-div
+ (nth 1 org-export-html-divs)))
+ ;; FIXME this should go in the preamble but is here so
+ ;; that org-infojs can still find it
+ "\n<h1 class=\"title\">" title "</h1>\n"))
+
+ ;; insert body
+ (if org-export-with-toc
+ (progn
+ (push (format "<h%d>%s</h%d>\n"
+ org-export-html-toplevel-hlevel
+ (nth 3 lang-words)
+ org-export-html-toplevel-hlevel)
+ thetoc)
+ (push "<div id=\"text-table-of-contents\">\n" thetoc)
+ (push "<ul>\n<li>" thetoc)
+ (setq lines
+ (mapcar
+ #'(lambda (org-line)
+ (if (and (string-match org-todo-line-regexp org-line)
+ (not (get-text-property 0 'org-protected org-line)))
+ ;; This is a headline
+ (progn
+ (setq have-headings t)
+ (setq level (- (match-end 1) (match-beginning 1)
+ level-offset)
+ level (org-tr-level level)
+ txt (save-match-data
+ (org-html-expand
+ (org-export-cleanup-toc-line
+ (match-string 3 org-line))))
+ todo
+ (or (and org-export-mark-todo-in-toc
+ (match-beginning 2)
+ (not (member (match-string 2 org-line)
+ org-done-keywords)))
+ ; TODO, not DONE
+ (and org-export-mark-todo-in-toc
+ (= level umax-toc)
+ (org-search-todo-below
+ org-line lines level))))
+ (if (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq txt (replace-match
+ "&nbsp;&nbsp;&nbsp;<span class=\"tag\">\\1</span>" t nil txt)))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq snumber (org-section-number level))
+ (if (and num (if (integerp num)
+ (>= num level)
+ num))
+ (setq txt (concat snumber " " txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (if (<= level umax-toc)
+ (progn
+ (if (> level org-last-level)
+ (progn
+ (setq cnt (- level org-last-level))
+ (while (>= (setq cnt (1- cnt)) 0)
+ (push "\n<ul>\n<li>" thetoc))
+ (push "\n" thetoc)))
+ (if (< level org-last-level)
+ (progn
+ (setq cnt (- org-last-level level))
+ (while (>= (setq cnt (1- cnt)) 0)
+ (push "</li>\n</ul>" thetoc))
+ (push "\n" thetoc)))
+ ;; Check for targets
+ (while (string-match org-any-target-regexp org-line)
+ (setq org-line (replace-match
+ (concat "@<span class=\"target\">"
+ (match-string 1 org-line) "@</span> ")
+ t t org-line)))
+ (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq href
+ (replace-regexp-in-string
+ "\\." "-" (format "sec-%s" snumber)))
+ (setq href (org-solidify-link-text
+ (or (cdr (assoc href
+ org-export-preferred-target-alist)) href)))
+ (push
+ (format
+ (if todo
+ "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
+ "</li>\n<li><a href=\"#%s\">%s</a>")
+ href txt) thetoc)
+
+ (setq org-last-level level)))))
+ org-line)
+ lines))
+ (while (> org-last-level (1- org-min-level))
+ (setq org-last-level (1- org-last-level))
+ (push "</li>\n</ul>\n" thetoc))
+ (push "</div>\n" thetoc)
+ (setq thetoc (if have-headings (nreverse thetoc) nil))))
+
+ (setq head-count 0)
+ (org-init-section-numbers)
+
+ (org-open-par)
+
+ (while (setq org-line (pop lines) origline org-line)
+ (catch 'nextline
+
+ ;; end of quote section?
+ (when (and inquote (string-match org-outline-regexp-bol org-line))
+ (insert "</pre>\n")
+ (org-open-par)
+ (setq inquote nil))
+ ;; inside a quote section?
+ (when inquote
+ (insert (org-html-protect org-line) "\n")
+ (throw 'nextline nil))
+
+ ;; Fixed-width, verbatim lines (examples)
+ (when (and org-export-with-fixed-width
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line))
+ (when (not infixed)
+ (setq infixed t)
+ (org-close-par-maybe)
+
+ (insert "<pre class=\"example\">\n"))
+ (insert (org-html-protect (match-string 3 org-line)) "\n")
+ (when (or (not lines)
+ (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
+ (car lines))))
+ (setq infixed nil)
+ (insert "</pre>\n")
+ (org-open-par))
+ (throw 'nextline nil))
+
+ ;; Protected HTML
+ (when (and (get-text-property 0 'org-protected org-line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-protected org-line) 10000)
+ (length org-line))))
+ (let (par (ind (get-text-property 0 'original-indentation org-line)))
+ (when (re-search-backward
+ "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
+ (setq par (match-string 1))
+ (replace-match "\\2\n"))
+ (insert org-line "\n")
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-protected (car lines))))
+ (insert (pop lines) "\n"))
+ (and par (insert "<p>\n")))
+ (throw 'nextline nil))
+
+ ;; Blockquotes, verse, and center
+ (when (equal "ORG-BLOCKQUOTE-START" org-line)
+ (org-close-par-maybe)
+ (insert "<blockquote>\n")
+ (org-open-par)
+ (throw 'nextline nil))
+ (when (equal "ORG-BLOCKQUOTE-END" org-line)
+ (org-close-par-maybe)
+ (insert "\n</blockquote>\n")
+ (org-open-par)
+ (throw 'nextline nil))
+ (when (equal "ORG-VERSE-START" org-line)
+ (org-close-par-maybe)
+ (insert "\n<p class=\"verse\">\n")
+ (setq org-par-open t)
+ (setq inverse t)
+ (throw 'nextline nil))
+ (when (equal "ORG-VERSE-END" org-line)
+ (insert "</p>\n")
+ (setq org-par-open nil)
+ (org-open-par)
+ (setq inverse nil)
+ (throw 'nextline nil))
+ (when (equal "ORG-CENTER-START" org-line)
+ (org-close-par-maybe)
+ (insert "\n<div style=\"text-align: center\">")
+ (org-open-par)
+ (throw 'nextline nil))
+ (when (equal "ORG-CENTER-END" org-line)
+ (org-close-par-maybe)
+ (insert "\n</div>")
+ (org-open-par)
+ (throw 'nextline nil))
+ (run-hooks 'org-export-html-after-blockquotes-hook)
+ (when inverse
+ (let ((i (org-get-string-indentation org-line)))
+ (if (> i 0)
+ (setq org-line (concat (mapconcat 'identity
+ (make-list (* 2 i) "\\nbsp") "")
+ " " (org-trim org-line))))
+ (unless (string-match "\\\\\\\\[ \t]*$" org-line)
+ (setq org-line (concat org-line "\\\\")))))
+
+ ;; make targets to anchors
+ (setq start 0)
+ (while (string-match
+ "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start)
+ (cond
+ ((get-text-property (match-beginning 1) 'org-protected org-line)
+ (setq start (match-end 1)))
+ ((match-end 2)
+ (setq org-line (replace-match
+ (format
+ "@<a name=\"%s\" id=\"%s\">@</a>"
+ (org-solidify-link-text (match-string 1 org-line))
+ (org-solidify-link-text (match-string 1 org-line)))
+ t t org-line)))
+ ((and org-export-with-toc (equal (string-to-char org-line) ?*))
+ ;; FIXME: NOT DEPENDENT on TOC?????????????????????
+ (setq org-line (replace-match
+ (concat "@<span class=\"target\">"
+ (match-string 1 org-line) "@</span> ")
+ ;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
+ t t org-line)))
+ (t
+ (setq org-line (replace-match
+ (concat "@<a name=\""
+ (org-solidify-link-text (match-string 1 org-line))
+ "\" class=\"target\">" (match-string 1 org-line)
+ "@</a> ")
+ t t org-line)))))
+
+ (setq org-line (org-html-handle-time-stamps org-line))
+
+ ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
+ ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
+ ;; Also handle sub_superscripts and checkboxes
+ (or (string-match org-table-hline-regexp org-line)
+ (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line)
+ (setq org-line (org-html-expand org-line)))
+
+ ;; Format the links
+ (setq org-line (org-html-handle-links org-line opt-plist))
+
+ ;; TODO items
+ (if (and org-todo-line-regexp
+ (string-match org-todo-line-regexp org-line)
+ (match-beginning 2))
+
+ (setq org-line
+ (concat (substring org-line 0 (match-beginning 2))
+ "<span class=\""
+ (if (member (match-string 2 org-line)
+ org-done-keywords)
+ "done" "todo")
+ " " (org-export-html-get-todo-kwd-class-name
+ (match-string 2 org-line))
+ "\">" (match-string 2 org-line)
+ "</span>" (substring org-line (match-end 2)))))
+
+ ;; Does this contain a reference to a footnote?
+ (when org-export-with-footnotes
+ (setq start 0)
+ (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start)
+ ;; Discard protected matches not clearly identified as
+ ;; footnote markers.
+ (if (or (get-text-property (match-beginning 2) 'org-protected org-line)
+ (not (get-text-property (match-beginning 2) 'org-footnote org-line)))
+ (setq start (match-end 2))
+ (let ((n (match-string 2 org-line)) extra a)
+ (if (setq a (assoc n footref-seen))
+ (progn
+ (setcdr a (1+ (cdr a)))
+ (setq extra (format ".%d" (cdr a))))
+ (setq extra "")
+ (push (cons n 1) footref-seen))
+ (setq org-line
+ (replace-match
+ (concat
+ (format
+ (concat "%s"
+ (format org-export-html-footnote-format
+ (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>")))
+ (or (match-string 1 org-line) "") n extra n n)
+ ;; If another footnote is following the
+ ;; current one, add a separator.
+ (if (save-match-data
+ (string-match "\\`\\[[0-9]+\\]"
+ (substring org-line (match-end 0))))
+ org-export-html-footnote-separator
+ ""))
+ t t org-line))))))
+
+ (cond
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line)
+ ;; This is a headline
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (or (match-string 2 org-line) ""))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (setq first-heading-pos (or first-heading-pos (point)))
+ (org-html-level-start level txt umax
+ (and org-export-with-toc (<= level umax))
+ head-count opt-plist)
+
+ ;; QUOTES
+ (when (string-match quote-re org-line)
+ (org-close-par-maybe)
+ (insert "<pre>")
+ (setq inquote t)))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
+ (when (not table-open)
+ ;; New table starts
+ (setq table-open t table-buffer nil table-orig-buffer nil))
+
+ ;; Accumulate lines
+ (setq table-buffer (cons org-line table-buffer)
+ table-orig-buffer (cons origline table-orig-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer)
+ table-orig-buffer (nreverse table-orig-buffer))
+ (org-close-par-maybe)
+ (insert (org-format-table-html table-buffer table-orig-buffer))))
+
+ ;; Normal lines
+
+ (t
+ ;; This line either is list item or end a list.
+ (when (get-text-property 0 'list-item org-line)
+ (setq org-line (org-html-export-list-line
+ org-line
+ (get-text-property 0 'list-item org-line)
+ (get-text-property 0 'list-struct org-line)
+ (get-text-property 0 'list-prevs org-line))))
+
+ ;; Horizontal line
+ (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
+ (if org-par-open
+ (insert "\n</p>\n<hr/>\n<p>\n")
+ (insert "\n<hr/>\n"))
+ (throw 'nextline nil))
+
+ ;; Empty lines start a new paragraph. If hand-formatted lists
+ ;; are not fully interpreted, lines starting with "-", "+", "*"
+ ;; also start a new paragraph.
+ (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par))
+
+ ;; Is this the start of a footnote?
+ (when org-export-with-footnotes
+ (when (and (boundp 'footnote-section-tag-regexp)
+ (string-match (concat "^" footnote-section-tag-regexp)
+ org-line))
+ ;; ignore this line
+ (throw 'nextline nil))
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line)
+ (org-close-par-maybe)
+ (let ((n (match-string 1 org-line)))
+ (setq org-par-open t
+ org-line (replace-match
+ (format
+ (concat "<p class=\"footnote\">"
+ (format org-export-html-footnote-format
+ (concat
+ "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
+ n n n) t t org-line)))))
+ ;; Check if the line break needs to be conserved
+ (cond
+ ((string-match "\\\\\\\\[ \t]*$" org-line)
+ (setq org-line (replace-match "<br/>" t t org-line)))
+ (org-export-preserve-breaks
+ (setq org-line (concat org-line "<br/>"))))
+
+ ;; Check if a paragraph should be started
+ (let ((start 0))
+ (while (and org-par-open
+ (string-match "\\\\par\\>" org-line start))
+ ;; Leave a space in the </p> so that the footnote matcher
+ ;; does not see this.
+ (if (not (get-text-property (match-beginning 0)
+ 'org-protected org-line))
+ (setq org-line (replace-match "</p ><p >" t t org-line)))
+ (setq start (match-end 0))))
+
+ (insert org-line "\n")))))
+
+ ;; Properly close all local lists and other lists
+ (when inquote
+ (insert "</pre>\n")
+ (org-open-par))
+
+ (org-html-level-start 1 nil umax
+ (and org-export-with-toc (<= level umax))
+ head-count opt-plist)
+ ;; the </div> to close the last text-... div.
+ (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
+
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
+ nil t)
+ (push (match-string 1) footnotes)
+ (replace-match "\\4" t nil)
+ (goto-char (match-beginning 0))))
+ (when footnotes
+ (insert (format org-export-html-footnotes-section
+ (nth 4 lang-words)
+ (mapconcat 'identity (nreverse footnotes) "\n"))
+ "\n"))
+ (let ((bib (org-export-html-get-bibliography)))
+ (when bib
+ (insert "\n" bib "\n")))
+
+ (unless body-only
+ ;; end wrap around body
+ (insert "</div>\n")
+
+ ;; export html postamble
+ (let ((html-post (plist-get opt-plist :html-postamble))
+ (email
+ (mapconcat (lambda(e)
+ (format "<a href=\"mailto:%s\">%s</a>" e e))
+ (split-string email ",+ *")
+ ", "))
+ (creator-info
+ (concat "<a href=\"http://orgmode.org\">Org</a> version "
+ (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
+ (number-to-string emacs-major-version))))
+
+ (when (plist-get opt-plist :html-postamble)
+ (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n")
+ (cond ((stringp html-post)
+ (insert (format-spec html-post
+ `((?a . ,author) (?e . ,email)
+ (?d . ,date) (?c . ,creator-info)
+ (?v . ,html-validation-link)))))
+ ((functionp html-post)
+ (if (stringp (funcall html-post)) (insert (funcall html-post))))
+ ((eq html-post 'auto)
+ ;; fall back on default postamble
+ (when (plist-get opt-plist :time-stamp-file)
+ (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
+ (when (and (plist-get opt-plist :author-info) author)
+ (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
+ (when (and (plist-get opt-plist :email-info) email)
+ (insert "<p class=\"email\">" email "</p>\n"))
+ (when (plist-get opt-plist :creator-info)
+ (insert "<p class=\"creator\">"
+ (concat "<a href=\"http://orgmode.org\">Org</a> version "
+ (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
+ (number-to-string emacs-major-version) "</p>\n")))
+ (insert html-validation-link "\n"))
+ (t
+ (insert (format-spec
+ (or (cadr (assoc (nth 0 lang-words)
+ org-export-html-postamble-format))
+ (cadr (assoc "en" org-export-html-postamble-format)))
+ `((?a . ,author) (?e . ,email)
+ (?d . ,date) (?c . ,creator-info)
+ (?v . ,html-validation-link))))))
+ (insert "\n</div>"))))
+
+ ;; FIXME `org-export-html-with-timestamp' has been declared
+ ;; obsolete since Org 7.7 -- don't forget to remove this.
+ (if org-export-html-with-timestamp
+ (insert org-export-html-html-helper-timestamp))
+
+ (unless body-only (insert "\n</body>\n</html>\n"))
+
+ (unless (plist-get opt-plist :buffer-will-be-killed)
+ (normal-mode)
+ (if (eq major-mode (default-value 'major-mode))
+ (html-mode)))
+
+ ;; insert the table of contents
+ (goto-char (point-min))
+ (when thetoc
+ (if (or (re-search-forward
+ "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
+ (re-search-forward
+ "\\[TABLE-OF-CONTENTS\\]" nil t))
+ (progn
+ (goto-char (match-beginning 0))
+ (replace-match ""))
+ (goto-char first-heading-pos)
+ (when (looking-at "\\s-*</p>")
+ (goto-char (match-end 0))
+ (insert "\n")))
+ (insert "<div id=\"table-of-contents\">\n")
+ (let ((beg (point)))
+ (mapc 'insert thetoc)
+ (insert "</div>\n")
+ (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t)
+ (replace-match ""))))
+ ;; remove empty paragraphs
+ (goto-char (point-min))
+ (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "<span style=\"visibility:hidden;\">%s</span>"
+ (make-string n ?x)))))
+ ;; Remove empty lines at the beginning of the file.
+ (goto-char (point-min))
+ (when (looking-at "\\s-+\n") (replace-match ""))
+ ;; Remove display properties
+ (remove-text-properties (point-min) (point-max) '(display t))
+ ;; Run the hook
+ (run-hooks 'org-export-html-final-hook)
+ (or to-buffer (save-buffer))
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring "HTML")
+ (message "Exporting... done"))
+ (if (eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer)))
+ (current-buffer)))))
+
+(defun org-export-html-format-href (s)
+ "Make sure the S is valid as a href reference in an XHTML document."
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "&" s start)
+ (setq start (+ (match-beginning 0) 3)
+ s (replace-match "&amp;" t t s)))))
+ s)
+
+(defun org-export-html-format-desc (s)
+ "Make sure the S is valid as a description in a link."
+ (if (and s (not (get-text-property 1 'org-protected s)))
+ (save-match-data
+ (org-html-do-expand s))
+ s))
+
+(defun org-export-html-format-image (src par-open)
+ "Create image tag with source and attributes."
+ (save-match-data
+ (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src)
+ (format "<img src=\"%s\" alt=\"%s\"/>"
+ src (org-find-text-property-in-string 'org-latex-src src))
+ (let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (attr (org-find-text-property-in-string 'org-attributes src))
+ (label (org-find-text-property-in-string 'org-label src)))
+ (setq caption (and caption (org-html-do-expand caption)))
+ (concat
+ (if caption
+ (format "%s<div %sclass=\"figure\">
+<p>"
+ (if org-par-open "</p>\n" "")
+ (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
+ (format "<img src=\"%s\"%s />"
+ src
+ (if (string-match "\\<alt=" (or attr ""))
+ (concat " " attr )
+ (concat " " attr " alt=\"" src "\"")))
+ (if caption
+ (format "</p>%s
+</div>%s"
+ (concat "\n<p>" caption "</p>")
+ (if org-par-open "\n<p>" ""))))))))
+
+(defun org-export-html-get-bibliography ()
+ "Find bibliography, cut it out and return it."
+ (catch 'exit
+ (let (beg end (cnt 1) bib)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
+ (setq beg (match-beginning 0))
+ (while (re-search-forward "</?div\\>" nil t)
+ (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
+ (when (= cnt 0)
+ (and (looking-at ">") (forward-char 1))
+ (setq bib (buffer-substring beg (point)))
+ (delete-region beg (point))
+ (throw 'exit bib))))
+ nil))))
+
+(defvar org-table-number-regexp) ; defined in org-table.el
+(defun org-format-table-html (lines olines &optional no-css)
+ "Find out which HTML converter to use and return the HTML code.
+NO-CSS is passed to the exporter."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (string-match "^[ \t]*|" (car lines))
+ ;; A normal org table
+ (org-format-org-table-html lines nil no-css)
+ ;; Table made by table.el
+ (or (org-format-table-table-html-using-table-generate-source
+ olines (not org-export-prefer-native-exporter-for-tables))
+ ;; We are here only when table.el table has NO col or row
+ ;; spanning and the user prefers using org's own converter for
+ ;; exporting of such simple table.el tables.
+ (org-format-table-table-html lines))))
+
+(defvar org-table-number-fraction) ; defined in org-table.el
+(defun org-format-org-table-html (lines &optional splice no-css)
+ "Format a table into HTML.
+LINES is a list of lines. Optional argument SPLICE means, do not
+insert header and surrounding <table> tags, just format the lines.
+Optional argument NO-CSS means use XHTML attributes instead of CSS
+for formatting. This is required for the DocBook exporter."
+ (require 'org-table)
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; column and the special lines
+ (setq lines (org-table-clean-before-export lines)))
+
+ (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
+ (label (org-find-text-property-in-string 'org-label (car lines)))
+ (col-cookies (org-find-text-property-in-string 'org-col-cookies
+ (car lines)))
+ (attributes (org-find-text-property-in-string 'org-attributes
+ (car lines)))
+ (html-table-tag (org-export-splice-attributes
+ html-table-tag attributes))
+ (head (and org-export-highlight-first-table-line
+ (delq nil (mapcar
+ (lambda (x) (string-match "^[ \t]*|-" x))
+ (cdr lines)))))
+ (nline 0) fnum nfields i (cnt 0)
+ tbopen org-line fields html gr colgropen rowstart rowend
+ ali align aligns n)
+ (setq caption (and caption (org-html-do-expand caption)))
+ (when (and col-cookies org-table-clean-did-remove-column)
+ (setq col-cookies
+ (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
+ (if splice (setq head nil))
+ (unless splice (push (if head "<thead>" "<tbody>") html))
+ (setq tbopen t)
+ (while (setq org-line (pop lines))
+ (catch 'next-line
+ (if (string-match "^[ \t]*|-" org-line)
+ (progn
+ (unless splice
+ (push (if head "</thead>" "</tbody>") html)
+ (if lines (push "<tbody>" html) (setq tbopen nil)))
+ (setq head nil) ;; head ends here, first time around
+ ;; ignore this line
+ (throw 'next-line t)))
+ ;; Break the line into fields
+ (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
+ (unless fnum (setq fnum (make-vector (length fields) 0)
+ nfields (length fnum)))
+ (setq nline (1+ nline) i -1
+ rowstart (eval (car org-export-table-row-tags))
+ rowend (eval (cdr org-export-table-row-tags)))
+ (push (concat rowstart
+ (mapconcat
+ (lambda (x)
+ (setq i (1+ i) ali (format "@@class%03d@@" i))
+ (if (and (< i nfields) ; make sure no rogue line causes an error here
+ (string-match org-table-number-regexp x))
+ (incf (aref fnum i)))
+ (cond
+ (head
+ (concat
+ (format (car org-export-table-header-tags)
+ "col" ali)
+ x
+ (cdr org-export-table-header-tags)))
+ ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
+ (concat
+ (format (car org-export-table-header-tags)
+ "row" ali)
+ x
+ (cdr org-export-table-header-tags)))
+ (t
+ (concat (format (car org-export-table-data-tags) ali)
+ x
+ (cdr org-export-table-data-tags)))))
+ fields "")
+ rowend)
+ html)))
+ (unless splice (if tbopen (push "</tbody>" html)))
+ (unless splice (push "</table>\n" html))
+ (setq html (nreverse html))
+ (unless splice
+ ;; Put in col tags with the alignment (unfortunately often ignored...)
+ (unless (car org-table-colgroup-info)
+ (setq org-table-colgroup-info
+ (cons :start (cdr org-table-colgroup-info))))
+ (setq i 0)
+ (push (mapconcat
+ (lambda (x)
+ (setq gr (pop org-table-colgroup-info)
+ i (1+ i)
+ align (if (nth 1 (assoc i col-cookies))
+ (cdr (assoc (nth 1 (assoc i col-cookies))
+ '(("l" . "left") ("r" . "right")
+ ("c" . "center"))))
+ (if (> (/ (float x) nline)
+ org-table-number-fraction)
+ "right" "left")))
+ (push align aligns)
+ (format (if no-css
+ "%s<col align=\"%s\" />%s"
+ "%s<col class=\"%s\" />%s")
+ (if (memq gr '(:start :startend))
+ (prog1
+ (if colgropen
+ "</colgroup>\n<colgroup>"
+ "<colgroup>")
+ (setq colgropen t))
+ "")
+ align
+ (if (memq gr '(:end :startend))
+ (progn (setq colgropen nil) "</colgroup>")
+ "")))
+ fnum "")
+ html)
+ (setq aligns (nreverse aligns))
+ (if colgropen (setq html (cons (car html)
+ (cons "</colgroup>" (cdr html)))))
+ ;; Since the output of HTML table formatter can also be used in
+ ;; DocBook document, include empty captions for the DocBook
+ ;; export only so that it produces valid XML.
+ (when (or caption (eq org-export-current-backend 'docbook))
+ (push (format "<caption>%s</caption>" (or caption "")) html))
+ (when label
+ (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
+ (push html-table-tag html))
+ (setq html (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ "@@class\\([0-9]+\\)@@"
+ (lambda (txt)
+ (if (not org-export-html-table-align-individual-fields)
+ ""
+ (setq n (string-to-number (match-string 1 txt)))
+ (format (if no-css " align=\"%s\"" " class=\"%s\"")
+ (or (nth n aligns) "left"))))
+ x))
+ html))
+ (concat (mapconcat 'identity html "\n") "\n")))
+
+(defun org-export-splice-attributes (tag attributes)
+ "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
+ (if (not attributes)
+ tag
+ (let (oldatt newatt)
+ (setq oldatt (org-extract-attributes-from-string tag)
+ tag (pop oldatt)
+ newatt (cdr (org-extract-attributes-from-string attributes)))
+ (while newatt
+ (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
+ (if (string-match ">" tag)
+ (setq tag
+ (replace-match (concat (org-attributes-to-string oldatt) ">")
+ t t tag)))
+ tag)))
+
+(defun org-format-table-table-html (lines)
+ "Format a table generated by table.el into HTML.
+This conversion does *not* use `table-generate-source' from table.el.
+This has the advantage that Org-mode's HTML conversions can be used.
+But it has the disadvantage, that no cell- or row-spanning is allowed."
+ (let (org-line field-buffer
+ (head org-export-highlight-first-table-line)
+ fields html empty i)
+ (setq html (concat html-table-tag "\n"))
+ (while (setq org-line (pop lines))
+ (setq empty "&nbsp;")
+ (catch 'next-line
+ (if (string-match "^[ \t]*\\+-" org-line)
+ (progn
+ (if field-buffer
+ (progn
+ (setq
+ html
+ (concat
+ html
+ "<tr>"
+ (mapconcat
+ (lambda (x)
+ (if (equal x "") (setq x empty))
+ (if head
+ (concat
+ (format (car org-export-table-header-tags) "col" "")
+ x
+ (cdr org-export-table-header-tags))
+ (concat (format (car org-export-table-data-tags) "") x
+ (cdr org-export-table-data-tags))))
+ field-buffer "\n")
+ "</tr>\n"))
+ (setq head nil)
+ (setq field-buffer nil)))
+ ;; Ignore this line
+ (throw 'next-line t)))
+ ;; Break the line into fields and store the fields
+ (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
+ (if field-buffer
+ (setq field-buffer (mapcar
+ (lambda (x)
+ (concat x "<br/>" (pop fields)))
+ field-buffer))
+ (setq field-buffer fields))))
+ (setq html (concat html "</table>\n"))
+ html))
+
+(defun org-format-table-table-html-using-table-generate-source (lines
+ &optional
+ spanned-only)
+ "Format a table into html, using `table-generate-source' from table.el.
+Use SPANNED-ONLY to suppress exporting of simple table.el tables.
+
+When SPANNED-ONLY is nil, all table.el tables are exported. When
+SPANNED-ONLY is non-nil, only tables with either row or column
+spans are exported.
+
+This routine returns the generated source or nil as appropriate.
+
+Refer docstring of `org-export-prefer-native-exporter-for-tables'
+for further information."
+ (require 'table)
+ (with-current-buffer (get-buffer-create " org-tmp1 ")
+ (erase-buffer)
+ (insert (mapconcat 'identity lines "\n"))
+ (goto-char (point-min))
+ (if (not (re-search-forward "|[^+]" nil t))
+ (error "Error processing table"))
+ (table-recognize-table)
+ (when (or (not spanned-only)
+ (let* ((dim (table-query-dimension))
+ (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
+ (not (= (* c r) cells))))
+ (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
+ (table-generate-source 'html " org-tmp2 ")
+ (set-buffer " org-tmp2 ")
+ (buffer-substring (point-min) (point-max)))))
+
+(defun org-export-splice-style (style extra)
+ "Splice EXTRA into STYLE, just before \"</style>\"."
+ (if (and (stringp extra)
+ (string-match "\\S-" extra)
+ (string-match "</style>" style))
+ (concat (substring style 0 (match-beginning 0))
+ "\n" extra "\n"
+ (substring style (match-beginning 0)))
+ style))
+
+(defun org-html-handle-time-stamps (s)
+ "Format time stamps in string S, or remove them."
+ (catch 'exit
+ (let (r b)
+ (when org-maybe-keyword-time-regexp
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (or b (setq b (substring s 0 (match-beginning 0))))
+ (setq r (concat
+ r (substring s 0 (match-beginning 0))
+ " @<span class=\"timestamp-wrapper\">"
+ (if (match-end 1)
+ (format "@<span class=\"timestamp-kwd\">%s @</span>"
+ (match-string 1 s)))
+ (format " @<span class=\"timestamp\">%s@</span>"
+ (substring
+ (org-translate-time (match-string 3 s)) 1 -1))
+ "@</span>")
+ s (substring s (match-end 0)))))
+ ;; Line break if line started and ended with time stamp stuff
+ (if (not r)
+ s
+ (setq r (concat r s))
+ (unless (string-match "\\S-" (concat b s))
+ (setq r (concat r "@<br/>")))
+ r))))
+
+(defvar htmlize-buffer-places) ; from htmlize.el
+(defun org-export-htmlize-region-for-paste (beg end)
+ "Convert the region to HTML, using htmlize.el.
+This is much like `htmlize-region-for-paste', only that it uses
+the settings define in the org-... variables."
+ (let* ((htmlize-output-type org-export-htmlize-output-type)
+ (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+;;;###autoload
+(defun org-export-htmlize-generate-css ()
+ "Create the CSS for all font definitions in the current Emacs session.
+Use this to create face definitions in your CSS style file that can then
+be used by code snippets transformed by htmlize.
+This command just produces a buffer that contains class definitions for all
+faces used in the current Emacs session. You can copy and paste the ones you
+need into your CSS file.
+
+If you then set `org-export-htmlize-output-type' to `css', calls to
+the function `org-export-htmlize-region-for-paste' will produce code
+that uses these same face definitions."
+ (interactive)
+ (require 'htmlize)
+ (and (get-buffer "*html*") (kill-buffer "*html*"))
+ (with-temp-buffer
+ (let ((fl (face-list))
+ (htmlize-css-name-prefix "org-")
+ (htmlize-output-type 'css)
+ f i)
+ (while (setq f (pop fl)
+ i (and f (face-attribute f :inherit)))
+ (when (and (symbolp f) (or (not i) (not (listp i))))
+ (insert (org-add-props (copy-sequence "1") nil 'face f))))
+ (htmlize-region (point-min) (point-max))))
+ (org-pop-to-buffer-same-window "*html*")
+ (goto-char (point-min))
+ (if (re-search-forward "<style" nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (if (re-search-forward "</style>" nil t)
+ (delete-region (1+ (match-end 0)) (point-max)))
+ (beginning-of-line 1)
+ (if (looking-at " +") (replace-match ""))
+ (goto-char (point-min)))
+
+(defun org-html-protect (s)
+ "Convert characters to HTML equivalent.
+Possible conversions are set in `org-export-html-protect-char-alist'."
+ (let ((cl org-export-html-protect-char-alist) c)
+ (while (setq c (pop cl))
+ (let ((start 0))
+ (while (string-match (car c) s start)
+ (setq s (replace-match (cdr c) t t s)
+ start (1+ (match-beginning 0))))))
+ s))
+
+(defun org-html-expand (string)
+ "Prepare STRING for HTML export. Apply all active conversions.
+If there are links in the string, don't modify these. If STRING
+is nil, return nil."
+ (when string
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-html-do-expand s) res)
+ (push l res))
+ (push (org-html-do-expand string) res)
+ (apply 'concat (nreverse res)))))
+
+(defun org-html-do-expand (s)
+ "Apply all active conversions to translate special ASCII to HTML."
+ (setq s (org-html-protect s))
+ (if org-export-html-expand
+ (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
+ (setq s (replace-match "<\\1>" t nil s))))
+ (if org-export-with-emphasize
+ (setq s (org-export-html-convert-emphasize s)))
+ (if org-export-with-special-strings
+ (setq s (org-export-html-convert-special-strings s)))
+ (if org-export-with-sub-superscripts
+ (setq s (org-export-html-convert-sub-super s)))
+ (if org-export-with-TeX-macros
+ (let ((start 0) wd rep)
+ (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
+ s start))
+ (if (get-text-property (match-beginning 0) 'org-protected s)
+ (setq start (match-end 0))
+ (setq wd (match-string 1 s))
+ (if (setq rep (org-entity-get-representation wd 'html))
+ (setq s (replace-match rep t t s))
+ (setq start (+ start (length wd))))))))
+ s)
+
+(defun org-export-html-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all org-export-html-special-string-regexps)
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (if (get-text-property (match-beginning 0) 'org-protected string)
+ (setq start (match-end 0))
+ (setq string (replace-match rpl t nil string)))))
+ string))
+
+(defun org-export-html-convert-sub-super (string)
+ "Convert sub- and superscripts in STRING to HTML."
+ (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
+ (while (string-match org-match-substring-regexp string s)
+ (cond
+ ((and requireb (match-end 8)) (setq s (match-end 2)))
+ ((get-text-property (match-beginning 2) 'org-protected string)
+ (setq s (match-end 2)))
+ (t
+ (setq s (match-end 1)
+ key (if (string= (match-string 2 string) "_") "sub" "sup")
+ c (or (match-string 8 string)
+ (match-string 6 string)
+ (match-string 5 string))
+ string (replace-match
+ (concat (match-string 1 string)
+ "<" key ">" c "</" key ">")
+ t t string)))))
+ (while (string-match "\\\\\\([_^]\\)" string)
+ (setq string (replace-match (match-string 1 string) t t string)))
+ string))
+
+(defun org-export-html-convert-emphasize (string)
+ "Apply emphasis."
+ (let ((s 0) rpl)
+ (while (string-match org-emph-re string s)
+ (if (not (equal
+ (substring string (match-beginning 3) (1+ (match-beginning 3)))
+ (substring string (match-beginning 4) (1+ (match-beginning 4)))))
+ (setq s (match-beginning 0)
+ rpl
+ (concat
+ (match-string 1 string)
+ (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
+ (match-string 4 string)
+ (nth 3 (assoc (match-string 3 string)
+ org-emphasis-alist))
+ (match-string 5 string))
+ string (replace-match rpl t t string)
+ s (+ s (- (length rpl) 2)))
+ (setq s (1+ s))))
+ string))
+
+(defun org-open-par ()
+ "Insert <p>, but first close previous paragraph if any."
+ (org-close-par-maybe)
+ (insert "\n<p>")
+ (setq org-par-open t))
+(defun org-close-par-maybe ()
+ "Close paragraph if there is one open."
+ (when org-par-open
+ (insert "</p>")
+ (setq org-par-open nil)))
+(defun org-close-li (&optional type)
+ "Close <li> if necessary."
+ (org-close-par-maybe)
+ (insert (if (equal type "d") "</dd>\n" "</li>\n")))
+
+(defvar body-only) ; dynamically scoped into this.
+(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist)
+ "Insert a new level in HTML export.
+When TITLE is nil, just close all open levels."
+ (org-close-par-maybe)
+ (let* ((target (and title (org-get-text-property-any 0 'target title)))
+ (extra-targets (and target
+ (assoc target org-export-target-aliases)))
+ (extra-class (and title (org-get-text-property-any 0 'html-container-class title)))
+ (preferred (and target
+ (cdr (assoc target org-export-preferred-target-alist))))
+ (l org-level-max)
+ (num (plist-get opt-plist :section-numbers))
+ snumber snu href suffix)
+ (setq extra-targets (remove (or preferred target) extra-targets))
+ (setq extra-targets
+ (mapconcat (lambda (x)
+ (setq x (org-solidify-link-text
+ (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (if (stringp org-export-html-headline-anchor-format)
+ (format org-export-html-headline-anchor-format x x)
+ ""))
+ extra-targets
+ ""))
+ (while (>= l level)
+ (if (aref org-levels-open (1- l))
+ (progn
+ (org-html-level-close l umax)
+ (aset org-levels-open (1- l) nil)))
+ (setq l (1- l)))
+ (when title
+ ;; If title is nil, this means this function is called to close
+ ;; all levels, so the rest is done only if title is given
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq title (replace-match
+ (if org-export-with-tags
+ (save-match-data
+ (concat
+ "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
+ (mapconcat
+ (lambda (x)
+ (format "<span class=\"%s\">%s</span>"
+ (org-export-html-get-tag-class-name x)
+ x))
+ (org-split-string (match-string 1 title) ":")
+ "&nbsp;")
+ "</span>"))
+ "")
+ t t title)))
+ (if (> level umax)
+ (progn
+ (if (aref org-levels-open (1- level))
+ (progn
+ (org-close-li)
+ (if target
+ (insert (format "<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
+ extra-targets title "<br/>\n")
+ (insert "<li>" title "<br/>\n")))
+ (aset org-levels-open (1- level) t)
+ (org-close-par-maybe)
+ (if target
+ (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
+ extra-targets title "<br/>\n")
+ (insert "<ul>\n<li>" title "<br/>\n"))))
+ (aset org-levels-open (1- level) t)
+ (setq snumber (org-section-number level)
+ snu (replace-regexp-in-string "\\." "-" snumber))
+ (setq level (+ level org-export-html-toplevel-hlevel -1))
+ (if (and num (not body-only))
+ (setq title (concat
+ (format "<span class=\"section-number-%d\">%s</span>"
+ level
+ (if (and num
+ (if (integerp num)
+ ;; fix up num to take into
+ ;; account the top-level
+ ;; heading value
+ (>= (+ num org-export-html-toplevel-hlevel -1)
+ level)
+ num))
+ snumber
+ ""))
+ " " title)))
+ (unless (= head-count 1) (insert "\n</div>\n"))
+ (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist)))
+ (setq suffix (org-solidify-link-text (or href snu)))
+ (setq href (org-solidify-link-text (or href (concat "sec-" snu))))
+ (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
+ suffix level (if extra-class (concat " " extra-class) "")
+ level href
+ extra-targets
+ title level level suffix))
+ (org-open-par)))))
+
+(defun org-export-html-get-tag-class-name (tag)
+ "Turn tag into a valid class name.
+Replaces invalid characters with \"_\" and then prepends a prefix."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" tag)
+ (setq tag (replace-match "_" t t tag))))
+ (concat org-export-html-tag-class-prefix tag))
+
+(defun org-export-html-get-todo-kwd-class-name (kwd)
+ "Turn todo keyword into a valid class name.
+Replaces invalid characters with \"_\" and then prepends a prefix."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ (concat org-export-html-todo-kwd-class-prefix kwd))
+
+(defun org-html-level-close (level max-outline-level)
+ "Terminate one level in HTML export."
+ (if (<= level max-outline-level)
+ (insert "</div>\n")
+ (org-close-li)
+ (insert "</ul>\n")))
+
+(defun org-html-export-list-line (org-line pos struct prevs)
+ "Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
+
+POS is the item position or org-line position the org-line had before
+modifications to buffer. STRUCT is the list structure. PREVS is
+the alist of previous items."
+ (let* ((get-type
+ (function
+ ;; Translate type of list containing POS to "d", "o" or
+ ;; "u".
+ (lambda (pos struct prevs)
+ (let ((type (org-list-get-list-type pos struct prevs)))
+ (cond
+ ((eq 'ordered type) "o")
+ ((eq 'descriptive type) "d")
+ (t "u"))))))
+ (get-closings
+ (function
+ ;; Return list of all items and sublists ending at POS, in
+ ;; reverse order.
+ (lambda (pos)
+ (let (out)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((end (nth 6 e))
+ (item (car e)))
+ (cond
+ ((= end pos) (push item out))
+ ((>= item pos) (throw 'exit nil)))))
+ struct))
+ out)))))
+ ;; First close any previous item, or list, ending at POS.
+ (mapc (lambda (e)
+ (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
+ (first-item (org-list-get-list-begin e struct prevs))
+ (type (funcall get-type first-item struct prevs)))
+ (org-close-par-maybe)
+ ;; Ending for every item
+ (org-close-li type)
+ ;; We're ending last item of the list: end list.
+ (when lastp
+ (insert (format "</%sl>\n" type))
+ (org-open-par))))
+ (funcall get-closings pos))
+ (cond
+ ;; At an item: insert appropriate tags in export buffer.
+ ((assq pos struct)
+ (string-match
+ (concat "[ \t]*\\(\\S-+[ \t]*\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
+ "\\(.*\\)") org-line)
+ (let* ((checkbox (match-string 3 org-line))
+ (desc-tag (or (match-string 4 org-line) "???"))
+ (body (or (match-string 5 org-line) ""))
+ (list-beg (org-list-get-list-begin pos struct prevs))
+ (firstp (= list-beg pos))
+ ;; Always refer to first item to determine list type, in
+ ;; case list is ill-formed.
+ (type (funcall get-type list-beg struct prevs))
+ (counter (let ((count-tmp (org-list-get-counter pos struct)))
+ (cond
+ ((not count-tmp) nil)
+ ((string-match "[A-Za-z]" count-tmp)
+ (- (string-to-char (upcase count-tmp)) 64))
+ ((string-match "[0-9]+" count-tmp)
+ count-tmp)))))
+ (when firstp
+ (org-close-par-maybe)
+ (insert (format "<%sl>\n" type)))
+ (insert (cond
+ ((equal type "d")
+ (format "<dt>%s</dt><dd>" desc-tag))
+ ((and (equal type "o") counter)
+ (format "<li value=\"%s\">" counter))
+ (t "<li>")))
+ ;; If line had a checkbox, some additional modification is required.
+ (when checkbox
+ (setq body
+ (concat
+ (cond
+ ((string-match "X" checkbox) "<code>[X]</code> ")
+ ((string-match " " checkbox) "<code>[&nbsp;]</code> ")
+ (t "<code>[-]</code> "))
+ body)))
+ ;; Return modified line
+ body))
+ ;; At a list ender: go to next line (side-effects only).
+ ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil))
+ ;; Not at an item: return line unchanged (side-effects only).
+ (t org-line))))
+
+(provide 'org-html)
+
+;;; org-html.el ends here
diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el
new file mode 100644
index 0000000..8523b44
--- /dev/null
+++ b/lisp/org-icalendar.el
@@ -0,0 +1,687 @@
+;;; org-icalendar.el --- iCalendar export for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-exp)
+
+(eval-when-compile (require 'cl))
+
+(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
+
+(defgroup org-export-icalendar nil
+ "Options specific for iCalendar export of Org-mode files."
+ :tag "Org Export iCalendar"
+ :group 'org-export)
+
+(defcustom org-combined-agenda-icalendar-file "~/org.ics"
+ "The file name for the iCalendar file covering all agenda files.
+This file is created with the command \\[org-export-icalendar-all-agenda-files].
+The file name should be absolute, the file will be overwritten without warning."
+ :group 'org-export-icalendar
+ :type 'file)
+
+(defcustom org-icalendar-alarm-time 0
+ "Number of minutes for triggering an alarm for exported timed events.
+A zero value (the default) turns off the definition of an alarm trigger
+for timed events. If non-zero, alarms are created.
+
+- a single alarm per entry is defined
+- The alarm will go off N minutes before the event
+- only a DISPLAY action is defined."
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type 'integer)
+
+(defcustom org-icalendar-combined-name "OrgMode"
+ "Calendar name for the combined iCalendar representing all agenda files."
+ :group 'org-export-icalendar
+ :type 'string)
+
+(defcustom org-icalendar-combined-description nil
+ "Calendar description for the combined iCalendar (all agenda files)."
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-icalendar-use-plain-timestamp t
+ "Non-nil means make an event from every plain time stamp."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-honor-noexport-tag nil
+ "Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
+ "Contexts where iCalendar export should use a deadline time stamp.
+This is a list with several symbols in it. Valid symbol are:
+
+event-if-todo Deadlines in TODO entries become calendar events.
+event-if-not-todo Deadlines in non-TODO entries become calendar events.
+todo-due Use deadlines in TODO entries as due-dates"
+ :group 'org-export-icalendar
+ :type '(set :greedy t
+ (const :tag "Deadlines in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "Deadline in TODO entries become events"
+ event-if-todo)
+ (const :tag "Deadlines in TODO entries become due-dates"
+ todo-due)))
+
+(defcustom org-icalendar-use-scheduled '(todo-start)
+ "Contexts where iCalendar export should use a scheduling time stamp.
+This is a list with several symbols in it. Valid symbol are:
+
+event-if-todo Scheduling time stamps in TODO entries become an event.
+event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
+todo-start Scheduling time stamps in TODO entries become start date.
+ Some calendar applications show TODO entries only after
+ that date."
+ :group 'org-export-icalendar
+ :type '(set :greedy t
+ (const :tag
+ "SCHEDULED timestamps in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "SCHEDULED timestamps in TODO entries become events"
+ event-if-todo)
+ (const :tag "SCHEDULED in TODO entries become start date"
+ todo-start)))
+
+(defcustom org-icalendar-categories '(local-tags category)
+ "Items that should be entered into the categories field.
+This is a list of symbols, the following are valid:
+
+category The Org-mode category of the current file or tree
+todo-state The todo state, if any
+local-tags The tags, defined in the current line
+all-tags All tags, including inherited ones."
+ :group 'org-export-icalendar
+ :type '(repeat
+ (choice
+ (const :tag "The file or tree category" category)
+ (const :tag "The TODO state" todo-state)
+ (const :tag "Tags defined in current line" local-tags)
+ (const :tag "All tags, including inherited ones" all-tags))))
+
+(defcustom org-icalendar-include-todo nil
+ "Non-nil means export to iCalendar files should also cover TODO items.
+Valid values are:
+nil don't include any TODO items
+t include all TODO items that are not in a DONE state
+unblocked include all TODO items that are not blocked
+all include both done and not done items."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "None" nil)
+ (const :tag "Unfinished" t)
+ (const :tag "Unblocked" unblocked)
+ (const :tag "All" all)))
+
+(defvar org-icalendar-verify-function nil
+ "Function to verify entries for iCalendar export.
+This can be set to a function that will be called at each entry that
+is considered for export to iCalendar. When the function returns nil,
+the entry will be skipped. When it returns a non-nil value, the entry
+will be considered for export.
+This is used internally when an agenda buffer is exported to an ics file,
+to make sure that only entries currently listed in the agenda will end
+up in the ics file. But for normal iCalendar export, you can use this
+for whatever you need.")
+
+(defcustom org-icalendar-include-bbdb-anniversaries nil
+ "Non-nil means a combined iCalendar files should include anniversaries.
+The anniversaries are define in the BBDB database."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-include-sexps t
+ "Non-nil means export to iCalendar files should also cover sexp entries.
+These are entries like in the diary, but directly in an Org-mode file."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-include-body 100
+ "Amount of text below headline to be included in iCalendar export.
+This is a number of characters that should maximally be included.
+Properties, scheduling and clocking lines will always be removed.
+The text will be inserted into the DESCRIPTION field."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (const :tag "Everything" t)
+ (integer :tag "Max characters")))
+
+(defcustom org-icalendar-store-UID nil
+ "Non-nil means store any created UIDs in properties.
+The iCalendar standard requires that all entries have a unique identifier.
+Org will create these identifiers as needed. When this variable is non-nil,
+the created UIDs will be stored in the ID property of the entry. Then the
+next time this entry is exported, it will be exported with the same UID,
+superseding the previous form of it. This is essential for
+synchronization services.
+This variable is not turned on by default because we want to avoid creating
+a property drawer in every entry if people are only playing with this feature,
+or if they are only using it locally."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-timezone (getenv "TZ")
+ "The time zone string for iCalendar export.
+When nil or the empty string, use output from \(current-time-zone\)."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "Unspecified" nil)
+ (string :tag "Time zone")))
+
+;; Backward compatibility with previous variable
+(defvar org-icalendar-use-UTC-date-time nil)
+(defcustom org-icalendar-date-time-format
+ (if org-icalendar-use-UTC-date-time
+ ":%Y%m%dT%H%M%SZ"
+ ":%Y%m%dT%H%M%S")
+ "Format-string for exporting icalendar DATE-TIME.
+See `format-time-string' for a full documentation. The only
+difference is that `org-icalendar-timezone' is used for %Z.
+
+Interesting value are:
+ - \":%Y%m%dT%H%M%S\" for local time
+ - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
+ - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
+
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type '(choice
+ (const :tag "Local time" ":%Y%m%dT%H%M%S")
+ (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
+ (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
+ (string :tag "Explicit format")))
+
+(defun org-icalendar-use-UTC-date-timep ()
+ (char-equal (elt org-icalendar-date-time-format
+ (1- (length org-icalendar-date-time-format))) ?Z))
+
+;;; iCalendar export
+
+;;;###autoload
+(defun org-export-icalendar-this-file ()
+ "Export current file as an iCalendar file.
+The iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'."
+ (interactive)
+ (org-export-icalendar nil buffer-file-name))
+
+;;;###autoload
+(defun org-export-icalendar-all-agenda-files ()
+ "Export all files in the variable `org-agenda-files' to iCalendar .ics files.
+Each iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'."
+ (interactive)
+ (apply 'org-export-icalendar nil (org-agenda-files t)))
+
+;;;###autoload
+(defun org-export-icalendar-combine-agenda-files ()
+ "Export all files in `org-agenda-files' to a single combined iCalendar file.
+The file is stored under the name `org-combined-agenda-icalendar-file'."
+ (interactive)
+ (apply 'org-export-icalendar t (org-agenda-files t)))
+
+(defun org-export-icalendar (combine &rest files)
+ "Create iCalendar files for all elements of FILES.
+If COMBINE is non-nil, combine all calendar entries into a single large
+file and store it under the name `org-combined-agenda-icalendar-file'."
+ (save-excursion
+ (org-agenda-prepare-buffers files)
+ (let* ((dir (org-export-directory
+ :ical (list :publishing-directory
+ org-export-publishing-directory)))
+ file ical-file ical-buffer category started org-agenda-new-buffers)
+ (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
+ (when combine
+ (setq ical-file
+ (if (file-name-absolute-p org-combined-agenda-icalendar-file)
+ org-combined-agenda-icalendar-file
+ (expand-file-name org-combined-agenda-icalendar-file dir))
+ ical-buffer (org-get-agenda-file-buffer ical-file))
+ (set-buffer ical-buffer) (erase-buffer))
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (set-buffer (org-get-agenda-file-buffer file))
+ (unless combine
+ (setq ical-file (concat (file-name-as-directory dir)
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ ".ics"))
+ (setq ical-buffer (org-get-agenda-file-buffer ical-file))
+ (with-current-buffer ical-buffer (erase-buffer)))
+ (setq category (or org-category
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))))
+ (if (symbolp category) (setq category (symbol-name category)))
+ (let ((standard-output ical-buffer))
+ (if combine
+ (and (not started) (setq started t)
+ (org-icalendar-start-file org-icalendar-combined-name))
+ (org-icalendar-start-file category))
+ (org-icalendar-print-entries combine)
+ (when (or (and combine (not files)) (not combine))
+ (when (and combine org-icalendar-include-bbdb-anniversaries)
+ (require 'org-bbdb)
+ (org-bbdb-anniv-export-ical))
+ (org-icalendar-finish-file)
+ (set-buffer ical-buffer)
+ (run-hooks 'org-before-save-iCalendar-file-hook)
+ (save-buffer)
+ (run-hooks 'org-after-save-iCalendar-file-hook)
+ (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))))
+ (org-release-buffers org-agenda-new-buffers))))
+
+(defvar org-before-save-iCalendar-file-hook nil
+ "Hook run before an iCalendar file has been saved.
+This can be used to modify the result of the export.")
+
+(defvar org-after-save-iCalendar-file-hook nil
+ "Hook run after an iCalendar file has been saved.
+The iCalendar buffer is still current when this hook is run.
+A good way to use this is to tell a desktop calendar application to re-read
+the iCalendar file.")
+
+(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
+(defun org-icalendar-print-entries (&optional combine)
+ "Print iCalendar entries for the current Org-mode file to `standard-output'.
+When COMBINE is non nil, add the category to each line."
+ (require 'org-agenda)
+ (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
+ (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
+ (dts (org-icalendar-ts-to-string
+ (format-time-string (cdr org-time-stamp-formats) (current-time))
+ "DTSTART"))
+ hd ts ts2 state status (inc t) pos b sexp rrule
+ scheduledp deadlinep todo prefix due start tags
+ tmp pri categories location summary desc uid alarm alarm-time
+ (sexp-buffer (get-buffer-create "*ical-tmp*")))
+ (org-refresh-category-properties)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re1 nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (when org-icalendar-verify-function
+ (unless (save-match-data (funcall org-icalendar-verify-function))
+ (outline-next-heading)
+ (backward-char 1)
+ (throw :skip nil)))
+ (setq pos (match-beginning 0)
+ ts (match-string 0)
+ tags (org-get-tags-at)
+ inc t
+ hd (condition-case nil
+ (org-icalendar-cleanup-string
+ (org-get-heading t))
+ (error (throw :skip nil)))
+ summary (org-icalendar-cleanup-string
+ (org-entry-get nil "SUMMARY"))
+ desc (org-icalendar-cleanup-string
+ (or (org-entry-get nil "DESCRIPTION")
+ (and org-icalendar-include-body (org-get-entry)))
+ t org-icalendar-include-body)
+ location (org-icalendar-cleanup-string
+ (org-entry-get nil "LOCATION" 'selective))
+ uid (if org-icalendar-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new)))
+ categories (org-export-get-categories)
+ alarm-time (org-entry-get nil "APPT_WARNTIME")
+ alarm-time (if alarm-time (string-to-number alarm-time) 0)
+ alarm ""
+ deadlinep nil scheduledp nil)
+ (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos)
+ deadlinep (string-match org-deadline-regexp tmp)
+ scheduledp (string-match org-scheduled-regexp tmp)
+ todo (org-get-todo-state))
+ ;; donep (org-entry-is-done-p)
+ (if (looking-at re2)
+ (progn
+ (goto-char (match-end 0))
+ (setq ts2 (match-string 1)
+ inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
+ (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
+ (progn
+ (setq inc nil)
+ (replace-match "\\1" t nil ts))
+ ts)))
+ (when (and (not org-icalendar-use-plain-timestamp)
+ (not deadlinep) (not scheduledp))
+ (throw :skip t))
+ ;; don't export entries with a :noexport: tag
+ (when (and org-icalendar-honor-noexport-tag
+ (delq nil (mapcar (lambda(x)
+ (member x org-export-exclude-tags)) tags)))
+ (throw :skip t))
+ (when (and
+ deadlinep
+ (if todo
+ (not (memq 'event-if-todo org-icalendar-use-deadline))
+ (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
+ (throw :skip t))
+ (when (and
+ scheduledp
+ (if todo
+ (not (memq 'event-if-todo org-icalendar-use-scheduled))
+ (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
+ (throw :skip t))
+ (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
+ (if (or (string-match org-tr-regexp hd)
+ (string-match org-ts-regexp hd))
+ (setq hd (replace-match "" t t hd)))
+ (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts)
+ (setq rrule
+ (concat "\nRRULE:FREQ="
+ (cdr (assoc
+ (match-string 2 ts)
+ '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY")
+ ("m" . "MONTHLY")("y" . "YEARLY"))))
+ ";INTERVAL=" (match-string 1 ts)))
+ (setq rrule ""))
+ (setq summary (or summary hd))
+ ;; create an alarm entry if the entry is timed. this is not very general in that:
+ ;; (a) only one alarm per entry is defined,
+ ;; (b) only minutes are allowed for the trigger period ahead of the start time, and
+ ;; (c) only a DISPLAY action is defined.
+ ;; [ESF]
+ (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
+ (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
+ (car t1) (nth 1 t1) (nth 2 t1))
+ (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM"
+ summary (or alarm-time org-icalendar-alarm-time)))
+ (setq alarm "")))
+ (if (string-match org-bracket-link-regexp summary)
+ (setq summary
+ (replace-match (if (match-end 3)
+ (match-string 3 summary)
+ (match-string 1 summary))
+ t t summary)))
+ (if deadlinep (setq summary (concat "DL: " summary)))
+ (if scheduledp (setq summary (concat "S: " summary)))
+ (if (string-match "\\`<%%" ts)
+ (with-current-buffer sexp-buffer
+ (let ((entry (substring ts 1 -1)))
+ (put-text-property 0 1 'uid
+ (concat " " prefix uid) entry)
+ (insert entry " " summary "\n")))
+ (princ (format "BEGIN:VEVENT
+UID: %s
+%s
+%s%s
+SUMMARY:%s%s%s
+CATEGORIES:%s%s
+END:VEVENT\n"
+ (concat prefix uid)
+ (org-icalendar-ts-to-string ts "DTSTART")
+ (org-icalendar-ts-to-string ts2 "DTEND" inc)
+ rrule summary
+ (if (and desc (string-match "\\S-" desc))
+ (concat "\nDESCRIPTION: " desc) "")
+ (if (and location (string-match "\\S-" location))
+ (concat "\nLOCATION: " location) "")
+ categories
+ alarm)))))
+ (when (and org-icalendar-include-sexps
+ (condition-case nil (require 'icalendar) (error nil))
+ (fboundp 'icalendar-export-region))
+ ;; Get all the literal sexps
+ (goto-char (point-min))
+ (while (re-search-forward "^&?%%(" nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (when org-icalendar-verify-function
+ (unless (save-match-data (funcall org-icalendar-verify-function))
+ (outline-next-heading)
+ (backward-char 1)
+ (throw :skip nil)))
+ (setq b (match-beginning 0))
+ (goto-char (1- (match-end 0)))
+ (forward-sexp 1)
+ (end-of-line 1)
+ (setq sexp (buffer-substring b (point)))
+ (with-current-buffer sexp-buffer
+ (insert sexp "\n"))))
+ (princ (org-diary-to-ical-string sexp-buffer))
+ (kill-buffer sexp-buffer))
+
+ (when org-icalendar-include-todo
+ (setq prefix "TODO-")
+ (goto-char (point-min))
+ (while (re-search-forward org-complex-heading-regexp nil t)
+ (catch :skip
+ (org-agenda-skip)
+ (when org-icalendar-verify-function
+ (unless (save-match-data
+ (funcall org-icalendar-verify-function))
+ (outline-next-heading)
+ (backward-char 1)
+ (throw :skip nil)))
+ (setq state (match-string 2))
+ (setq status (if (member state org-done-keywords)
+ "COMPLETED" "NEEDS-ACTION"))
+ (when (and state
+ (cond
+ ;; check if the state is one we should use
+ ((eq org-icalendar-include-todo 'all)
+ ;; all should be included
+ t)
+ ((eq org-icalendar-include-todo 'unblocked)
+ ;; only undone entries that are not blocked
+ (and (member state org-not-done-keywords)
+ (or (not org-blocker-hook)
+ (save-match-data
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook
+ (list :type 'todo-state-change
+ :position (point-at-bol)
+ :from 'todo
+ :to 'done))))))
+ ((eq org-icalendar-include-todo t)
+ ;; include everything that is not done
+ (member state org-not-done-keywords))))
+ (setq hd (match-string 4)
+ summary (org-icalendar-cleanup-string
+ (org-entry-get nil "SUMMARY"))
+ desc (org-icalendar-cleanup-string
+ (or (org-entry-get nil "DESCRIPTION")
+ (and org-icalendar-include-body (org-get-entry)))
+ t org-icalendar-include-body)
+ location (org-icalendar-cleanup-string
+ (org-entry-get nil "LOCATION" 'selective))
+ due (and (member 'todo-due org-icalendar-use-deadline)
+ (org-entry-get nil "DEADLINE"))
+ start (and (member 'todo-start org-icalendar-use-scheduled)
+ (org-entry-get nil "SCHEDULED"))
+ categories (org-export-get-categories)
+ uid (if org-icalendar-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new))))
+ (and due (setq due (org-icalendar-ts-to-string due "DUE")))
+ (and start (setq start (org-icalendar-ts-to-string start "DTSTART")))
+
+ (if (string-match org-bracket-link-regexp hd)
+ (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
+ (match-string 1 hd))
+ t t hd)))
+ (if (string-match org-priority-regexp hd)
+ (setq pri (string-to-char (match-string 2 hd))
+ hd (concat (substring hd 0 (match-beginning 1))
+ (substring hd (match-end 1))))
+ (setq pri org-default-priority))
+ (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
+ (- org-lowest-priority org-highest-priority))))))
+
+ (princ (format "BEGIN:VTODO
+UID: %s
+%s
+SUMMARY:%s%s%s%s
+CATEGORIES:%s
+SEQUENCE:1
+PRIORITY:%d
+STATUS:%s
+END:VTODO\n"
+ (concat prefix uid)
+ (or start dts)
+ (or summary hd)
+ (if (and location (string-match "\\S-" location))
+ (concat "\nLOCATION: " location) "")
+ (if (and desc (string-match "\\S-" desc))
+ (concat "\nDESCRIPTION: " desc) "")
+ (if due (concat "\n" due) "")
+ categories
+ pri status)))))))))
+
+(defun org-export-get-categories ()
+ "Get categories according to `org-icalendar-categories'."
+ (let ((cs org-icalendar-categories) c rtn tmp)
+ (while (setq c (pop cs))
+ (cond
+ ((eq c 'category) (push (org-get-category) rtn))
+ ((eq c 'todo-state)
+ (setq tmp (org-get-todo-state))
+ (and tmp (push tmp rtn)))
+ ((eq c 'local-tags)
+ (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
+ ((eq c 'all-tags)
+ (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
+ (mapconcat 'identity (nreverse rtn) ",")))
+
+(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
+ "Take out stuff and quote what needs to be quoted.
+When IS-BODY is non-nil, assume that this is the body of an item, clean up
+whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
+characters."
+ (if (not s)
+ nil
+ (if is-body
+ (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+ (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+ (while (string-match re s) (setq s (replace-match "" t t s)))
+ (while (string-match re2 s) (setq s (replace-match "" t t s))))
+ (setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
+ (let ((start 0))
+ (while (string-match "\\([,;]\\)" s start)
+ (setq start (+ (match-beginning 0) 2)
+ s (replace-match "\\\\\\1" nil nil s))))
+ (setq s (org-trim s))
+ (when is-body
+ (while (string-match "[ \t]*\n[ \t]*" s)
+ (setq s (replace-match "\\n" t t s))))
+ (if is-body
+ (if maxlength
+ (if (and (numberp maxlength)
+ (> (length s) maxlength))
+ (setq s (substring s 0 maxlength)))))
+ s))
+
+(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
+ "Take out stuff and quote what needs to be quoted.
+When IS-BODY is non-nil, assume that this is the body of an item, clean up
+whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
+characters.
+This seems to be more like RFC 2455, but it causes problems, so it is
+not used right now."
+ (if (not s)
+ nil
+ (if is-body
+ (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
+ (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
+ (while (string-match re s) (setq s (replace-match "" t t s)))
+ (while (string-match re2 s) (setq s (replace-match "" t t s)))
+ (setq s (org-trim s))
+ (while (string-match "[ \t]*\n[ \t]*" s)
+ (setq s (replace-match "\\n" t t s)))
+ (if maxlength
+ (if (and (numberp maxlength)
+ (> (length s) maxlength))
+ (setq s (substring s 0 maxlength)))))
+ (setq s (org-trim s)))
+ (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
+ (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
+ s))
+
+(defun org-icalendar-start-file (name)
+ "Start an iCalendar file by inserting the header."
+ (let ((user user-full-name)
+ (name (or name "unknown"))
+ (timezone (if (> (length org-icalendar-timezone) 0)
+ org-icalendar-timezone
+ (cadr (current-time-zone))))
+ (description org-icalendar-combined-description))
+ (princ
+ (format "BEGIN:VCALENDAR
+VERSION:2.0
+X-WR-CALNAME:%s
+PRODID:-//%s//Emacs with Org-mode//EN
+X-WR-TIMEZONE:%s
+X-WR-CALDESC:%s
+CALSCALE:GREGORIAN\n" name user timezone description))))
+
+(defun org-icalendar-finish-file ()
+ "Finish an iCalendar file by inserting the END statement."
+ (princ "END:VCALENDAR\n"))
+
+(defun org-icalendar-ts-to-string (s keyword &optional inc)
+ "Take a time string S and convert it to iCalendar format.
+KEYWORD is added in front, to make a complete line like DTSTART....
+When INC is non-nil, increase the hour by two (if time string contains
+a time), or the day by one (if it does not contain a time)."
+ (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault)))
+ t2 fmt have-time time)
+ (if (not t1)
+ ""
+ (if (and (car t1) (nth 1 t1) (nth 2 t1))
+ (setq t2 t1 have-time t)
+ (setq t2 (org-parse-time-string s)))
+ (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
+ (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
+ (when inc
+ (if have-time
+ (if org-agenda-default-appointment-duration
+ (setq mi (+ org-agenda-default-appointment-duration mi))
+ (setq h (+ 2 h)))
+ (setq d (1+ d))))
+ (setq time (encode-time s mi h d m y)))
+ (setq fmt (if have-time
+ (replace-regexp-in-string "%Z"
+ org-icalendar-timezone
+ org-icalendar-date-time-format)
+ ";VALUE=DATE:%Y%m%d"))
+ (concat keyword (format-time-string fmt time
+ (and (org-icalendar-use-UTC-date-timep)
+ have-time))))))
+
+(provide 'org-icalendar)
+
+;;; org-icalendar.el ends here
diff --git a/lisp/org-id.el b/lisp/org-id.el
new file mode 100644
index 0000000..c156e24
--- /dev/null
+++ b/lisp/org-id.el
@@ -0,0 +1,684 @@
+;;; org-id.el --- Global identifiers for Org-mode entries
+;;
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements globally unique identifiers for Org-mode entries.
+;; Identifiers are stored in the entry as an :ID: property. Functions
+;; are provided that create and retrieve such identifiers, and that find
+;; entries based on the identifier.
+
+;; Identifiers consist of a prefix (default "Org" given by the variable
+;; `org-id-prefix') and a unique part that can be created by a number
+;; of different methods, see the variable `org-id-method'.
+;; Org has a builtin method that uses a compact encoding of the creation
+;; time of the ID, with microsecond accuracy. This virtually
+;; guarantees globally unique identifiers, even if several people are
+;; creating IDs at the same time in files that will eventually be used
+;; together.
+;;
+;; By default Org uses UUIDs as global unique identifiers.
+;;
+;; This file defines the following API:
+;;
+;; org-id-get-create
+;; Create an ID for the entry at point if it does not yet have one.
+;; Returns the ID (old or new). This function can be used
+;; interactively, with prefix argument the creation of a new ID is
+;; forced, even if there was an old one.
+;;
+;; org-id-get
+;; Get the ID property of an entry. Using appropriate arguments
+;; to the function, it can also create the ID for this entry.
+;;
+;; org-id-goto
+;; Command to go to a specific ID, this command can be used
+;; interactively.
+;;
+;; org-id-get-with-outline-path-completion
+;; Retrieve the ID of an entry, using outline path completion.
+;; This function can work for multiple files.
+;;
+;; org-id-get-with-outline-drilling
+;; Retrieve the ID of an entry, using outline path completion.
+;; This function only works for the current file.
+;;
+;; org-id-find
+;; Find the location of an entry with specific id.
+;;
+
+;;; Code:
+
+(require 'org)
+
+(declare-function message-make-fqdn "message" ())
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+;;; Customization
+
+(defgroup org-id nil
+ "Options concerning global entry identifiers in Org-mode."
+ :tag "Org ID"
+ :group 'org)
+
+(define-obsolete-variable-alias
+ 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
+(defcustom org-id-link-to-org-use-id nil
+ "Non-nil means storing a link to an Org file will use entry IDs.
+
+The variable can have the following values:
+
+t Create an ID if needed to make a link to the current entry.
+
+create-if-interactive
+ If `org-store-link' is called directly (interactively, as a user
+ command), do create an ID to support the link. But when doing the
+ job for capture, only use the ID if it already exists. The
+ purpose of this setting is to avoid proliferation of unwanted
+ IDs, just because you happen to be in an Org file when you
+ call `org-capture' that automatically and preemptively creates a
+ link. If you do want to get an ID link in a capture template to
+ an entry not having an ID, create it first by explicitly creating
+ a link to it, using `C-c C-l' first.
+
+create-if-interactive-and-no-custom-id
+ Like create-if-interactive, but do not create an ID if there is
+ a CUSTOM_ID property defined in the entry.
+
+use-existing
+ Use existing ID, do not create one.
+
+nil Never use an ID to make a link, instead link using a text search for
+ the headline text."
+ :group 'org-link-store
+ :group 'org-id
+ :version "24.3"
+ :type '(choice
+ (const :tag "Create ID to make link" t)
+ (const :tag "Create if storing link interactively"
+ create-if-interactive)
+ (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
+ create-if-interactive-and-no-custom-id)
+ (const :tag "Only use existing" use-existing)
+ (const :tag "Do not use ID to create link" nil)))
+
+(defcustom org-id-uuid-program "uuidgen"
+ "The uuidgen program."
+ :group 'org-id
+ :type 'string)
+
+(defcustom org-id-method 'uuid
+ "The method that should be used to create new IDs.
+
+An ID will consist of the optional prefix specified in `org-id-prefix',
+and a unique part created by the method this variable specifies.
+
+Allowed values are:
+
+org Org's own internal method, using an encoding of the current time to
+ microsecond accuracy, and optionally the current domain of the
+ computer. See the variable `org-id-include-domain'.
+
+uuid Create random (version 4) UUIDs. If the program defined in
+ `org-id-uuid-program' is available it is used to create the ID.
+ Otherwise an internal functions is used."
+ :group 'org-id
+ :type '(choice
+ (const :tag "Org's internal method" org)
+ (const :tag "external: uuidgen" uuid)))
+
+(defcustom org-id-prefix nil
+ "The prefix for IDs.
+
+This may be a string, or it can be nil to indicate that no prefix is required.
+When a string, the string should have no space characters as IDs are expected
+to have no space characters in them."
+ :group 'org-id
+ :type '(choice
+ (const :tag "No prefix")
+ (string :tag "Prefix")))
+
+(defcustom org-id-include-domain nil
+ "Non-nil means add the domain name to new IDs.
+This ensures global uniqueness of IDs, and is also suggested by
+RFC 2445 in combination with RFC 822. This is only relevant if
+`org-id-method' is `org'. When uuidgen is used, the domain will never
+be added.
+The default is to not use this because we have no really good way to get
+the true domain, and Org entries will normally not be shared with enough
+people to make this necessary."
+ :group 'org-id
+ :type 'boolean)
+
+(defcustom org-id-track-globally t
+ "Non-nil means track IDs through files, so that links work globally.
+This work by maintaining a hash table for IDs and writing this table
+to disk when exiting Emacs. Because of this, it works best if you use
+a single Emacs process, not many.
+
+When nil, IDs are not tracked. Links to IDs will still work within
+a buffer, but not if the entry is located in another file.
+IDs can still be used if the entry with the id is in the same file as
+the link."
+ :group 'org-id
+ :type 'boolean)
+
+(defcustom org-id-locations-file (convert-standard-filename
+ "~/.emacs.d/.org-id-locations")
+ "The file for remembering in which file an ID was defined.
+This variable is only relevant when `org-id-track-globally' is set."
+ :group 'org-id
+ :type 'file)
+
+(defvar org-id-locations nil
+ "List of files with IDs in those files.")
+
+(defvar org-id-files nil
+ "List of files that contain IDs.")
+
+(defcustom org-id-extra-files 'org-agenda-text-search-extra-files
+ "Files to be searched for IDs, besides the agenda files.
+When Org reparses files to remake the list of files and IDs it is tracking,
+it will normally scan the agenda files, the archives related to agenda files,
+any files that are listed as ID containing in the current register, and
+any Org-mode files currently visited by Emacs.
+You can list additional files here.
+This variable is only relevant when `org-id-track-globally' is set."
+ :group 'org-id
+ :type
+ '(choice
+ (symbol :tag "Variable")
+ (repeat :tag "List of files"
+ (file))))
+
+(defcustom org-id-search-archives t
+ "Non-nil means search also the archive files of agenda files for entries.
+This is a possibility to reduce overhead, but it means that entries moved
+to the archives can no longer be found by ID.
+This variable is only relevant when `org-id-track-globally' is set."
+ :group 'org-id
+ :type 'boolean)
+
+;;; The API functions
+
+;;;###autoload
+(defun org-id-get-create (&optional force)
+ "Create an ID for the current entry and return it.
+If the entry already has an ID, just return it.
+With optional argument FORCE, force the creation of a new ID."
+ (interactive "P")
+ (when force
+ (org-entry-put (point) "ID" nil))
+ (org-id-get (point) 'create))
+
+;;;###autoload
+(defun org-id-copy ()
+ "Copy the ID of the entry at point to the kill ring.
+Create an ID if necessary."
+ (interactive)
+ (org-kill-new (org-id-get nil 'create)))
+
+;;;###autoload
+(defun org-id-get (&optional pom create prefix)
+ "Get the ID property of the entry at point-or-marker POM.
+If POM is nil, refer to the entry at point.
+If the entry does not have an ID, the function returns nil.
+However, when CREATE is non nil, create an ID if none is present already.
+PREFIX will be passed through to `org-id-new'.
+In any case, the ID of the entry is returned."
+ (org-with-point-at pom
+ (let ((id (org-entry-get nil "ID")))
+ (cond
+ ((and id (stringp id) (string-match "\\S-" id))
+ id)
+ (create
+ (setq id (org-id-new prefix))
+ (org-entry-put pom "ID" id)
+ (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
+ id)))))
+
+;;;###autoload
+(defun org-id-get-with-outline-path-completion (&optional targets)
+ "Use outline-path-completion to retrieve the ID of an entry.
+TARGETS may be a setting for `org-refile-targets' to define the eligible
+headlines. When omitted, all headlines in all agenda files are
+eligible.
+It returns the ID of the entry. If necessary, the ID is created."
+ (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
+ (org-refile-use-outline-path
+ (if (caar org-refile-targets) 'file t))
+ (org-refile-target-verify-function nil)
+ (spos (org-refile-get-location "Entry"))
+ (pom (and spos (move-marker (make-marker) (nth 3 spos)
+ (get-file-buffer (nth 1 spos))))))
+ (prog1 (org-id-get pom 'create)
+ (move-marker pom nil))))
+
+;;;###autoload
+(defun org-id-get-with-outline-drilling (&optional targets)
+ "Use an outline-cycling interface to retrieve the ID of an entry.
+This only finds entries in the current buffer, using `org-get-location'.
+It returns the ID of the entry. If necessary, the ID is created."
+ (let* ((spos (org-get-location (current-buffer) org-goto-help))
+ (pom (and spos (move-marker (make-marker) (car spos)))))
+ (prog1 (org-id-get pom 'create)
+ (move-marker pom nil))))
+
+;;;###autoload
+(defun org-id-goto (id)
+ "Switch to the buffer containing the entry with id ID.
+Move the cursor to that entry in that buffer."
+ (interactive "sID: ")
+ (let ((m (org-id-find id 'marker)))
+ (unless m
+ (error "Cannot find entry with ID \"%s\"" id))
+ (org-pop-to-buffer-same-window (marker-buffer m))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)))
+
+;;;###autoload
+(defun org-id-find (id &optional markerp)
+ "Return the location of the entry with the id ID.
+The return value is a cons cell (file-name . position), or nil
+if there is no entry with that ID.
+With optional argument MARKERP, return the position as a new marker."
+ (cond
+ ((symbolp id) (setq id (symbol-name id)))
+ ((numberp id) (setq id (number-to-string id))))
+ (let ((file (org-id-find-id-file id))
+ org-agenda-new-buffers where)
+ (when file
+ (setq where (org-id-find-id-in-file id file markerp)))
+ (unless where
+ (org-id-update-id-locations nil t)
+ (setq file (org-id-find-id-file id))
+ (when file
+ (setq where (org-id-find-id-in-file id file markerp))))
+ where))
+
+;;; Internal functions
+
+;; Creating new IDs
+
+(defun org-id-new (&optional prefix)
+ "Create a new globally unique ID.
+
+An ID consists of two parts separated by a colon:
+- a prefix
+- a unique part that will be created according to `org-id-method'.
+
+PREFIX can specify the prefix, the default is given by the variable
+`org-id-prefix'. However, if PREFIX is the symbol `none', don't use any
+prefix even if `org-id-prefix' specifies one.
+
+So a typical ID could look like \"Org:4nd91V40HI\"."
+ (let* ((prefix (if (eq prefix 'none)
+ ""
+ (concat (or prefix org-id-prefix) ":")))
+ unique)
+ (if (equal prefix ":") (setq prefix ""))
+ (cond
+ ((memq org-id-method '(uuidgen uuid))
+ (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))
+ (unless (org-uuidgen-p unique)
+ (setq unique (org-id-uuid))))
+ ((eq org-id-method 'org)
+ (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
+ (postfix (if org-id-include-domain
+ (progn
+ (require 'message)
+ (concat "@" (message-make-fqdn))))))
+ (setq unique (concat etime postfix))))
+ (t (error "Invalid `org-id-method'")))
+ (concat prefix unique)))
+
+(defun org-id-uuid ()
+ "Return string with random (version 4) UUID."
+ (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+ (random)
+ (current-time)
+ (user-uid)
+ (emacs-pid)
+ (user-full-name)
+ user-mail-address
+ (recent-keys)))))
+ (format "%s-%s-4%s-%s%s-%s"
+ (substring rnd 0 8)
+ (substring rnd 8 12)
+ (substring rnd 13 16)
+ (format "%x"
+ (logior
+ #b10000000
+ (logand
+ #b10111111
+ (string-to-number
+ (substring rnd 16 18) 16))))
+ (substring rnd 18 20)
+ (substring rnd 20 32))))
+
+(defun org-id-reverse-string (s)
+ (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
+
+(defun org-id-int-to-b36-one-digit (i)
+ "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z."
+ (cond
+ ((< i 10) (+ ?0 i))
+ ((< i 36) (+ ?a i -10))
+ (t (error "Larger that 35"))))
+
+(defun org-id-b36-to-int-one-digit (i)
+ "Turn a character 0..9, A..Z, a..z into a number 0..61.
+The input I may be a character, or a single-letter string."
+ (and (stringp i) (setq i (string-to-char i)))
+ (cond
+ ((and (>= i ?0) (<= i ?9)) (- i ?0))
+ ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10))
+ (t (error "Invalid b36 letter"))))
+
+(defun org-id-int-to-b36 (i &optional length)
+ "Convert an integer to a base-36 number represented as a string."
+ (let ((s ""))
+ (while (> i 0)
+ (setq s (concat (char-to-string
+ (org-id-int-to-b36-one-digit (mod i 36))) s)
+ i (/ i 36)))
+ (setq length (max 1 (or length 1)))
+ (if (< (length s) length)
+ (setq s (concat (make-string (- length (length s)) ?0) s)))
+ s))
+
+(defun org-id-b36-to-int (s)
+ "Convert a base-36 string into the corresponding integer."
+ (let ((r 0))
+ (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i))))
+ s)
+ r))
+
+(defun org-id-time-to-b36 (&optional time)
+ "Encode TIME as a 10-digit string.
+This string holds the time to micro-second accuracy, and can be decoded
+using `org-id-decode'."
+ (setq time (or time (current-time)))
+ (concat (org-id-int-to-b36 (nth 0 time) 4)
+ (org-id-int-to-b36 (nth 1 time) 4)
+ (org-id-int-to-b36 (or (nth 2 time) 0) 4)))
+
+(defun org-id-decode (id)
+ "Split ID into the prefix and the time value that was used to create it.
+The return value is (prefix . time) where PREFIX is nil or a string,
+and time is the usual three-integer representation of time."
+ (let (prefix time parts)
+ (setq parts (org-split-string id ":"))
+ (if (= 2 (length parts))
+ (setq prefix (car parts) time (nth 1 parts))
+ (setq prefix nil time (nth 0 parts)))
+ (setq time (org-id-reverse-string time))
+ (setq time (list (org-id-b36-to-int (substring time 0 4))
+ (org-id-b36-to-int (substring time 4 8))
+ (org-id-b36-to-int (substring time 8 12))))
+ (cons prefix time)))
+
+;; Storing ID locations (files)
+
+(defun org-id-update-id-locations (&optional files silent)
+ "Scan relevant files for IDs.
+Store the relation between files and corresponding IDs.
+This will scan all agenda files, all associated archives, and all
+files currently mentioned in `org-id-locations'.
+When FILES is given, scan these files instead.
+When CHECK is given, prepare detailed information about duplicate IDs."
+ (interactive)
+ (if (not org-id-track-globally)
+ (error "Please turn on `org-id-track-globally' if you want to track IDs")
+ (let* ((org-id-search-archives
+ (or org-id-search-archives
+ (and (symbolp org-id-extra-files)
+ (symbol-value org-id-extra-files)
+ (member 'agenda-archives org-id-extra-files))))
+ (files
+ (or files
+ (append
+ ;; Agenda files and all associated archives
+ (org-agenda-files t org-id-search-archives)
+ ;; Explicit extra files
+ (if (symbolp org-id-extra-files)
+ (symbol-value org-id-extra-files)
+ org-id-extra-files)
+ ;; Files associated with live org-mode buffers
+ (delq nil
+ (mapcar (lambda (b)
+ (with-current-buffer b
+ (and (derived-mode-p 'org-mode) (buffer-file-name))))
+ (buffer-list)))
+ ;; All files known to have IDs
+ org-id-files)))
+ org-agenda-new-buffers
+ file nfiles tfile ids reg found id seen (ndup 0))
+ (when (member 'agenda-archives files)
+ (setq files (delq 'agenda-archives (copy-sequence files))))
+ (setq nfiles (length files))
+ (while (setq file (pop files))
+ (unless silent
+ (message "Finding ID locations (%d/%d files): %s"
+ (- nfiles (length files)) nfiles file))
+ (setq tfile (file-truename file))
+ (when (and (file-exists-p file) (not (member tfile seen)))
+ (push tfile seen)
+ (setq ids nil)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
+ nil t)
+ (setq id (org-match-string-no-properties 1))
+ (if (member id found)
+ (progn
+ (message "Duplicate ID \"%s\", also in file %s"
+ id (or (car (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (if (member id (cdr x))
+ (car x)))
+ reg)))
+ (buffer-file-name)))
+ (when (= ndup 0)
+ (ding)
+ (sit-for 2))
+ (setq ndup (1+ ndup)))
+ (push id found)
+ (push id ids)))
+ (push (cons (abbreviate-file-name file) ids) reg))))))
+ (org-release-buffers org-agenda-new-buffers)
+ (setq org-agenda-new-buffers nil)
+ (setq org-id-locations reg)
+ (setq org-id-files (mapcar 'car org-id-locations))
+ (org-id-locations-save) ;; this function can also handle the alist form
+ ;; now convert to a hash
+ (setq org-id-locations (org-id-alist-to-hash org-id-locations))
+ (if (> ndup 0)
+ (message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)
+ (message "%d unique files scanned for IDs" (length org-id-files)))
+ org-id-locations)))
+
+(defun org-id-locations-save ()
+ "Save `org-id-locations' in `org-id-locations-file'."
+ (when (and org-id-track-globally org-id-locations)
+ (let ((out (if (hash-table-p org-id-locations)
+ (org-id-hash-to-alist org-id-locations)
+ org-id-locations)))
+ (with-temp-file org-id-locations-file
+ (print out (current-buffer))))))
+
+(defun org-id-locations-load ()
+ "Read the data from `org-id-locations-file'."
+ (setq org-id-locations nil)
+ (when org-id-track-globally
+ (with-temp-buffer
+ (condition-case nil
+ (progn
+ (insert-file-contents-literally org-id-locations-file)
+ (goto-char (point-min))
+ (setq org-id-locations (read (current-buffer))))
+ (error
+ (message "Could not read org-id-values from %s. Setting it to nil."
+ org-id-locations-file))))
+ (setq org-id-files (mapcar 'car org-id-locations))
+ (setq org-id-locations (org-id-alist-to-hash org-id-locations))))
+
+(defun org-id-add-location (id file)
+ "Add the ID with location FILE to the database of ID locations."
+ ;; Only if global tracking is on, and when the buffer has a file
+ (when (and org-id-track-globally id file)
+ (unless org-id-locations (org-id-locations-load))
+ (puthash id (abbreviate-file-name file) org-id-locations)
+ (add-to-list 'org-id-files (abbreviate-file-name file))))
+
+(unless noninteractive
+ (add-hook 'kill-emacs-hook 'org-id-locations-save))
+
+(defun org-id-hash-to-alist (hash)
+ "Turn an org-id hash into an alist, so that it can be written to a file."
+ (let (res x)
+ (maphash
+ (lambda (k v)
+ (if (setq x (member v res))
+ (setcdr x (cons k (cdr x)))
+ (push (list v k) res)))
+ hash)
+ res))
+
+(defun org-id-alist-to-hash (list)
+ "Turn an org-id location list into a hash table."
+ (let ((res (make-hash-table
+ :test 'equal
+ :size (apply '+ (mapcar 'length list))))
+ f)
+ (mapc
+ (lambda (x)
+ (setq f (car x))
+ (mapc (lambda (i) (puthash i f res)) (cdr x)))
+ list)
+ res))
+
+(defun org-id-paste-tracker (txt &optional buffer-or-file)
+ "Update any IDs in TXT and assign BUFFER-OR-FILE to them."
+ (when org-id-track-globally
+ (save-match-data
+ (setq buffer-or-file (or buffer-or-file (current-buffer)))
+ (when (bufferp buffer-or-file)
+ (setq buffer-or-file (or (buffer-base-buffer buffer-or-file)
+ buffer-or-file))
+ (setq buffer-or-file (buffer-file-name buffer-or-file)))
+ (when buffer-or-file
+ (let ((fname (abbreviate-file-name buffer-or-file))
+ (s 0))
+ (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s)
+ (setq s (match-end 0))
+ (org-id-add-location (match-string 1 txt) fname)))))))
+
+;; Finding entries with specified id
+
+;;;###autoload
+(defun org-id-find-id-file (id)
+ "Query the id database for the file in which this ID is located."
+ (unless org-id-locations (org-id-locations-load))
+ (or (and org-id-locations
+ (hash-table-p org-id-locations)
+ (gethash id org-id-locations))
+ ;; ball back on current buffer
+ (buffer-file-name (or (buffer-base-buffer (current-buffer))
+ (current-buffer)))))
+
+(defun org-id-find-id-in-file (id file &optional markerp)
+ "Return the position of the entry ID in FILE.
+If that files does not exist, or if it does not contain this ID,
+return nil.
+The position is returned as a cons cell (file-name . position). With
+optional argument MARKERP, return the position as a new marker."
+ (let (org-agenda-new-buffers buf pos)
+ (cond
+ ((not file) nil)
+ ((not (file-exists-p file)) nil)
+ (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file))
+ (setq pos (org-find-entry-with-id id))
+ (when pos
+ (if markerp
+ (move-marker (make-marker) pos buf)
+ (cons file pos))))))))
+
+;; id link type
+
+;; Calling the following function is hard-coded into `org-store-link',
+;; so we do have to add it to `org-store-link-functions'.
+
+;;;###autoload
+(defun org-id-store-link ()
+ "Store a link to the current entry, using its ID."
+ (interactive)
+ (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (let* ((link (concat "id:" (org-id-get-create)))
+ (case-fold-search nil)
+ (desc (save-excursion
+ (org-back-to-heading t)
+ (or (and (looking-at org-complex-heading-regexp)
+ (if (match-end 4)
+ (match-string 4)
+ (match-string 0)))
+ link))))
+ (org-store-link-props :link link :description desc :type "id")
+ link)))
+
+(defun org-id-open (id)
+ "Go to the entry with id ID."
+ (org-mark-ring-push)
+ (let ((m (org-id-find id 'marker))
+ cmd)
+ (unless m
+ (error "Cannot find entry with ID \"%s\"" id))
+ ;; Use a buffer-switching command in analogy to finding files
+ (setq cmd
+ (or
+ (cdr
+ (assq
+ (cdr (assq 'file org-link-frame-setup))
+ '((find-file . switch-to-buffer)
+ (find-file-other-window . switch-to-buffer-other-window)
+ (find-file-other-frame . switch-to-buffer-other-frame))))
+ 'switch-to-buffer-other-window))
+ (if (not (equal (current-buffer) (marker-buffer m)))
+ (funcall cmd (marker-buffer m)))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)))
+
+(org-add-link-type "id" 'org-id-open)
+
+(provide 'org-id)
+
+;;; org-id.el ends here
diff --git a/lisp/org-indent.el b/lisp/org-indent.el
new file mode 100644
index 0000000..d006df8
--- /dev/null
+++ b/lisp/org-indent.el
@@ -0,0 +1,434 @@
+;;; org-indent.el --- Dynamic indentation for Org-mode
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This is an implementation of dynamic virtual indentation. It works
+;; by adding text properties to a buffer to make sure lines are
+;; indented according to outline structure.
+;;
+;; The process is synchronous, toggled at every buffer modification.
+;; Though, the initialization (indentation of text already in the
+;; buffer), which can take a few seconds in large buffers, happens on
+;; idle time.
+;;
+;;; Code:
+
+(require 'org-macs)
+(require 'org-compat)
+(require 'org)
+
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-list-item-body-column "org-list" (item))
+(defvar org-inlinetask-show-first-star)
+
+(defgroup org-indent nil
+ "Options concerning dynamic virtual outline indentation."
+ :tag "Org Indent"
+ :group 'org)
+
+(defconst org-indent-max 40
+ "Maximum indentation in characters.")
+(defconst org-indent-max-levels 20
+ "Maximum added level through virtual indentation, in characters.
+
+It is computed by multiplying `org-indent-indentation-per-level'
+minus one by actual level of the headline minus one.")
+
+(defvar org-indent-strings nil
+ "Vector with all indentation strings.
+It will be set in `org-indent-initialize'.")
+(defvar org-indent-stars nil
+ "Vector with all indentation star strings.
+It will be set in `org-indent-initialize'.")
+(defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning))
+ "First star of inline tasks, with correct face.")
+(defvar org-indent-agent-timer nil
+ "Timer running the initialize agent.")
+(defvar org-indent-agentized-buffers nil
+ "List of buffers watched by the initialize agent.")
+(defvar org-indent-agent-resume-timer nil
+ "Timer to reschedule agent after switching to other idle processes.")
+(defvar org-indent-agent-active-delay '(0 2 0)
+ "Time to run agent before switching to other idle processes.
+Delay used when the buffer to initialize is current.")
+(defvar org-indent-agent-passive-delay '(0 0 400000)
+ "Time to run agent before switching to other idle processes.
+Delay used when the buffer to initialize isn't current.")
+(defvar org-indent-agent-resume-delay '(0 0 100000)
+ "Minimal time for other idle processes before switching back to agent.")
+(defvar org-indent-initial-marker nil
+ "Position of initialization before interrupt.
+This is used locally in each buffer being initialized.")
+(defvar org-hide-leading-stars-before-indent-mode nil
+ "Used locally.")
+(defvar org-indent-modified-headline-flag nil
+ "Non-nil means the last deletion operated on an headline.
+It is modified by `org-indent-notify-modified-headline'.")
+
+
+(defcustom org-indent-boundary-char ?\ ; comment to protect space char
+ "The end of the virtual indentation strings, a single-character string.
+The default is just a space, but if you wish, you can use \"|\" or so.
+This can be useful on a terminal window - under a windowing system,
+it may be prettier to customize the org-indent face."
+ :group 'org-indent
+ :set (lambda (var val)
+ (set var val)
+ (and org-indent-strings (org-indent-initialize)))
+ :type 'character)
+
+(defcustom org-indent-mode-turns-off-org-adapt-indentation t
+ "Non-nil means setting the variable `org-indent-mode' will \
+turn off indentation adaptation.
+For details see the variable `org-adapt-indentation'."
+ :group 'org-indent
+ :type 'boolean)
+
+(defcustom org-indent-mode-turns-on-hiding-stars t
+ "Non-nil means setting the variable `org-indent-mode' will \
+turn on `org-hide-leading-stars'."
+ :group 'org-indent
+ :type 'boolean)
+
+(defcustom org-indent-indentation-per-level 2
+ "Indentation per level in number of characters."
+ :group 'org-indent
+ :type 'integer)
+
+(defface org-indent
+ (org-compatible-face nil nil)
+ "Face for outline indentation.
+The default is to make it look like whitespace. But you may find it
+useful to make it ever so slightly different."
+ :group 'org-faces)
+
+(defun org-indent-initialize ()
+ "Initialize the indentation strings."
+ (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
+ (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
+ (aset org-indent-strings 0 nil)
+ (aset org-indent-stars 0 nil)
+ (loop for i from 1 to org-indent-max do
+ (aset org-indent-strings i
+ (org-add-props
+ (concat (make-string (1- i) ?\ )
+ (char-to-string org-indent-boundary-char))
+ nil 'face 'org-indent)))
+ (loop for i from 1 to org-indent-max-levels do
+ (aset org-indent-stars i
+ (org-add-props (make-string i ?*)
+ nil 'face 'org-hide))))
+
+(defsubst org-indent-remove-properties (beg end)
+ "Remove indentations between BEG and END."
+ (with-silent-modifications
+ (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
+
+;;;###autoload
+(define-minor-mode org-indent-mode
+ "When active, indent text according to outline structure.
+
+Internally this works by adding `line-prefix' and `wrap-prefix'
+properties, after each buffer modification, on the modified zone.
+
+The process is synchronous. Though, initial indentation of
+buffer, which can take a few seconds on large buffers, is done
+during idle time." nil " Ind" nil
+(cond
+ ((org-bound-and-true-p org-inhibit-startup)
+ (setq org-indent-mode nil))
+ ((and org-indent-mode (featurep 'xemacs))
+ (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
+ (setq org-indent-mode nil))
+ ((and org-indent-mode
+ (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
+ (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
+ (ding)
+ (sit-for 1)
+ (setq org-indent-mode nil))
+ (org-indent-mode
+ ;; mode was turned on.
+ (org-set-local 'indent-tabs-mode nil)
+ (or org-indent-strings (org-indent-initialize))
+ (org-set-local 'org-indent-initial-marker (copy-marker 1))
+ (when org-indent-mode-turns-off-org-adapt-indentation
+ (org-set-local 'org-adapt-indentation nil))
+ (when org-indent-mode-turns-on-hiding-stars
+ (org-set-local 'org-hide-leading-stars-before-indent-mode
+ org-hide-leading-stars)
+ (org-set-local 'org-hide-leading-stars t))
+ (make-local-variable 'filter-buffer-substring-functions)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete))))
+ (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
+ (org-add-hook 'before-change-functions
+ 'org-indent-notify-modified-headline nil 'local)
+ (and font-lock-mode (org-restart-font-lock))
+ (org-indent-remove-properties (point-min) (point-max))
+ ;; Submit current buffer to initialize agent. If it's the first
+ ;; buffer submitted, also start the agent. Current buffer is
+ ;; pushed in both cases to avoid a race condition.
+ (if org-indent-agentized-buffers
+ (push (current-buffer) org-indent-agentized-buffers)
+ (push (current-buffer) org-indent-agentized-buffers)
+ (setq org-indent-agent-timer
+ (run-with-idle-timer 0.2 t #'org-indent-initialize-agent))))
+ (t
+ ;; mode was turned off (or we refused to turn it on)
+ (kill-local-variable 'org-adapt-indentation)
+ (setq org-indent-agentized-buffers
+ (delq (current-buffer) org-indent-agentized-buffers))
+ (when (markerp org-indent-initial-marker)
+ (set-marker org-indent-initial-marker nil))
+ (when (boundp 'org-hide-leading-stars-before-indent-mode)
+ (org-set-local 'org-hide-leading-stars
+ org-hide-leading-stars-before-indent-mode))
+ (remove-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete))))
+ (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
+ (remove-hook 'before-change-functions
+ 'org-indent-notify-modified-headline 'local)
+ (org-with-wide-buffer
+ (org-indent-remove-properties (point-min) (point-max)))
+ (and font-lock-mode (org-restart-font-lock))
+ (redraw-display))))
+
+(defun org-indent-indent-buffer ()
+ "Add indentation properties to the accessible part of the buffer."
+ (interactive)
+ (if (not (derived-mode-p 'org-mode))
+ (error "Not in Org mode")
+ (message "Setting buffer indentation. It may take a few seconds...")
+ (org-indent-remove-properties (point-min) (point-max))
+ (org-indent-add-properties (point-min) (point-max))
+ (message "Indentation of buffer set.")))
+
+(defun org-indent-remove-properties-from-string (string)
+ "Remove indentation properties from STRING."
+ (remove-text-properties 0 (length string)
+ '(line-prefix nil wrap-prefix nil) string)
+ string)
+
+(defun org-indent-initialize-agent ()
+ "Start or resume current buffer initialization.
+Only buffers in `org-indent-agentized-buffers' trigger an action.
+When no more buffer is being watched, the agent suppress itself."
+ (when org-indent-agent-resume-timer
+ (cancel-timer org-indent-agent-resume-timer))
+ (setq org-indent-agentized-buffers
+ (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
+ (cond
+ ;; Job done: kill agent.
+ ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer))
+ ;; Current buffer is agentized: start/resume initialization
+ ;; somewhat aggressively.
+ ((memq (current-buffer) org-indent-agentized-buffers)
+ (org-indent-initialize-buffer (current-buffer)
+ org-indent-agent-active-delay))
+ ;; Else, start/resume initialization of the last agentized buffer,
+ ;; softly.
+ (t (org-indent-initialize-buffer (car org-indent-agentized-buffers)
+ org-indent-agent-passive-delay))))
+
+(defun org-indent-initialize-buffer (buffer delay)
+ "Set virtual indentation for the buffer BUFFER, asynchronously.
+Give hand to other idle processes if it takes longer than DELAY,
+a time value."
+ (with-current-buffer buffer
+ (when org-indent-mode
+ (org-with-wide-buffer
+ (let ((interruptp
+ ;; Always nil unless interrupted.
+ (catch 'interrupt
+ (and org-indent-initial-marker
+ (marker-position org-indent-initial-marker)
+ (org-indent-add-properties org-indent-initial-marker
+ (point-max)
+ delay)
+ nil))))
+ (move-marker org-indent-initial-marker interruptp)
+ ;; Job is complete: un-agentize buffer.
+ (unless interruptp
+ (setq org-indent-agentized-buffers
+ (delq buffer org-indent-agentized-buffers))))))))
+
+(defsubst org-indent-set-line-properties (l w h)
+ "Set prefix properties on current line an move to next one.
+
+Prefix properties `line-prefix' and `wrap-prefix' in current line
+are set to, respectively, length L and W.
+
+If H is non-nil, `line-prefix' will be starred. If H is
+`inline', the first star will have `org-warning' face.
+
+Assume point is at beginning of line."
+ (let ((line (cond
+ ((eq 'inline h)
+ (let ((stars (aref org-indent-stars
+ (min l org-indent-max-levels))))
+ (and stars
+ (if (org-bound-and-true-p org-inlinetask-show-first-star)
+ (concat org-indent-inlinetask-first-star
+ (substring stars 1))
+ stars))))
+ (h (aref org-indent-stars
+ (min l org-indent-max-levels)))
+ (t (aref org-indent-strings
+ (min l org-indent-max)))))
+ (wrap (aref org-indent-strings (min w org-indent-max))))
+ ;; Add properties down to the next line to indent empty lines.
+ (add-text-properties (point) (min (1+ (point-at-eol)) (point-max))
+ `(line-prefix ,line wrap-prefix ,wrap)))
+ (forward-line 1))
+
+(defun org-indent-add-properties (beg end &optional delay)
+ "Add indentation properties between BEG and END.
+
+When DELAY is non-nil, it must be a time value. In that case,
+the process is asynchronous and can be interrupted, either by
+user request, or after DELAY. This is done by throwing the
+`interrupt' tag along with the buffer position where the process
+stopped."
+ (save-match-data
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ ;; 1. Initialize prefix at BEG. This is done by storing two
+ ;; variables: INLINE-PF and PF, representing respectively
+ ;; length of current `line-prefix' when line is inside an
+ ;; inline task or not.
+ (let* ((case-fold-search t)
+ (limited-re (org-get-limited-outline-regexp))
+ (added-ind-per-lvl (1- org-indent-indentation-per-level))
+ (pf (save-excursion
+ (and (ignore-errors (let ((outline-regexp limited-re))
+ (org-back-to-heading t)))
+ (+ (* org-indent-indentation-per-level
+ (- (match-end 0) (match-beginning 0) 2)) 2))))
+ (pf-inline (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)
+ (+ (* org-indent-indentation-per-level
+ (1- (org-inlinetask-get-task-level))) 2)))
+ (time-limit (and delay (time-add (current-time) delay))))
+ ;; 2. For each line, set `line-prefix' and `wrap-prefix'
+ ;; properties depending on the type of line (headline,
+ ;; inline task, item or other).
+ (with-silent-modifications
+ (while (and (<= (point) end) (not (eobp)))
+ (cond
+ ;; When in asynchronous mode, check if interrupt is
+ ;; required.
+ ((and delay (input-pending-p)) (throw 'interrupt (point)))
+ ;; In asynchronous mode, take a break of
+ ;; `org-indent-agent-resume-delay' every DELAY to avoid
+ ;; blocking any other idle timer or process output.
+ ((and delay (time-less-p time-limit (current-time)))
+ (setq org-indent-agent-resume-timer
+ (run-with-idle-timer
+ (time-add (current-idle-time)
+ org-indent-agent-resume-delay)
+ nil #'org-indent-initialize-agent))
+ (throw 'interrupt (point)))
+ ;; Headline or inline task.
+ ((looking-at org-outline-regexp)
+ (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
+ (line (* added-ind-per-lvl (1- nstars)))
+ (wrap (+ line (1+ nstars))))
+ (cond
+ ;; Headline: new value for PF.
+ ((looking-at limited-re)
+ (org-indent-set-line-properties line wrap t)
+ (setq pf wrap))
+ ;; End of inline task: PF-INLINE is now nil.
+ ((looking-at "\\*+ end[ \t]*$")
+ (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline nil))
+ ;; Start of inline task. Determine if it contains
+ ;; text, or if it is only one line long. Set
+ ;; PF-INLINE accordingly.
+ (t (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
+ ;; List item: `wrap-prefix' is set where body starts.
+ ((org-at-item-p)
+ (let* ((line (or pf-inline pf 0))
+ (wrap (+ (org-list-item-body-column (point)) line)))
+ (org-indent-set-line-properties line wrap nil)))
+ ;; Normal line: use PF-INLINE, PF or nil as prefixes.
+ (t (let* ((line (or pf-inline pf 0))
+ (wrap (+ line (org-get-indentation))))
+ (org-indent-set-line-properties line wrap nil))))))))))
+
+(defun org-indent-notify-modified-headline (beg end)
+ "Set `org-indent-modified-headline-flag' depending on context.
+
+BEG and END are the positions of the beginning and end of the
+range of deleted text.
+
+This function is meant to be called by `before-change-functions'.
+Flag will be non-nil if command is going to modify or delete an
+headline."
+ (when org-indent-mode
+ (setq org-indent-modified-headline-flag
+ (save-excursion
+ (goto-char beg)
+ (save-match-data
+ (or (and (org-at-heading-p) (< beg (match-end 0)))
+ (re-search-forward org-outline-regexp-bol end t)))))))
+
+(defun org-indent-refresh-maybe (beg end dummy)
+ "Refresh indentation properties in an adequate portion of buffer.
+BEG and END are the positions of the beginning and end of the
+range of inserted text. DUMMY is an unused argument.
+
+This function is meant to be called by `after-change-functions'."
+ (when org-indent-mode
+ (save-match-data
+ ;; If an headline was modified or inserted, set properties until
+ ;; next headline.
+ (if (or org-indent-modified-headline-flag
+ (save-excursion
+ (goto-char beg)
+ (beginning-of-line)
+ (re-search-forward org-outline-regexp-bol end t)))
+ (let ((end (save-excursion
+ (goto-char end)
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (setq org-indent-modified-headline-flag nil)
+ (org-indent-add-properties beg end))
+ ;; Otherwise, only set properties on modified area.
+ (org-indent-add-properties beg end)))))
+
+(provide 'org-indent)
+
+;;; org-indent.el ends here
diff --git a/lisp/org-info.el b/lisp/org-info.el
new file mode 100644
index 0000000..31981ae
--- /dev/null
+++ b/lisp/org-info.el
@@ -0,0 +1,79 @@
+;;; org-info.el --- Support for links to Info nodes from within Org-Mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to Info nodes from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+;; Declare external functions and variables
+
+(declare-function Info-find-node "info" (filename nodename
+ &optional no-going-back))
+(defvar Info-current-file)
+(defvar Info-current-node)
+
+;; Install the link type
+(org-add-link-type "info" 'org-info-open)
+(add-hook 'org-store-link-functions 'org-info-store-link)
+
+;; Implementation
+(defun org-info-store-link ()
+ "Store a link to an Info file and node."
+ (when (eq major-mode 'Info-mode)
+ (let (link desc)
+ (setq link (concat "info:"
+ (file-name-nondirectory Info-current-file)
+ "#" Info-current-node))
+ (setq desc (concat (file-name-nondirectory Info-current-file)
+ "#" Info-current-node))
+ (org-store-link-props :type "info" :file Info-current-file
+ :node Info-current-node
+ :link link :desc desc)
+ link)))
+
+(defun org-info-open (path)
+ "Follow an Info file and node link specified by PATH."
+ (org-info-follow-link path))
+
+
+(defun org-info-follow-link (name)
+ "Follow an Info file and node link specified by NAME."
+ (if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name)
+ (string-match "\\(.*\\)" name))
+ (progn
+ (require 'info)
+ (if (match-string 2 name) ; If there isn't a node, choose "Top"
+ (Info-find-node (match-string 1 name) (match-string 2 name))
+ (Info-find-node (match-string 1 name) "Top")))
+ (message "Could not open: %s" name)))
+
+(provide 'org-info)
+
+;;; org-info.el ends here
diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el
new file mode 100644
index 0000000..01f861e
--- /dev/null
+++ b/lisp/org-inlinetask.el
@@ -0,0 +1,484 @@
+;;; org-inlinetask.el --- Tasks independent of outline hierarchy
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This module implements inline tasks in Org-mode. Inline tasks are
+;; tasks that have all the properties of normal outline nodes, including
+;; the ability to store meta data like scheduling dates, TODO state, tags
+;; and properties. However, these nodes are treated specially by the
+;; visibility cycling and export commands.
+;;
+;; Visibility cycling exempts these nodes from cycling. So whenever their
+;; parent is opened, so are these tasks. This will only work with
+;; `org-cycle', so if you are also using other commands to show/hide
+;; entries, you will occasionally find these tasks to behave like
+;; all other outline nodes, seemingly splitting the text of the parent
+;; into children.
+;;
+;; Export commands do not treat these nodes as part of the sectioning
+;; structure, but as a special inline text that is either removed, or
+;; formatted in some special way. This in handled by
+;; `org-inlinetask-export' and `org-inlinetask-export-templates'
+;; variables.
+;;
+;; Special fontification of inline tasks, so that they can be immediately
+;; recognized. From the stars of the headline, only the first and the
+;; last two will be visible, the others will be hidden using the
+;; `org-hide' face.
+;;
+;; An inline task is identified solely by a minimum outline level, given
+;; by the variable `org-inlinetask-min-level', default 15.
+;;
+;; If you need to have a time planning line (DEADLINE etc), drawers,
+;; for example LOGBOOK of PROPERTIES, or even normal text as part of
+;; the inline task, you must add an "END" headline with the same
+;; number of stars.
+;;
+;; As an example, here are two valid inline tasks:
+;;
+;; **************** TODO a small task
+;;
+;; and
+;;
+;; **************** TODO another small task
+;; DEADLINE: <2009-03-30 Mon>
+;; :PROPERTIES:
+;; :SOMETHING: or other
+;; :END:
+;; And here is some extra text
+;; **************** END
+;;
+;; Also, if you want to use refiling and archiving for inline tasks,
+;; The END line must be present to make things work properly.
+;;
+;; This package installs one new command:
+;;
+;; C-c C-x t Insert a new inline task with END line
+
+;;; Code:
+
+(require 'org)
+
+(defgroup org-inlinetask nil
+ "Options concerning inline tasks in Org mode."
+ :tag "Org Inline Tasks"
+ :group 'org-structure)
+
+(defcustom org-inlinetask-min-level 15
+ "Minimum level a headline must have before it is treated as an inline task.
+Don't set it to something higher than `29' or clocking will break since this
+is the hardcoded maximum number of stars `org-clock-sum' will work with.
+
+It is strongly recommended that you set `org-cycle-max-level' not at all,
+or to a number smaller than this one. In fact, when `org-cycle-max-level' is
+not set, it will be assumed to be one less than the value of smaller than
+the value of this variable."
+ :group 'org-inlinetask
+ :type '(choice
+ (const :tag "Off" nil)
+ (integer)))
+
+(defcustom org-inlinetask-show-first-star nil
+ "Non-nil means display the first star of an inline task as additional marker.
+When nil, the first star is not shown."
+ :tag "Org Inline Tasks"
+ :group 'org-structure)
+
+(defcustom org-inlinetask-export t
+ "Non-nil means export inline tasks.
+When nil, they will not be exported."
+ :group 'org-inlinetask
+ :type 'boolean)
+
+(defvar org-inlinetask-export-templates
+ '((html "<div class=\"inlinetask\"><b>%s%s</b><br />%s</div>"
+ '((unless (eq todo "")
+ (format "<span class=\"%s %s\">%s%s</span> "
+ class todo todo priority))
+ heading content))
+ (odt "%s" '((org-odt-format-inlinetask heading content
+ todo priority tags)))
+
+ (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}"
+ '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
+ heading content))
+ (ascii " -- %s%s%s"
+ '((unless (eq todo "") (format "%s%s " todo priority))
+ heading
+ (unless (eq content "")
+ (format "\n ¦ %s"
+ (mapconcat 'identity (org-split-string content "\n")
+ "\n ¦ ")))))
+ (docbook "<variablelist>
+<varlistentry>
+<term>%s%s</term>
+<listitem><para>%s</para></listitem>
+</varlistentry>
+</variablelist>"
+ '((unless (eq todo "") (format "%s%s " todo priority))
+ heading content)))
+ "Templates for inline tasks in various exporters.
+
+This variable is an alist in the shape of \(BACKEND STRING OBJECTS\).
+
+BACKEND is the name of the backend for the template \(ascii, html...\).
+
+STRING is a format control string.
+
+OBJECTS is a list of elements to be substituted into the format
+string. They can be of any type, from a string to a form
+returning a value (thus allowing conditional insertion). A nil
+object will be substituted as the empty string. Obviously, there
+must be at least as many objects as %-sequences in the format
+string.
+
+Moreover, the following special keywords are provided: `todo',
+`priority', `heading', `content', `tags'. If some of them are not
+defined in an inline task, their value is the empty string.
+
+As an example, valid associations are:
+
+\(html \"<ul><li>%s <p>%s</p></li></ul>\" \(heading content\)\)
+
+or, with the additional package \"todonotes\" for LaTeX,
+
+\(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
+ '\(\(unless \(eq todo \"\"\)
+ \(format \"\\textsc{%s%s}\" todo priority\)\)
+ heading content\)\)\)")
+
+(defvar org-odd-levels-only)
+(defvar org-keyword-time-regexp)
+(defvar org-drawer-regexp)
+(defvar org-complex-heading-regexp)
+(defvar org-property-end-re)
+
+(defcustom org-inlinetask-default-state nil
+ "Non-nil means make inline tasks have a TODO keyword initially.
+This should be the state `org-inlinetask-insert-task' should use by
+default, or nil of no state should be assigned."
+ :group 'org-inlinetask
+ :version "24.1"
+ :type '(choice
+ (const :tag "No state" nil)
+ (string :tag "Specific state")))
+
+(defun org-inlinetask-insert-task (&optional no-state)
+ "Insert an inline task.
+If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'."
+ (interactive "P")
+ ;; Error when inside an inline task, except if point was at its very
+ ;; beginning, in which case the new inline task will be inserted
+ ;; before this one.
+ (when (and (org-inlinetask-in-task-p)
+ (not (and (org-inlinetask-at-task-p) (bolp))))
+ (error "Cannot nest inline tasks"))
+ (or (bolp) (newline))
+ (let* ((indent (if org-odd-levels-only
+ (1- (* 2 org-inlinetask-min-level))
+ org-inlinetask-min-level))
+ (indent-string (concat (make-string indent ?*) " ")))
+ (insert indent-string
+ (if (or no-state (not org-inlinetask-default-state))
+ "\n"
+ (concat org-inlinetask-default-state " \n"))
+ indent-string "END\n"))
+ (end-of-line -1))
+(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task)
+
+(defun org-inlinetask-outline-regexp ()
+ "Return string matching an inline task heading.
+The number of levels is controlled by `org-inlinetask-min-level'."
+ (let ((nstars (if org-odd-levels-only
+ (1- (* org-inlinetask-min-level 2))
+ org-inlinetask-min-level)))
+ (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars)))
+
+(defun org-inlinetask-at-task-p ()
+ "Return true if point is at beginning of an inline task."
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)"))
+ (not (string-match "^end[ \t]*$" (downcase (match-string 2)))))))
+
+(defun org-inlinetask-in-task-p ()
+ "Return true if point is inside an inline task."
+ (save-excursion
+ (beginning-of-line)
+ (let* ((case-fold-search t)
+ (stars-re (org-inlinetask-outline-regexp))
+ (task-beg-re (concat stars-re "\\(?:.*\\)"))
+ (task-end-re (concat stars-re "END[ \t]*$")))
+ (or (org-looking-at-p task-beg-re)
+ (and (re-search-forward "^\\*+[ \t]+" nil t)
+ (progn (beginning-of-line) (org-looking-at-p task-end-re)))))))
+
+(defun org-inlinetask-goto-beginning ()
+ "Go to the beginning of the inline task at point."
+ (end-of-line)
+ (let ((case-fold-search t)
+ (inlinetask-re (org-inlinetask-outline-regexp)))
+ (re-search-backward inlinetask-re nil t)
+ (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
+ (re-search-backward inlinetask-re nil t))))
+
+(defun org-inlinetask-goto-end ()
+ "Go to the end of the inline task at point.
+Return point."
+ (save-match-data
+ (beginning-of-line)
+ (let* ((case-fold-search t)
+ (inlinetask-re (org-inlinetask-outline-regexp))
+ (task-end-re (concat inlinetask-re "END[ \t]*$")))
+ (cond
+ ((looking-at task-end-re) (forward-line))
+ ((looking-at inlinetask-re)
+ (forward-line)
+ (cond
+ ((looking-at task-end-re) (forward-line))
+ ((looking-at inlinetask-re))
+ ((org-inlinetask-in-task-p)
+ (re-search-forward inlinetask-re nil t)
+ (forward-line))))
+ (t (re-search-forward inlinetask-re nil t)
+ (forward-line)))
+ (point))))
+
+(defun org-inlinetask-get-task-level ()
+ "Get the level of the inline task around.
+This assumes the point is inside an inline task."
+ (save-excursion
+ (end-of-line)
+ (re-search-backward (org-inlinetask-outline-regexp) nil t)
+ (- (match-end 1) (match-beginning 1))))
+
+(defun org-inlinetask-promote ()
+ "Promote the inline task at point.
+If the task has an end part, promote it. Also, prevents level from
+going below `org-inlinetask-min-level'."
+ (interactive)
+ (if (not (org-inlinetask-in-task-p))
+ (error "Not in an inline task")
+ (save-excursion
+ (let* ((lvl (org-inlinetask-get-task-level))
+ (next-lvl (org-get-valid-level lvl -1))
+ (diff (- next-lvl lvl))
+ (down-task (concat (make-string next-lvl ?*)))
+ beg)
+ (if (< next-lvl org-inlinetask-min-level)
+ (error "Cannot promote an inline task at minimum level")
+ (org-inlinetask-goto-beginning)
+ (setq beg (point))
+ (replace-match down-task nil t nil 1)
+ (org-inlinetask-goto-end)
+ (if (eobp) (beginning-of-line) (forward-line -1))
+ (unless (= (point) beg)
+ (replace-match down-task nil t nil 1)
+ (when org-adapt-indentation
+ (goto-char beg)
+ (org-fixup-indentation diff))))))))
+
+(defun org-inlinetask-demote ()
+ "Demote the inline task at point.
+If the task has an end part, also demote it."
+ (interactive)
+ (if (not (org-inlinetask-in-task-p))
+ (error "Not in an inline task")
+ (save-excursion
+ (let* ((lvl (org-inlinetask-get-task-level))
+ (next-lvl (org-get-valid-level lvl 1))
+ (diff (- next-lvl lvl))
+ (down-task (concat (make-string next-lvl ?*)))
+ beg)
+ (org-inlinetask-goto-beginning)
+ (setq beg (point))
+ (replace-match down-task nil t nil 1)
+ (org-inlinetask-goto-end)
+ (if (eobp) (beginning-of-line) (forward-line -1))
+ (unless (= (point) beg)
+ (replace-match down-task nil t nil 1)
+ (when org-adapt-indentation
+ (goto-char beg)
+ (org-fixup-indentation diff)))))))
+
+(defvar org-export-current-backend) ; dynamically bound in org-exp.el
+(defun org-inlinetask-export-handler ()
+ "Handle headlines with level larger or equal to `org-inlinetask-min-level'.
+Either remove headline and meta data, or do special formatting."
+ (goto-char (point-min))
+ (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp))
+ (inline-re (concat (org-inlinetask-outline-regexp) ".*")))
+ (while (re-search-forward inline-re nil t)
+ (let ((headline (match-string 0))
+ (beg (point-at-bol))
+ (end (copy-marker (save-excursion
+ (org-inlinetask-goto-end) (point))))
+ content)
+ ;; Delete SCHEDULED, DEADLINE...
+ (while (re-search-forward keywords-re end t)
+ (delete-region (point-at-bol) (1+ (point-at-eol))))
+ (goto-char beg)
+ ;; Delete drawers
+ (while (re-search-forward org-drawer-regexp end t)
+ (when (save-excursion (re-search-forward org-property-end-re nil t))
+ (delete-region beg (1+ (match-end 0)))))
+ ;; Get CONTENT, if any.
+ (goto-char beg)
+ (forward-line 1)
+ (unless (= (point) end)
+ (setq content (buffer-substring (point)
+ (save-excursion (goto-char end)
+ (forward-line -1)
+ (point)))))
+ ;; Remove the task.
+ (goto-char beg)
+ (delete-region beg end)
+ (when (and org-inlinetask-export
+ (assq org-export-current-backend
+ org-inlinetask-export-templates))
+ ;; Format CONTENT, if appropriate.
+ (setq content
+ (if (not (and content (string-match "\\S-" content)))
+ ""
+ ;; Ensure CONTENT has minimal indentation, a single
+ ;; newline character at its boundaries, and isn't
+ ;; protected.
+ (when (string-match "\\`\\([ \t]*\n\\)+" content)
+ (setq content (substring content (match-end 0))))
+ (when (string-match "[ \t\n]+\\'" content)
+ (setq content (substring content 0 (match-beginning 0))))
+ (org-add-props
+ (concat "\n\n" (org-remove-indentation content) "\n\n")
+ '(org-protected nil org-native-text nil))))
+
+ (when (string-match org-complex-heading-regexp headline)
+ (let* ((nil-to-str
+ (function
+ ;; Change nil arguments into empty strings.
+ (lambda (el) (or (eval el) ""))))
+ ;; Set up keywords provided to templates.
+ (todo (or (match-string 2 headline) ""))
+ (class (or (and (eq "" todo) "")
+ (if (member todo org-done-keywords) "done" "todo")))
+ (priority (or (match-string 3 headline) ""))
+ (heading (or (match-string 4 headline) ""))
+ (tags (or (match-string 5 headline) ""))
+ ;; Read `org-inlinetask-export-templates'.
+ (backend-spec (assq org-export-current-backend
+ org-inlinetask-export-templates))
+ (format-str (org-add-props (nth 1 backend-spec)
+ '(org-protected t org-native-text t)))
+ (tokens (cadr (nth 2 backend-spec)))
+ ;; Build export string. Ensure it won't break
+ ;; surrounding lists by giving it arbitrary high
+ ;; indentation.
+ (export-str (org-add-props
+ (eval (append '(format format-str)
+ (mapcar nil-to-str tokens)))
+ '(original-indentation 1000))))
+ ;; Ensure task starts a new paragraph.
+ (unless (or (bobp)
+ (save-excursion (forward-line -1)
+ (looking-at "[ \t]*$")))
+ (insert "\n"))
+ (insert export-str)
+ (unless (bolp) (insert "\n")))))))))
+
+(defun org-inlinetask-get-current-indentation ()
+ "Get the indentation of the last non-while line above this one."
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-backward " \t\n")
+ (beginning-of-line 1)
+ (or (org-at-item-p)
+ (looking-at "[ \t]*"))
+ (goto-char (match-end 0))
+ (current-column)))
+
+(defvar org-indent-indentation-per-level) ; defined in org-indent.el
+
+(defface org-inlinetask
+ (org-compatible-face 'shadow '((t (:bold t))))
+ "Face for inlinetask headlines."
+ :group 'org-faces)
+
+(defun org-inlinetask-fontify (limit)
+ "Fontify the inline tasks down to LIMIT."
+ (let* ((nstars (if org-odd-levels-only
+ (1- (* 2 (or org-inlinetask-min-level 200)))
+ (or org-inlinetask-min-level 200)))
+ (re (concat "^\\(\\*\\)\\(\\*\\{"
+ (format "%d" (- nstars 3))
+ ",\\}\\)\\(\\*\\* .*\\)"))
+ ;; Virtual indentation will add the warning face on the first
+ ;; star. Thus, in that case, only hide it.
+ (start-face (if (and (org-bound-and-true-p org-indent-mode)
+ (> org-indent-indentation-per-level 1))
+ 'org-hide
+ 'org-warning)))
+ (while (re-search-forward re limit t)
+ (if org-inlinetask-show-first-star
+ (add-text-properties (match-beginning 1) (match-end 1)
+ `(face ,start-face font-lock-fontified t)))
+ (add-text-properties (match-beginning
+ (if org-inlinetask-show-first-star 2 1))
+ (match-end 2)
+ '(face org-hide font-lock-fontified t))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(face org-inlinetask font-lock-fontified t)))))
+
+(defun org-inlinetask-toggle-visibility ()
+ "Toggle visibility of inline task at point."
+ (let ((end (save-excursion
+ (org-inlinetask-goto-end)
+ (if (bolp) (1- (point)) (point))))
+ (start (save-excursion
+ (org-inlinetask-goto-beginning)
+ (point-at-eol))))
+ (cond
+ ;; Nothing to show/hide.
+ ((= end start))
+ ;; Inlinetask was folded: expand it.
+ ((get-char-property (1+ start) 'invisible)
+ (org-show-entry))
+ (t (outline-flag-region start end t)))))
+
+(defun org-inlinetask-remove-END-maybe ()
+ "Remove an END line when present."
+ (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
+ org-inlinetask-min-level))
+ (replace-match "")))
+
+(eval-after-load "org-exp"
+ '(add-hook 'org-export-preprocess-before-backend-specifics-hook
+ 'org-inlinetask-export-handler))
+(eval-after-load "org"
+ '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
+
+(provide 'org-inlinetask)
+
+;;; org-inlinetask.el ends here
diff --git a/lisp/org-install.el b/lisp/org-install.el
new file mode 100644
index 0000000..f61878a
--- /dev/null
+++ b/lisp/org-install.el
@@ -0,0 +1,2190 @@
+;;; org-install.el --- autogenerated file, do not edit
+;;
+;;; Code:
+
+;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el"
+;;;;;; (20323 36516))
+;;; Generated autoloads from ob-keys.el
+
+(autoload 'org-babel-describe-bindings "ob-keys" "\
+Describe all keybindings behind `org-babel-key-prefix'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe
+;;;;;; org-babel-lob-ingest) "ob-lob" "ob-lob.el" (20535 39646))
+;;; Generated autoloads from ob-lob.el
+
+(autoload 'org-babel-lob-ingest "ob-lob" "\
+Add all named source-blocks defined in FILE to
+`org-babel-library-of-babel'.
+
+\(fn &optional FILE)" t nil)
+
+(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
+Execute a Library of Babel source block, if appropriate.
+Detect if this is context for a Library Of Babel source block and
+if so then run the appropriate source block from the Library.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-lob-get-info "ob-lob" "\
+Return a Library of Babel function call as a string.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file
+;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "ob-tangle.el" (20547
+;;;;;; 19019))
+;;; Generated autoloads from ob-tangle.el
+
+(defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\
+Alist mapping languages to their file extensions.
+The key is the language name, the value is the string that should
+be inserted as the extension commonly used to identify files
+written in this language. If no entry is found in this list,
+then the name of the language is used.")
+
+(custom-autoload 'org-babel-tangle-lang-exts "ob-tangle" t)
+
+(autoload 'org-babel-load-file "ob-tangle" "\
+Load Emacs Lisp source code blocks in the Org-mode FILE.
+This function exports the source code using
+`org-babel-tangle' and then loads the resulting file using
+`load-file'.
+
+\(fn FILE)" t nil)
+
+(autoload 'org-babel-tangle-file "ob-tangle" "\
+Extract the bodies of source code blocks in FILE.
+Source code blocks are extracted with `org-babel-tangle'.
+Optional argument TARGET-FILE can be used to specify a default
+export file for all source blocks. Optional argument LANG can be
+used to limit the exported source code blocks by language.
+
+\(fn FILE &optional TARGET-FILE LANG)" t nil)
+
+(autoload 'org-babel-tangle "ob-tangle" "\
+Write code blocks to source-specific files.
+Extract the bodies of all source code blocks from the current
+file into their own source-specific files. Optional argument
+TARGET-FILE can be used to specify a default export file for all
+source blocks. Optional argument LANG can be used to limit the
+exported source code blocks by language.
+
+\(fn &optional ONLY-THIS-BLOCK TARGET-FILE LANG)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block
+;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block
+;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe
+;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer
+;;;;;; org-babel-map-executables org-babel-map-call-lines org-babel-map-inline-src-blocks
+;;;;;; org-babel-map-src-blocks org-babel-open-src-block-result
+;;;;;; org-babel-switch-to-session-with-code org-babel-switch-to-session
+;;;;;; org-babel-initiate-session org-babel-load-in-session org-babel-insert-header-arg
+;;;;;; org-babel-check-src-block org-babel-expand-src-block org-babel-execute-src-block
+;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe
+;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info
+;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob"
+;;;;;; "ob.el" (20582 38860))
+;;; Generated autoloads from ob.el
+
+(autoload 'org-babel-execute-safely-maybe "ob" "\
+Not documented
+
+\(fn)" nil nil)
+
+(autoload 'org-babel-execute-maybe "ob" "\
+Not documented
+
+\(fn)" t nil)
+
+(autoload 'org-babel-view-src-block-info "ob" "\
+Display information on the current source block.
+This includes header arguments, language and name, and is largely
+a window into the `org-babel-get-src-block-info' function.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-expand-src-block-maybe "ob" "\
+Conditionally expand a source block.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-expand-src-block'.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-load-in-session-maybe "ob" "\
+Conditionally load a source block in a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-load-in-session'.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-pop-to-session-maybe "ob" "\
+Conditionally pop to a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-pop-to-session'.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-execute-src-block "ob" "\
+Execute the current source code block.
+Insert the results of execution into the buffer. Source code
+execution and the collection and formatting of results can be
+controlled through a variety of header arguments.
+
+With prefix argument ARG, force re-execution even if an existing
+result cached in the buffer would otherwise have been returned.
+
+Optionally supply a value for INFO in the form returned by
+`org-babel-get-src-block-info'.
+
+Optionally supply a value for PARAMS which will be merged with
+the header arguments specified at the front of the source code
+block.
+
+\(fn &optional ARG INFO PARAMS)" t nil)
+
+(autoload 'org-babel-expand-src-block "ob" "\
+Expand the current source code block.
+Expand according to the source code block's header
+arguments and pop open the results in a preview buffer.
+
+\(fn &optional ARG INFO PARAMS)" t nil)
+
+(autoload 'org-babel-check-src-block "ob" "\
+Check for misspelled header arguments in the current code block.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-insert-header-arg "ob" "\
+Insert a header argument selecting from lists of common args and values.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-load-in-session "ob" "\
+Load the body of the current source-code block.
+Evaluate the header arguments for the source block before
+entering the session. After loading the body this pops open the
+session.
+
+\(fn &optional ARG INFO)" t nil)
+
+(autoload 'org-babel-initiate-session "ob" "\
+Initiate session for current code block.
+If called with a prefix argument then resolve any variable
+references in the header arguments and assign these variables in
+the session. Copy the body of the code block to the kill ring.
+
+\(fn &optional ARG INFO)" t nil)
+
+(autoload 'org-babel-switch-to-session "ob" "\
+Switch to the session of the current code block.
+Uses `org-babel-initiate-session' to start the session. If called
+with a prefix argument then this is passed on to
+`org-babel-initiate-session'.
+
+\(fn &optional ARG INFO)" t nil)
+
+(autoload 'org-babel-switch-to-session-with-code "ob" "\
+Switch to code buffer and display session.
+
+\(fn &optional ARG INFO)" t nil)
+
+(autoload 'org-babel-open-src-block-result "ob" "\
+If `point' is on a src block then open the results of the
+source code block, otherwise return nil. With optional prefix
+argument RE-RUN the source-code block is evaluated even if
+results already exist.
+
+\(fn &optional RE-RUN)" t nil)
+
+(autoload 'org-babel-map-src-blocks "ob" "\
+Evaluate BODY forms on each source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer. During evaluation of BODY the following local variables
+are set relative to the currently matched code block.
+
+full-block ------- string holding the entirety of the code block
+beg-block -------- point at the beginning of the code block
+end-block -------- point at the end of the matched code block
+lang ------------- string holding the language of the code block
+beg-lang --------- point at the beginning of the lang
+end-lang --------- point at the end of the lang
+switches --------- string holding the switches
+beg-switches ----- point at the beginning of the switches
+end-switches ----- point at the end of the switches
+header-args ------ string holding the header-args
+beg-header-args -- point at the beginning of the header-args
+end-header-args -- point at the end of the header-args
+body ------------- string holding the body of the code block
+beg-body --------- point at the beginning of the body
+end-body --------- point at the end of the body
+
+\(fn FILE &rest BODY)" nil (quote macro))
+
+(autoload 'org-babel-map-inline-src-blocks "ob" "\
+Evaluate BODY forms on each inline source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer.
+
+\(fn FILE &rest BODY)" nil (quote macro))
+
+(autoload 'org-babel-map-call-lines "ob" "\
+Evaluate BODY forms on each call line in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer.
+
+\(fn FILE &rest BODY)" nil (quote macro))
+
+(autoload 'org-babel-map-executables "ob" "\
+Not documented
+
+\(fn FILE &rest BODY)" nil (quote macro))
+
+(autoload 'org-babel-execute-buffer "ob" "\
+Execute source code blocks in a buffer.
+Call `org-babel-execute-src-block' on every source block in
+the current buffer.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-babel-execute-subtree "ob" "\
+Execute source code blocks in a subtree.
+Call `org-babel-execute-src-block' on every source block in
+the current subtree.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-babel-sha1-hash "ob" "\
+Generate an sha1 hash based on the value of info.
+
+\(fn &optional INFO)" t nil)
+
+(autoload 'org-babel-hide-result-toggle-maybe "ob" "\
+Toggle visibility of result at point.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-goto-src-block-head "ob" "\
+Go to the beginning of the current code block.
+
+\(fn)" t nil)
+
+(autoload 'org-babel-goto-named-src-block "ob" "\
+Go to a named source-code block.
+
+\(fn NAME)" t nil)
+
+(autoload 'org-babel-goto-named-result "ob" "\
+Go to a named result.
+
+\(fn NAME)" t nil)
+
+(autoload 'org-babel-next-src-block "ob" "\
+Jump to the next source block.
+With optional prefix argument ARG, jump forward ARG many source blocks.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-babel-previous-src-block "ob" "\
+Jump to the previous source block.
+With optional prefix argument ARG, jump backward ARG many source blocks.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-babel-mark-block "ob" "\
+Mark current src block.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list
+;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views
+;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda
+;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el"
+;;;;;; (20583 28515))
+;;; Generated autoloads from org-agenda.el
+
+(autoload 'org-toggle-sticky-agenda "org-agenda" "\
+Toggle `org-agenda-sticky'.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-agenda "org-agenda" "\
+Dispatch agenda commands to collect entries to the agenda buffer.
+Prompts for a command to execute. Any prefix arg will be passed
+on to the selected command. The default selections are:
+
+a Call `org-agenda-list' to display the agenda for current day or week.
+t Call `org-todo-list' to display the global todo list.
+T Call `org-todo-list' to display the global todo list, select only
+ entries with a specific TODO keyword (the user gets a prompt).
+m Call `org-tags-view' to display headlines with tags matching
+ a condition (the user is prompted for the condition).
+M Like `m', but select only TODO entries, no ordinary headlines.
+L Create a timeline for the current buffer.
+e Export views to associated files.
+s Search entries for keywords.
+S Search entries for keywords, only with TODO keywords.
+/ Multi occur across all agenda files and also files listed
+ in `org-agenda-text-search-extra-files'.
+< Restrict agenda commands to buffer, subtree, or region.
+ Press several times to get the desired effect.
+> Remove a previous restriction.
+# List \"stuck\" projects.
+! Configure what \"stuck\" means.
+C Configure custom agenda commands.
+
+More commands can be added by configuring the variable
+`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
+searches can be pre-defined in this way.
+
+If the current buffer is in Org-mode and visiting a file, you can also
+first press `<' once to indicate that the agenda should be temporarily
+\(until the next use of \\[org-agenda]) restricted to the current file.
+Pressing `<' twice means to restrict to the current subtree or region
+\(if active).
+
+\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil)
+
+(autoload 'org-batch-agenda "org-agenda" "\
+Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command.
+
+\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+
+(autoload 'org-batch-agenda-csv "org-agenda" "\
+Run an agenda command in batch mode and send the result to STDOUT.
+If CMD-KEY is a string of length 1, it is used as a key in
+`org-agenda-custom-commands' and triggers this command. If it is a
+longer string it is used as a tags/todo match string.
+Parameters are alternating variable names and values that will be bound
+before running the agenda command.
+
+The output gives a line for each selected agenda item. Each
+item is a list of comma-separated values, like this:
+
+category,head,type,todo,tags,date,time,extra,priority-l,priority-n
+
+category The category of the item
+head The headline, without TODO kwd, TAGS and PRIORITY
+type The type of the agenda entry, can be
+ todo selected in TODO match
+ tagsmatch selected in tags match
+ diary imported from diary
+ deadline a deadline on given date
+ scheduled scheduled on given date
+ timestamp entry has timestamp on given date
+ closed entry was closed on given date
+ upcoming-deadline warning about deadline
+ past-scheduled forwarded scheduled item
+ block entry has date block including g. date
+todo The todo keyword, if any
+tags All tags including inherited ones, separated by colons
+date The relevant date, like 2007-2-14
+time The time, like 15:00-16:50
+extra Sting with extra planning info
+priority-l The priority letter if any was given
+priority-n The computed numerical priority
+agenda-day The day in the agenda where this is listed
+
+\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro))
+
+(autoload 'org-store-agenda-views "org-agenda" "\
+Not documented
+
+\(fn &rest PARAMETERS)" t nil)
+
+(autoload 'org-batch-store-agenda-views "org-agenda" "\
+Run all custom agenda commands that have a file argument.
+
+\(fn &rest PARAMETERS)" nil (quote macro))
+
+(autoload 'org-agenda-list "org-agenda" "\
+Produce a daily/weekly view from all files in variable `org-agenda-files'.
+The view will be for the current day or week, but from the overview buffer
+you will be able to go to other days/weeks.
+
+With a numeric prefix argument in an interactive call, the agenda will
+span ARG days. Lisp programs should instead specify SPAN to change
+the number of days. SPAN defaults to `org-agenda-span'.
+
+START-DAY defaults to TODAY, or to the most recent match for the weekday
+given in `org-agenda-start-on-weekday'.
+
+\(fn &optional ARG START-DAY SPAN)" t nil)
+
+(autoload 'org-search-view "org-agenda" "\
+Show all entries that contain a phrase or words or regular expressions.
+
+With optional prefix argument TODO-ONLY, only consider entries that are
+TODO entries. The argument STRING can be used to pass a default search
+string into this function. If EDIT-AT is non-nil, it means that the
+user should get a chance to edit this string, with cursor at position
+EDIT-AT.
+
+The search string can be viewed either as a phrase that should be found as
+is, or it can be broken into a number of snippets, each of which must match
+in a Boolean way to select an entry. The default depends on the variable
+`org-agenda-search-view-always-boolean'.
+Even if this is turned off (the default) you can always switch to
+Boolean search dynamically by preceding the first word with \"+\" or \"-\".
+
+The default is a direct search of the whole phrase, where each space in
+the search string can expand to an arbitrary amount of whitespace,
+including newlines.
+
+If using a Boolean search, the search string is split on whitespace and
+each snippet is searched separately, with logical AND to select an entry.
+Words prefixed with a minus must *not* occur in the entry. Words without
+a prefix or prefixed with a plus must occur in the entry. Matching is
+case-insensitive. Words are enclosed by word delimiters (i.e. they must
+match whole words, not parts of a word) if
+`org-agenda-search-view-force-full-words' is set (default is nil).
+
+Boolean search snippets enclosed by curly braces are interpreted as
+regular expressions that must or (when preceded with \"-\") must not
+match in the entry. Snippets enclosed into double quotes will be taken
+as a whole, to include whitespace.
+
+- If the search string starts with an asterisk, search only in headlines.
+- If (possibly after the leading star) the search string starts with an
+ exclamation mark, this also means to look at TODO entries only, an effect
+ that can also be achieved with a prefix argument.
+- If (possibly after star and exclamation mark) the search string starts
+ with a colon, this will mean that the (non-regexp) snippets of the
+ Boolean search must match as full words.
+
+This command searches the agenda files, and in addition the files listed
+in `org-agenda-text-search-extra-files'.
+
+\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil)
+
+(autoload 'org-todo-list "org-agenda" "\
+Show all (not done) TODO entries from all agenda file in a single list.
+The prefix arg can be used to select a specific TODO keyword and limit
+the list to these. When using \\[universal-argument], you will be prompted
+for a keyword. A numeric prefix directly selects the Nth keyword in
+`org-todo-keywords-1'.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-tags-view "org-agenda" "\
+Show all headlines for all `org-agenda-files' matching a TAGS criterion.
+The prefix arg TODO-ONLY limits the search to TODO entries.
+
+\(fn &optional TODO-ONLY MATCH)" t nil)
+
+(autoload 'org-agenda-list-stuck-projects "org-agenda" "\
+Create agenda view for projects that are stuck.
+Stuck projects are project that have no next actions. For the definitions
+of what a project is and how to check if it stuck, customize the variable
+`org-stuck-projects'.
+
+\(fn &rest IGNORE)" t nil)
+
+(autoload 'org-diary "org-agenda" "\
+Return diary information from org files.
+This function can be used in a \"sexp\" diary entry in the Emacs calendar.
+It accesses org files and extracts information from those files to be
+listed in the diary. The function accepts arguments specifying what
+items should be listed. For a list of arguments allowed here, see the
+variable `org-agenda-entry-types'.
+
+The call in the diary file should look like this:
+
+ &%%(org-diary) ~/path/to/some/orgfile.org
+
+Use a separate line for each org file to check. Or, if you omit the file name,
+all files listed in `org-agenda-files' will be checked automatically:
+
+ &%%(org-diary)
+
+If you don't give any arguments (as in the example above), the default
+arguments (:deadline :scheduled :timestamp :sexp) are used.
+So the example above may also be written as
+
+ &%%(org-diary :deadline :timestamp :sexp :scheduled)
+
+The function expects the lisp variables `entry' and `date' to be provided
+by the caller, because this is how the calendar works. Don't use this
+function from a program - use `org-agenda-get-day-entries' instead.
+
+\(fn &rest ARGS)" nil nil)
+
+(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\
+Do we have a reason to ignore this TODO entry because it has a time stamp?
+
+\(fn &optional END)" nil nil)
+
+(autoload 'org-calendar-goto-agenda "org-agenda" "\
+Compute the Org-mode agenda for the calendar date displayed at the cursor.
+This is a command that has to be installed in `calendar-mode-map'.
+
+\(fn)" t nil)
+
+(autoload 'org-agenda-to-appt "org-agenda" "\
+Activate appointments found in `org-agenda-files'.
+With a \\[universal-argument] prefix, refresh the list of
+appointments.
+
+If FILTER is t, interactively prompt the user for a regular
+expression, and filter out entries that don't match it.
+
+If FILTER is a string, use this string as a regular expression
+for filtering entries out.
+
+If FILTER is a function, filter out entries against which
+calling the function returns nil. This function takes one
+argument: an entry from `org-agenda-get-day-entries'.
+
+FILTER can also be an alist with the car of each cell being
+either 'headline or 'category. For example:
+
+ '((headline \"IMPORTANT\")
+ (category \"Work\"))
+
+will only add headlines containing IMPORTANT or headlines
+belonging to the \"Work\" category.
+
+ARGS are symbols indicating what kind of entries to consider.
+By default `org-agenda-to-appt' will use :deadline, :scheduled
+and :timestamp entries. See the docstring of `org-diary' for
+details and examples.
+
+If an entry as a APPT_WARNTIME property, its value will be used
+to override `appt-message-warning-time'.
+
+\(fn &optional REFRESH FILTER &rest ARGS)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-archive-subtree-default-with-confirmation
+;;;;;; org-archive-subtree-default) "org-archive" "org-archive.el"
+;;;;;; (20535 39591))
+;;; Generated autoloads from org-archive.el
+
+(autoload 'org-archive-subtree-default "org-archive" "\
+Archive the current subtree with the default command.
+This command is set with the variable `org-archive-default-command'.
+
+\(fn)" t nil)
+
+(autoload 'org-archive-subtree-default-with-confirmation "org-archive" "\
+Archive the current subtree with the default command.
+This command is set with the variable `org-archive-default-command'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii
+;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer
+;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer
+;;;;;; org-export-as-latin1) "org-ascii" "org-ascii.el" (20535 39591))
+;;; Generated autoloads from org-ascii.el
+
+(autoload 'org-export-as-latin1 "org-ascii" "\
+Like `org-export-as-ascii', use latin1 encoding for special symbols.
+
+\(fn &rest ARGS)" t nil)
+
+(autoload 'org-export-as-latin1-to-buffer "org-ascii" "\
+Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols.
+
+\(fn &rest ARGS)" t nil)
+
+(autoload 'org-export-as-utf8 "org-ascii" "\
+Like `org-export-as-ascii', use encoding for special symbols.
+
+\(fn &rest ARGS)" t nil)
+
+(autoload 'org-export-as-utf8-to-buffer "org-ascii" "\
+Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols.
+
+\(fn &rest ARGS)" t nil)
+
+(autoload 'org-export-as-ascii-to-buffer "org-ascii" "\
+Call `org-export-as-ascii` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-ascii'.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-replace-region-by-ascii "org-ascii" "\
+Assume the current region has org-mode syntax, and convert it to plain ASCII.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in a Mail buffer and then use this
+command to convert it.
+
+\(fn BEG END)" t nil)
+
+(autoload 'org-export-region-as-ascii "org-ascii" "\
+Convert region from BEG to END in org-mode buffer to plain ASCII.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted ASCII. If BUFFER is the symbol `string', return the
+produced ASCII as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq ascii (org-export-region-as-ascii beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer.
+
+\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
+
+(autoload 'org-export-as-ascii "org-ascii" "\
+Export the outline as a pretty ASCII file.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+underlined headlines, default is 3. Lower levels will become bulleted
+lists. When HIDDEN is non-nil, don't display the ASCII buffer.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting ASCII as a string. When BODY-ONLY is set, don't produce
+the file header and footer. When PUB-DIR is set, use this as the
+publishing directory.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-attach) "org-attach" "org-attach.el" (20535
+;;;;;; 39591))
+;;; Generated autoloads from org-attach.el
+
+(autoload 'org-attach "org-attach" "\
+The dispatcher for attachment commands.
+Shows a list of commands and prompts for another key to execute a command.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el"
+;;;;;; (20535 39591))
+;;; Generated autoloads from org-bbdb.el
+
+(autoload 'org-bbdb-anniversaries "org-bbdb" "\
+Extract anniversaries from BBDB for display in the agenda.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here
+;;;;;; org-capture) "org-capture" "org-capture.el" (20583 28515))
+;;; Generated autoloads from org-capture.el
+
+(defvar org-capture-initial nil)
+
+(autoload 'org-capture "org-capture" "\
+Capture something.
+\\<org-capture-mode-map>
+This will let you select a template from `org-capture-templates', and then
+file the newly captured information. The text is immediately inserted
+at the target location, and an indirect buffer is shown where you can
+edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
+of Emacs, so that you can continue your work.
+
+When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
+anything, just go to the file/headline where the selected template
+stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note
+stored.
+
+When called with a `C-0' (zero) prefix, insert a template at point.
+
+Lisp programs can set KEYS to a string associated with a template
+in `org-capture-templates'. In this case, interactive selection
+will be bypassed.
+
+If `org-capture-use-agenda-date' is non-nil, capturing from the
+agenda will use the date at point as the default date.
+
+\(fn &optional GOTO KEYS)" t nil)
+
+(autoload 'org-capture-insert-template-here "org-capture" "\
+Not documented
+
+\(fn)" nil nil)
+
+(autoload 'org-capture-import-remember-templates "org-capture" "\
+Set org-capture-templates to be similar to `org-remember-templates'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable
+;;;;;; org-clock-in-last) "org-clock" "org-clock.el" (20581 51586))
+;;; Generated autoloads from org-clock.el
+
+(autoload 'org-clock-in-last "org-clock" "\
+Clock in the last closed clocked item.
+When already clocking in, send an warning.
+With a universal prefix argument, select the task you want to
+clock in from the last clocked in tasks.
+With two universal prefix arguments, start clocking using the
+last clock-out time, if any.
+With three universal prefix arguments, interactively prompt
+for a todo state to switch to, overriding the existing value
+`org-clock-in-switch-to-state'.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-get-clocktable "org-clock" "\
+Get a formatted clocktable with parameters according to PROPS.
+The table is created in a temporary buffer, fully formatted and
+fontified, and then returned.
+
+\(fn &rest PROPS)" nil nil)
+
+(autoload 'org-clock-persistence-insinuate "org-clock" "\
+Set up hooks for clock persistence.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-check-version) "org-compat" "org-compat.el"
+;;;;;; (20559 38989))
+;;; Generated autoloads from org-compat.el
+
+(autoload 'org-check-version "org-compat" "\
+Try very hard to provide sensible version strings.
+
+\(fn)" nil (quote macro))
+
+;;;***
+
+;;;### (autoloads (org-datetree-find-date-create) "org-datetree"
+;;;;;; "org-datetree.el" (20583 28515))
+;;; Generated autoloads from org-datetree.el
+
+(autoload 'org-datetree-find-date-create "org-datetree" "\
+Find or create an entry for DATE.
+If KEEP-RESTRICTION is non-nil, do not widen the buffer.
+When it is nil, the buffer will be widened to make sure an existing date
+tree can be found.
+
+\(fn DATE &optional KEEP-RESTRICTION)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open
+;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook
+;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch)
+;;;;;; "org-docbook" "org-docbook.el" (20535 39591))
+;;; Generated autoloads from org-docbook.el
+
+(autoload 'org-export-as-docbook-batch "org-docbook" "\
+Call `org-export-as-docbook' in batch style.
+This function can be used in batch processing.
+
+For example:
+
+$ emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --visit=MyOrgFile.org --funcall org-export-as-docbook-batch
+
+\(fn)" nil nil)
+
+(autoload 'org-export-as-docbook-to-buffer "org-docbook" "\
+Call `org-export-as-docbook' with output to a temporary buffer.
+No file is created.
+
+\(fn)" t nil)
+
+(autoload 'org-replace-region-by-docbook "org-docbook" "\
+Replace the region from BEG to END with its DocBook export.
+It assumes the region has `org-mode' syntax, and then convert it to
+DocBook. This can be used in any buffer. For example, you could
+write an itemized list in `org-mode' syntax in an DocBook buffer and
+then use this command to convert it.
+
+\(fn BEG END)" t nil)
+
+(autoload 'org-export-region-as-docbook "org-docbook" "\
+Convert region from BEG to END in `org-mode' buffer to DocBook.
+If prefix arg BODY-ONLY is set, omit file header and footer and
+only produce the region of converted text, useful for
+cut-and-paste operations. If BUFFER is a buffer or a string,
+use/create that buffer as a target of the converted DocBook. If
+BUFFER is the symbol `string', return the produced DocBook as a
+string and leave not buffer behind. For example, a Lisp program
+could call this function in the following way:
+
+ (setq docbook (org-export-region-as-docbook beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer.
+
+\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
+
+(autoload 'org-export-as-docbook-pdf "org-docbook" "\
+Export as DocBook XML file, and generate PDF file.
+
+\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-export-as-docbook-pdf-and-open "org-docbook" "\
+Export as DocBook XML file, generate PDF file, and open it.
+
+\(fn)" t nil)
+
+(autoload 'org-export-as-docbook "org-docbook" "\
+Export the current buffer as a DocBook file.
+If there is an active region, export only the region. When
+HIDDEN is obsolete and does nothing. EXT-PLIST is a
+property list with external parameters overriding org-mode's
+default settings, but still inferior to file-local settings.
+When TO-BUFFER is non-nil, create a buffer with that name and
+export to that buffer. If TO-BUFFER is the symbol `string',
+don't leave any buffer behind but just return the resulting HTML
+as a string. When BODY-ONLY is set, don't produce the file
+header and footer, simply return the content of the document (all
+top-level sections). When PUB-DIR is set, use this as the
+publishing directory.
+
+\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data)
+;;;;;; "org-element" "org-element.el" (20582 46050))
+;;; Generated autoloads from org-element.el
+
+(autoload 'org-element-interpret-data "org-element" "\
+Interpret DATA as Org syntax.
+
+DATA is a parse tree, an element, an object or a secondary string
+to interpret.
+
+Optional argument PARENT is used for recursive calls. It contains
+the element or object containing data, or nil.
+
+Return Org syntax as a string.
+
+\(fn DATA &optional PARENT)" nil nil)
+
+(autoload 'org-element-at-point "org-element" "\
+Determine closest element around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element and PROPS a plist of properties associated to the
+element.
+
+Possible types are defined in `org-element-all-elements'.
+Properties depend on element or object type, but always
+include :begin, :end, :parent and :post-blank properties.
+
+As a special case, if point is at the very beginning of a list or
+sub-list, returned element will be that list instead of the first
+item. In the same way, if point is at the beginning of the first
+row of a table, returned element will be the table instead of the
+first row.
+
+If optional argument KEEP-TRAIL is non-nil, the function returns
+a list of of elements leading to element at point. The list's
+CAR is always the element at point. Following positions contain
+element's siblings, then parents, siblings of parents, until the
+first element of current section.
+
+\(fn &optional KEEP-TRAIL)" nil nil)
+
+(autoload 'org-element-context "org-element" "\
+Return closest element or object around point.
+
+Return value is a list like (TYPE PROPS) where TYPE is the type
+of the element or object and PROPS a plist of properties
+associated to it.
+
+Possible types are defined in `org-element-all-elements' and
+`org-element-all-objects'. Properties depend on element or
+object type, but always include :begin, :end, :parent
+and :post-blank properties.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-insert-export-options-template org-export-as-org
+;;;;;; org-export-visible org-export) "org-exp" "org-exp.el" (20568
+;;;;;; 20361))
+;;; Generated autoloads from org-exp.el
+
+(autoload 'org-export "org-exp" "\
+Export dispatcher for Org-mode.
+When `org-export-run-in-background' is non-nil, try to run the command
+in the background. This will be done only for commands that write
+to a file. For details see the docstring of `org-export-run-in-background'.
+
+The prefix argument ARG will be passed to the exporter. However, if
+ARG is a double universal prefix \\[universal-argument] \\[universal-argument], that means to inverse the
+value of `org-export-run-in-background'.
+
+If `org-export-initial-scope' is set to 'subtree, try to export
+the current subtree, otherwise try to export the whole buffer.
+Pressing `1' will switch between these two options.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-export-visible "org-exp" "\
+Create a copy of the visible part of the current buffer, and export it.
+The copy is created in a temporary buffer and removed after use.
+TYPE is the final key (as a string) that also selects the export command in
+the \\<org-mode-map>\\[org-export] export dispatcher.
+As a special case, if the you type SPC at the prompt, the temporary
+org-mode file will not be removed but presented to you so that you can
+continue to use it. The prefix arg ARG is passed through to the exporting
+command.
+
+\(fn TYPE ARG)" t nil)
+
+(autoload 'org-export-as-org "org-exp" "\
+Make a copy with not-exporting stuff removed.
+The purpose of this function is to provide a way to export the source
+Org file of a webpage in Org format, but with sensitive and/or irrelevant
+stuff removed. This command will remove the following:
+
+- archived trees (if the variable `org-export-with-archived-trees' is nil)
+- comment blocks and trees starting with the COMMENT keyword
+- only trees that are consistent with `org-export-select-tags'
+ and `org-export-exclude-tags'.
+
+The only arguments that will be used are EXT-PLIST and PUB-DIR,
+all the others will be ignored (but are present so that the general
+mechanism to call publishing functions will work).
+
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When PUB-DIR is set, use this as the publishing
+directory.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-insert-export-options-template "org-exp" "\
+Insert into the buffer a template with information for exporting.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update
+;;;;;; org-feed-update-all) "org-feed" "org-feed.el" (20535 39591))
+;;; Generated autoloads from org-feed.el
+
+(autoload 'org-feed-update-all "org-feed" "\
+Get inbox items from all feeds in `org-feed-alist'.
+
+\(fn)" t nil)
+
+(autoload 'org-feed-update "org-feed" "\
+Get inbox items from FEED.
+FEED can be a string with an association in `org-feed-alist', or
+it can be a list structured like an entry in `org-feed-alist'.
+
+\(fn FEED &optional RETRIEVE-ONLY)" t nil)
+
+(autoload 'org-feed-goto-inbox "org-feed" "\
+Go to the inbox that captures the feed named FEED.
+
+\(fn FEED)" t nil)
+
+(autoload 'org-feed-show-raw-feed "org-feed" "\
+Show the raw feed buffer of a feed.
+
+\(fn FEED)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
+;;;;;; "org-footnote.el" (20535 39591))
+;;; Generated autoloads from org-footnote.el
+
+(autoload 'org-footnote-action "org-footnote" "\
+Do the right thing for footnotes.
+
+When at a footnote reference, jump to the definition.
+
+When at a definition, jump to the references if they exist, offer
+to create them otherwise.
+
+When neither at definition or reference, create a new footnote,
+interactively.
+
+With prefix arg SPECIAL, offer additional commands in a menu.
+
+\(fn &optional SPECIAL)" t nil)
+
+(autoload 'org-footnote-normalize "org-footnote" "\
+Collect the footnotes in various formats and normalize them.
+
+This finds the different sorts of footnotes allowed in Org, and
+normalizes them to the usual [N] format that is understood by the
+Org-mode exporters.
+
+When SORT-ONLY is set, only sort the footnote definitions into the
+referenced sequence.
+
+If Org is amidst an export process, EXPORT-PROPS will hold the
+export properties of the buffer.
+
+When EXPORT-PROPS is non-nil, the default action is to insert
+normalized footnotes towards the end of the pre-processing
+buffer. Some exporters (docbook, odt...) expect footnote
+definitions to be available before any references to them. Such
+exporters can let bind `org-footnote-insert-pos-for-preprocessor'
+to symbol `point-min' to achieve the desired behaviour.
+
+Additional note on `org-footnote-insert-pos-for-preprocessor':
+1. This variable has not effect when FOR-PREPROCESSOR is nil.
+2. This variable (potentially) obviates the need for extra scan
+ of pre-processor buffer as witnessed in
+ `org-export-docbook-get-footnotes'.
+
+\(fn &optional SORT-ONLY EXPORT-PROPS)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree
+;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node
+;;;;;; org-freemind-show org-export-as-freemind) "org-freemind"
+;;;;;; "org-freemind.el" (20569 35225))
+;;; Generated autoloads from org-freemind.el
+
+(autoload 'org-export-as-freemind "org-freemind" "\
+Export the current buffer as a Freemind file.
+If there is an active region, export only the region. HIDDEN is
+obsolete and does nothing. EXT-PLIST is a property list with
+external parameters overriding org-mode's default settings, but
+still inferior to file-local settings. When TO-BUFFER is
+non-nil, create a buffer with that name and export to that
+buffer. If TO-BUFFER is the symbol `string', don't leave any
+buffer behind but just return the resulting HTML as a string.
+When BODY-ONLY is set, don't produce the file header and footer,
+simply return the content of the document (all top level
+sections). When PUB-DIR is set, use this as the publishing
+directory.
+
+See `org-freemind-from-org-mode' for more information.
+
+\(fn &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-freemind-show "org-freemind" "\
+Show file MM-FILE in Freemind.
+
+\(fn MM-FILE)" t nil)
+
+(autoload 'org-freemind-from-org-mode-node "org-freemind" "\
+Convert node at line NODE-LINE to the FreeMind file MM-FILE.
+See `org-freemind-from-org-mode' for more information.
+
+\(fn NODE-LINE MM-FILE)" t nil)
+
+(autoload 'org-freemind-from-org-mode "org-freemind" "\
+Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
+All the nodes will be opened or closed in Freemind just as you
+have them in `org-mode'.
+
+Note that exporting to Freemind also gives you an alternative way
+to export from `org-mode' to html. You can create a dynamic html
+version of the your org file, by first exporting to Freemind and
+then exporting from Freemind to html. The 'As
+XHTML (JavaScript)' version in Freemind works very well (and you
+can use a CSS stylesheet to style it).
+
+\(fn ORG-FILE MM-FILE)" t nil)
+
+(autoload 'org-freemind-from-org-sparse-tree "org-freemind" "\
+Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE.
+
+\(fn ORG-BUFFER MM-FILE)" t nil)
+
+(autoload 'org-freemind-to-org-mode "org-freemind" "\
+Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE.
+
+\(fn MM-FILE ORG-FILE)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html
+;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer
+;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html"
+;;;;;; "org-html.el" (20562 57177))
+;;; Generated autoloads from org-html.el
+
+(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
+
+(put 'org-export-html-style 'safe-local-variable 'stringp)
+
+(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
+
+(autoload 'org-export-as-html-and-open "org-html" "\
+Export the outline as HTML and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-export-as-html-batch "org-html" "\
+Call the function `org-export-as-html'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-html-batch
+
+\(fn)" nil nil)
+
+(autoload 'org-export-as-html-to-buffer "org-html" "\
+Call `org-export-as-html` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-html'.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-replace-region-by-html "org-html" "\
+Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use this
+command to convert it.
+
+\(fn BEG END)" t nil)
+
+(autoload 'org-export-region-as-html "org-html" "\
+Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-export-region-as-html beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer.
+
+\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
+
+(autoload 'org-export-as-html "org-html" "\
+Export the outline as a pretty HTML file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting HTML as a string. When BODY-ONLY is set, don't produce
+the file header and footer, simply return the content of
+<body>...</body>, without even the body tags themselves. When
+PUB-DIR is set, use this as the publishing directory.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-export-htmlize-generate-css "org-html" "\
+Create the CSS for all font definitions in the current Emacs session.
+Use this to create face definitions in your CSS style file that can then
+be used by code snippets transformed by htmlize.
+This command just produces a buffer that contains class definitions for all
+faces used in the current Emacs session. You can copy and paste the ones you
+need into your CSS file.
+
+If you then set `org-export-htmlize-output-type' to `css', calls to
+the function `org-export-htmlize-region-for-paste' will produce code
+that uses these same face definitions.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files
+;;;;;; org-export-icalendar-this-file) "org-icalendar" "org-icalendar.el"
+;;;;;; (20540 44570))
+;;; Generated autoloads from org-icalendar.el
+
+(autoload 'org-export-icalendar-this-file "org-icalendar" "\
+Export current file as an iCalendar file.
+The iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'.
+
+\(fn)" t nil)
+
+(autoload 'org-export-icalendar-all-agenda-files "org-icalendar" "\
+Export all files in the variable `org-agenda-files' to iCalendar .ics files.
+Each iCalendar file will be located in the same directory as the Org-mode
+file, but with extension `.ics'.
+
+\(fn)" t nil)
+
+(autoload 'org-export-icalendar-combine-agenda-files "org-icalendar" "\
+Export all files in `org-agenda-files' to a single combined iCalendar file.
+The file is stored under the name `org-combined-agenda-icalendar-file'.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find
+;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion
+;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org-id.el"
+;;;;;; (20583 28515))
+;;; Generated autoloads from org-id.el
+
+(autoload 'org-id-get-create "org-id" "\
+Create an ID for the current entry and return it.
+If the entry already has an ID, just return it.
+With optional argument FORCE, force the creation of a new ID.
+
+\(fn &optional FORCE)" t nil)
+
+(autoload 'org-id-copy "org-id" "\
+Copy the ID of the entry at point to the kill ring.
+Create an ID if necessary.
+
+\(fn)" t nil)
+
+(autoload 'org-id-get "org-id" "\
+Get the ID property of the entry at point-or-marker POM.
+If POM is nil, refer to the entry at point.
+If the entry does not have an ID, the function returns nil.
+However, when CREATE is non nil, create an ID if none is present already.
+PREFIX will be passed through to `org-id-new'.
+In any case, the ID of the entry is returned.
+
+\(fn &optional POM CREATE PREFIX)" nil nil)
+
+(autoload 'org-id-get-with-outline-path-completion "org-id" "\
+Use outline-path-completion to retrieve the ID of an entry.
+TARGETS may be a setting for `org-refile-targets' to define the eligible
+headlines. When omitted, all headlines in all agenda files are
+eligible.
+It returns the ID of the entry. If necessary, the ID is created.
+
+\(fn &optional TARGETS)" nil nil)
+
+(autoload 'org-id-get-with-outline-drilling "org-id" "\
+Use an outline-cycling interface to retrieve the ID of an entry.
+This only finds entries in the current buffer, using `org-get-location'.
+It returns the ID of the entry. If necessary, the ID is created.
+
+\(fn &optional TARGETS)" nil nil)
+
+(autoload 'org-id-goto "org-id" "\
+Switch to the buffer containing the entry with id ID.
+Move the cursor to that entry in that buffer.
+
+\(fn ID)" t nil)
+
+(autoload 'org-id-find "org-id" "\
+Return the location of the entry with the id ID.
+The return value is a cons cell (file-name . position), or nil
+if there is no entry with that ID.
+With optional argument MARKERP, return the position as a new marker.
+
+\(fn ID &optional MARKERP)" nil nil)
+
+(autoload 'org-id-find-id-file "org-id" "\
+Query the id database for the file in which this ID is located.
+
+\(fn ID)" nil nil)
+
+(autoload 'org-id-store-link "org-id" "\
+Store a link to the current entry, using its ID.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el"
+;;;;;; (20535 39591))
+;;; Generated autoloads from org-indent.el
+
+(autoload 'org-indent-mode "org-indent" "\
+When active, indent text according to outline structure.
+
+Internally this works by adding `line-prefix' and `wrap-prefix'
+properties, after each buffer modification, on the modified zone.
+
+The process is synchronous. Though, initial indentation of
+buffer, which can take a few seconds on large buffers, is done
+during idle time.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-irc-store-link) "org-irc" "org-irc.el" (20535
+;;;;;; 39646))
+;;; Generated autoloads from org-irc.el
+
+(autoload 'org-irc-store-link "org-irc" "\
+Dispatch to the appropriate function to store a link to an IRC session.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex
+;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer
+;;;;;; org-export-as-latex-batch) "org-latex" "org-latex.el" (20583
+;;;;;; 28515))
+;;; Generated autoloads from org-latex.el
+
+(autoload 'org-export-as-latex-batch "org-latex" "\
+Call `org-export-as-latex', may be used in batch processing.
+For example:
+
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-latex-batch
+
+\(fn)" nil nil)
+
+(autoload 'org-export-as-latex-to-buffer "org-latex" "\
+Call `org-export-as-latex` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-latex'.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-replace-region-by-latex "org-latex" "\
+Replace the region from BEG to END with its LaTeX export.
+It assumes the region has `org-mode' syntax, and then convert it to
+LaTeX. This can be used in any buffer. For example, you could
+write an itemized list in `org-mode' syntax in an LaTeX buffer and
+then use this command to convert it.
+
+\(fn BEG END)" t nil)
+
+(autoload 'org-export-region-as-latex "org-latex" "\
+Convert region from BEG to END in `org-mode' buffer to LaTeX.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted LaTeX. If BUFFER is the symbol `string', return the
+produced LaTeX as a string and leave no buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq latex (org-export-region-as-latex beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer.
+
+\(fn BEG END &optional BODY-ONLY BUFFER)" t nil)
+
+(autoload 'org-export-as-latex "org-latex" "\
+Export current buffer to a LaTeX file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will be exported
+depending on `org-export-latex-low-levels'. The default is to
+convert them as description lists.
+HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with
+external parameters overriding org-mode's default settings, but
+still inferior to file-local settings. When TO-BUFFER is
+non-nil, create a buffer with that name and export to that
+buffer. If TO-BUFFER is the symbol `string', don't leave any
+buffer behind but just return the resulting LaTeX as a string.
+When BODY-ONLY is set, don't produce the file header and footer,
+simply return the content of \\begin{document}...\\end{document},
+without even the \\begin{document} and \\end{document} commands.
+when PUB-DIR is set, use this as the publishing directory.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-export-as-pdf "org-latex" "\
+Export as LaTeX, then process through to PDF.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-export-as-pdf-and-open "org-latex" "\
+Export as LaTeX, then process through to PDF, and open.
+
+\(fn ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-lparse-region org-replace-region-by org-lparse-to-buffer
+;;;;;; org-lparse-batch org-lparse-and-open) "org-lparse" "org-lparse.el"
+;;;;;; (20580 53523))
+;;; Generated autoloads from org-lparse.el
+
+(autoload 'org-lparse-and-open "org-lparse" "\
+Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists.
+
+\(fn TARGET-BACKEND NATIVE-BACKEND ARG &optional FILE-OR-BUF)" nil nil)
+
+(autoload 'org-lparse-batch "org-lparse" "\
+Call the function `org-lparse'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-lparse-batch
+
+\(fn TARGET-BACKEND &optional NATIVE-BACKEND)" nil nil)
+
+(autoload 'org-lparse-to-buffer "org-lparse" "\
+Call `org-lparse' with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to
+`org-lparse'.
+
+\(fn BACKEND ARG)" nil nil)
+
+(autoload 'org-replace-region-by "org-lparse" "\
+Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use
+this command to convert it.
+
+\(fn BACKEND BEG END)" nil nil)
+
+(autoload 'org-lparse-region "org-lparse" "\
+Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-lparse-region \"html\" beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer.
+
+\(fn BACKEND BEG END &optional BODY-ONLY BUFFER)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull
+;;;;;; org-mobile-push) "org-mobile" "org-mobile.el" (20540 44570))
+;;; Generated autoloads from org-mobile.el
+
+(autoload 'org-mobile-push "org-mobile" "\
+Push the current state of Org affairs to the WebDAV directory.
+This will create the index file, copy all agenda files there, and also
+create all custom agenda views, for upload to the mobile phone.
+
+\(fn)" t nil)
+
+(autoload 'org-mobile-pull "org-mobile" "\
+Pull the contents of `org-mobile-capture-file' and integrate them.
+Apply all flagged actions, flag entries to be flagged and then call an
+agenda view showing the flagged items.
+
+\(fn)" t nil)
+
+(autoload 'org-mobile-create-sumo-agenda "org-mobile" "\
+Create a file that contains all custom agenda views.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-export-as-odf-and-open org-export-as-odf org-export-odt-convert
+;;;;;; org-export-as-odt org-export-as-odt-batch org-export-as-odt-and-open)
+;;;;;; "org-odt" "org-odt.el" (20581 51586))
+;;; Generated autoloads from org-odt.el
+
+(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
+
+(autoload 'org-export-as-odt-and-open "org-odt" "\
+Export the outline as ODT and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-export-as-odt-batch "org-odt" "\
+Call the function `org-lparse-batch'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-odt-batch
+
+\(fn)" nil nil)
+
+(autoload 'org-export-as-odt "org-odt" "\
+Export the outline as a OpenDocumentText file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting XML as a string. When BODY-ONLY is set, don't produce
+the file header and footer, simply return the content of
+<body>...</body>, without even the body tags themselves. When
+PUB-DIR is set, use this as the publishing directory.
+
+\(fn ARG &optional HIDDEN EXT-PLIST TO-BUFFER BODY-ONLY PUB-DIR)" t nil)
+
+(autoload 'org-export-odt-convert "org-odt" "\
+Convert IN-FILE to format OUT-FMT using a command line converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. OUT-FMT is the desired output
+format. Use `org-export-odt-convert-process' as the converter.
+If PREFIX-ARG is non-nil then the newly converted file is opened
+using `org-open-file'.
+
+\(fn &optional IN-FILE OUT-FMT PREFIX-ARG)" t nil)
+
+(autoload 'org-export-as-odf "org-odt" "\
+Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
+Use `org-create-math-formula' to convert LATEX-FRAG first to
+MathML. When invoked as an interactive command, use
+`org-latex-regexps' to infer LATEX-FRAG from currently active
+region. If no LaTeX fragments are found, prompt for it. Push
+MathML source to kill ring, if `org-export-copy-to-kill-ring' is
+non-nil.
+
+\(fn LATEX-FRAG &optional ODF-FILE)" t nil)
+
+(autoload 'org-export-as-odf-and-open "org-odt" "\
+Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" (20535
+;;;;;; 39591))
+;;; Generated autoloads from org-plot.el
+
+(autoload 'org-plot/gnuplot "org-plot" "\
+Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
+If not given options will be taken from the +PLOT
+line directly before or after the table.
+
+\(fn &optional PARAMS)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-publish-current-project org-publish-current-file
+;;;;;; org-publish-all org-publish) "org-publish" "org-publish.el"
+;;;;;; (20581 49187))
+;;; Generated autoloads from org-publish.el
+
+(defalias 'org-publish-project 'org-publish)
+
+(autoload 'org-publish "org-publish" "\
+Publish PROJECT.
+
+\(fn PROJECT &optional FORCE)" t nil)
+
+(autoload 'org-publish-all "org-publish" "\
+Publish all projects.
+With prefix argument, remove all files in the timestamp
+directory and force publishing all files.
+
+\(fn &optional FORCE)" t nil)
+
+(autoload 'org-publish-current-file "org-publish" "\
+Publish the current file.
+With prefix argument, force publish the file.
+
+\(fn &optional FORCE)" t nil)
+
+(autoload 'org-publish-current-project "org-publish" "\
+Publish the project associated with the current file.
+With a prefix argument, force publishing of all files in
+the project.
+
+\(fn &optional FORCE)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template
+;;;;;; org-remember-annotation org-remember-insinuate) "org-remember"
+;;;;;; "org-remember.el" (20535 39646))
+;;; Generated autoloads from org-remember.el
+
+(autoload 'org-remember-insinuate "org-remember" "\
+Setup remember.el for use with Org-mode.
+
+\(fn)" nil nil)
+
+(autoload 'org-remember-annotation "org-remember" "\
+Return a link to the current location as an annotation for remember.el.
+If you are using Org-mode files as target for data storage with
+remember.el, then the annotations should include a link compatible with the
+conventions in Org-mode. This function returns such a link.
+
+\(fn)" nil nil)
+
+(autoload 'org-remember-apply-template "org-remember" "\
+Initialize *remember* buffer with template, invoke `org-mode'.
+This function should be placed into `remember-mode-hook' and in fact requires
+to be run from that hook to function properly.
+
+\(fn &optional USE-CHAR SKIP-INTERACTIVE)" nil nil)
+
+(autoload 'org-remember "org-remember" "\
+Call `remember'. If this is already a remember buffer, re-apply template.
+If there is an active region, make sure remember uses it as initial content
+of the remember buffer.
+
+When called interactively with a \\[universal-argument] prefix argument GOTO, don't remember
+anything, just go to the file/headline where the selected template usually
+stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last
+note stored by remember.
+
+Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
+associated with a template in `org-remember-templates'.
+
+\(fn &optional GOTO ORG-FORCE-REMEMBER-TEMPLATE-CHAR)" t nil)
+
+(autoload 'org-remember-handler "org-remember" "\
+Store stuff from remember.el into an org file.
+When the template has specified a file and a headline, the entry is filed
+there, or in the location defined by `org-default-notes-file' and
+`org-remember-default-headline'.
+\\<org-remember-mode-map>
+If no defaults have been defined, or if the current prefix argument
+is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive
+process is used to select the target location.
+
+When the prefix is 0 (i.e. when remember is exited with C-0 \\[org-remember-finalize]),
+the entry is filed to the same location as the previous note.
+
+When the prefix is 2 (i.e. when remember is exited with C-2 \\[org-remember-finalize]),
+the entry is filed as a subentry of the entry where the clock is
+currently running.
+
+When \\[universal-argument] has been used as prefix argument, the
+note is stored and Emacs moves point to the new location of the
+note, so that editing can be continued there (similar to
+inserting \"%&\" into the template).
+
+Before storing the note, the function ensures that the text has an
+org-mode-style headline, i.e. a first line that starts with
+a \"*\". If not, a headline is constructed from the current date and
+some additional data.
+
+If the variable `org-adapt-indentation' is non-nil, the entire text is
+also indented so that it starts in the same column as the headline
+\(i.e. after the stars).
+
+See also the variable `org-reverse-note-order'.
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl org-table-iterate-buffer-tables
+;;;;;; org-table-recalculate-buffer-tables) "org-table" "org-table.el"
+;;;;;; (20581 53986))
+;;; Generated autoloads from org-table.el
+
+(autoload 'org-table-recalculate-buffer-tables "org-table" "\
+Recalculate all tables in the current buffer.
+
+\(fn)" t nil)
+
+(autoload 'org-table-iterate-buffer-tables "org-table" "\
+Iterate all tables in the buffer, to converge inter-table dependencies.
+
+\(fn)" t nil)
+
+(autoload 'turn-on-orgtbl "org-table" "\
+Unconditionally turn on `orgtbl-mode'.
+
+\(fn)" nil nil)
+
+(autoload 'orgtbl-mode "org-table" "\
+The `org-mode' table editor as a minor mode for use in other modes.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-table-to-lisp "org-table" "\
+Convert the table at point to a Lisp structure.
+The structure will be a list. Each item is either the symbol `hline'
+for a horizontal separator line, or a list of field values as strings.
+The table is taken from the parameter TXT, or from the buffer at point.
+
+\(fn &optional TXT)" nil nil)
+
+;;;***
+
+;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler)
+;;;;;; "org-taskjuggler" "org-taskjuggler.el" (20538 30195))
+;;; Generated autoloads from org-taskjuggler.el
+
+(autoload 'org-export-as-taskjuggler "org-taskjuggler" "\
+Export parts of the current buffer as a TaskJuggler file.
+The exporter looks for a tree with tag, property or todo that
+matches `org-export-taskjuggler-project-tag' and takes this as
+the tasks for this project. The first node of this tree defines
+the project properties such as project name and project period.
+If there is a tree with tag, property or todo that matches
+`org-export-taskjuggler-resource-tag' this three is taken as
+resources for the project. If no resources are specified, a
+default resource is created and allocated to the project. Also
+the taskjuggler project will be created with default reports as
+defined in `org-export-taskjuggler-default-reports'.
+
+\(fn)" t nil)
+
+(autoload 'org-export-as-taskjuggler-and-open "org-taskjuggler" "\
+Export the current buffer as a TaskJuggler file and open it
+with the TaskJuggler GUI.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
+;;;;;; org-timer org-timer-stop org-timer-pause-or-continue org-timer-start)
+;;;;;; "org-timer" "org-timer.el" (20542 22690))
+;;; Generated autoloads from org-timer.el
+
+(autoload 'org-timer-start "org-timer" "\
+Set the starting time for the relative timer to now.
+When called with prefix argument OFFSET, prompt the user for an offset time,
+with the default taken from a timer stamp at point, if any.
+If OFFSET is a string or an integer, it is directly taken to be the offset
+without user interaction.
+When called with a double prefix arg, all timer strings in the active
+region will be shifted by a specific amount. You will be prompted for
+the amount, with the default to make the first timer string in
+the region 0:00:00.
+
+\(fn &optional OFFSET)" t nil)
+
+(autoload 'org-timer-pause-or-continue "org-timer" "\
+Pause or continue the relative timer.
+With prefix arg STOP, stop it entirely.
+
+\(fn &optional STOP)" t nil)
+
+(autoload 'org-timer-stop "org-timer" "\
+Stop the relative timer.
+
+\(fn)" t nil)
+
+(autoload 'org-timer "org-timer" "\
+Insert a H:MM:SS string from the timer into the buffer.
+The first time this command is used, the timer is started. When used with
+a \\[universal-argument] prefix, force restarting the timer.
+When used with a double prefix argument \\[universal-argument], change all the timer string
+in the region by a fixed amount. This can be used to recalibrate a timer
+that was not started at the correct moment.
+
+If NO-INSERT-P is non-nil, return the string instead of inserting
+it in the buffer.
+
+\(fn &optional RESTART NO-INSERT-P)" t nil)
+
+(autoload 'org-timer-change-times-in-region "org-timer" "\
+Change all h:mm:ss time in region by a DELTA.
+
+\(fn BEG END DELTA)" t nil)
+
+(autoload 'org-timer-item "org-timer" "\
+Insert a description-type item with the current timer value.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'org-timer-set-timer "org-timer" "\
+Prompt for a duration and set a timer.
+
+If `org-timer-default-timer' is not zero, suggest this value as
+the default duration for the timer. If a timer is already set,
+prompt the user if she wants to replace it.
+
+Called with a numeric prefix argument, use this numeric value as
+the duration of the timer.
+
+Called with a `C-u' prefix arguments, use `org-timer-default-timer'
+without prompting the user for a duration.
+
+With two `C-u' prefix arguments, use `org-timer-default-timer'
+without prompting the user for a duration and automatically
+replace any running timer.
+
+\(fn &optional OPT)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el"
+;;;;;; (20583 29615))
+;;; Generated autoloads from org-version.el
+
+(autoload 'org-release "org-version" "\
+The release version of org-mode.
+ Inserted by installing org-mode or when a release is made.
+
+\(fn)" nil nil)
+
+(autoload 'org-git-version "org-version" "\
+The Git version of org-mode.
+ Inserted by installing org-mode or when a release is made.
+
+\(fn)" nil nil)
+
+(defconst org-odt-data-dir "/usr/share/emacs/etc/org" "\
+The location of ODT styles.")
+
+;;;***
+
+;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org-xoxo.el" (20535
+;;;;;; 39591))
+;;; Generated autoloads from org-xoxo.el
+
+(autoload 'org-export-as-xoxo "org-xoxo" "\
+Export the org buffer as XOXO.
+The XOXO buffer is named *xoxo-<source buffer name>*
+
+\(fn &optional BUFFER)" t nil)
+
+;;;***
+
+;;;### (autoloads (org-unindent-buffer org-transpose-element org-narrow-to-element
+;;;;;; org-mark-element org-drag-element-forward org-drag-element-backward
+;;;;;; org-up-element org-backward-element org-forward-element org-customize
+;;;;;; org-reload org-require-autoloaded-modules org-submit-bug-report
+;;;;;; org-cycle-agenda-files org-switchb org-map-entries org-update-all-dblocks
+;;;;;; org-open-link-from-string org-open-at-point-global org-insert-link-global
+;;;;;; org-store-link org-run-like-in-org-mode turn-on-orgstruct++
+;;;;;; turn-on-orgstruct orgstruct-mode org-global-cycle org-mode
+;;;;;; org-version org-babel-do-load-languages) "org" "org.el" (20583
+;;;;;; 28515))
+;;; Generated autoloads from org.el
+
+(autoload 'org-babel-do-load-languages "org" "\
+Load the languages defined in `org-babel-load-languages'.
+
+\(fn SYM VALUE)" nil nil)
+
+(autoload 'org-version "org" "\
+Show the org-mode version in the echo area.
+With prefix argument HERE, insert it at point.
+When FULL is non-nil, use a verbose version string.
+When MESSAGE is non-nil, display a message with the version.
+
+\(fn &optional HERE FULL MESSAGE)" t nil)
+
+(autoload 'org-mode "org" "\
+Outline-based notes management and organizer, alias
+\"Carsten's outline-mode for keeping track of everything.\"
+
+Org-mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org-mode is
+implemented on top of outline-mode, which is ideal to keep the content
+of large files well structured. It supports ToDo items, deadlines and
+time stamps, which magically appear in the diary listing of the Emacs
+calendar. Tables are easily created with a built-in table editor.
+Plain text URL-like links connect to websites, emails (VM), Usenet
+messages (Gnus), BBDB entries, and any files related to the project.
+For printing and sharing of notes, an Org-mode file (or a part of it)
+can be exported as a structured ASCII or HTML file.
+
+The following commands are available:
+
+\\{org-mode-map}
+
+\(fn)" t nil)
+
+(defvar org-inlinetask-min-level)
+
+(autoload 'org-global-cycle "org" "\
+Cycle the global visibility. For details see `org-cycle'.
+With \\[universal-argument] prefix arg, switch to startup visibility.
+With a numeric prefix, show all headlines up to that level.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'orgstruct-mode "org" "\
+Toggle the minor mode `orgstruct-mode'.
+This mode is for using Org-mode structure commands in other
+modes. The following keys behave as if Org-mode were active, if
+the cursor is on a headline, or on a plain list item (both as
+defined by Org-mode).
+
+M-up Move entry/item up
+M-down Move entry/item down
+M-left Promote
+M-right Demote
+M-S-up Move entry/item up
+M-S-down Move entry/item down
+M-S-left Promote subtree
+M-S-right Demote subtree
+M-q Fill paragraph and items like in Org-mode
+C-c ^ Sort entries
+C-c - Cycle list bullet
+TAB Cycle item visibility
+M-RET Insert new heading/item
+S-M-RET Insert new TODO heading / Checkbox item
+C-c C-c Set tags / toggle checkbox
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'turn-on-orgstruct "org" "\
+Unconditionally turn on `orgstruct-mode'.
+
+\(fn)" nil nil)
+
+(autoload 'turn-on-orgstruct++ "org" "\
+Unconditionally turn on `orgstruct++-mode'.
+
+\(fn)" nil nil)
+
+(autoload 'org-run-like-in-org-mode "org" "\
+Run a command, pretending that the current buffer is in Org-mode.
+This will temporarily bind local variables that are typically bound in
+Org-mode to the values they have in Org-mode, and then interactively
+call CMD.
+
+\(fn CMD)" nil nil)
+
+(autoload 'org-store-link "org" "\
+\\<org-mode-map>Store an org-link to the current location.
+This link is added to `org-stored-links' and can later be inserted
+into an org-buffer with \\[org-insert-link].
+
+For some link types, a prefix arg is interpreted:
+For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
+For file links, arg negates `org-context-in-file-links'.
+
+\(fn ARG)" t nil)
+
+(autoload 'org-insert-link-global "org" "\
+Insert a link like Org-mode does.
+This command can be called in any mode to insert a link in Org-mode syntax.
+
+\(fn)" t nil)
+
+(autoload 'org-open-at-point-global "org" "\
+Follow a link like Org-mode does.
+This command can be called in any mode to follow a link that has
+Org-mode syntax.
+
+\(fn)" t nil)
+
+(autoload 'org-open-link-from-string "org" "\
+Open a link in the string S, as if it was in Org-mode.
+
+\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
+
+(autoload 'org-update-all-dblocks "org" "\
+Update all dynamic blocks in the buffer.
+This function can be used in a hook.
+
+\(fn)" t nil)
+
+(autoload 'org-map-entries "org" "\
+Call FUNC at each headline selected by MATCH in SCOPE.
+
+FUNC is a function or a lisp form. The function will be called without
+arguments, with the cursor positioned at the beginning of the headline.
+The return values of all calls to the function will be collected and
+returned as a list.
+
+The call to FUNC will be wrapped into a save-excursion form, so FUNC
+does not need to preserve point. After evaluation, the cursor will be
+moved to the end of the line (presumably of the headline of the
+processed entry) and search continues from there. Under some
+circumstances, this may not produce the wanted results. For example,
+if you have removed (e.g. archived) the current (sub)tree it could
+mean that the next entry will be skipped entirely. In such cases, you
+can specify the position from where search should continue by making
+FUNC set the variable `org-map-continue-from' to the desired buffer
+position.
+
+MATCH is a tags/property/todo match as it is used in the agenda tags view.
+Only headlines that are matched by this query will be considered during
+the iteration. When MATCH is nil or t, all headlines will be
+visited by the iteration.
+
+SCOPE determines the scope of this command. It can be any of:
+
+nil The current buffer, respecting the restriction if any
+tree The subtree started with the entry at point
+region The entries within the active region, if any
+region-start-level
+ The entries within the active region, but only those at
+ the same level than the first one.
+file The current buffer, without restriction
+file-with-archives
+ The current buffer, and any archives associated with it
+agenda All agenda files
+agenda-with-archives
+ All agenda files with any archive files associated with them
+\(file1 file2 ...)
+ If this is a list, all files in the list will be scanned
+
+The remaining args are treated as settings for the skipping facilities of
+the scanner. The following items can be given here:
+
+ archive skip trees with the archive tag.
+ comment skip trees with the COMMENT keyword
+ function or Emacs Lisp form:
+ will be used as value for `org-agenda-skip-function', so whenever
+ the function returns t, FUNC will not be called for that
+ entry and search will continue from the point where the
+ function leaves it.
+
+If your function needs to retrieve the tags including inherited tags
+at the *current* entry, you can use the value of the variable
+`org-scanner-tags' which will be much faster than getting the value
+with `org-get-tags-at'. If your function gets properties with
+`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
+to t around the call to `org-entry-properties' to get the same speedup.
+Note that if your function moves around to retrieve tags and properties at
+a *different* entry, you cannot use these techniques.
+
+\(fn FUNC &optional MATCH SCOPE &rest SKIP)" nil nil)
+
+(autoload 'org-switchb "org" "\
+Switch between Org buffers.
+With one prefix argument, restrict available buffers to files.
+With two prefix arguments, restrict available buffers to agenda files.
+
+Defaults to `iswitchb' for buffer name completion.
+Set `org-completion-use-ido' to make it use ido instead.
+
+\(fn &optional ARG)" t nil)
+
+(defalias 'org-ido-switchb 'org-switchb)
+
+(defalias 'org-iswitchb 'org-switchb)
+
+(autoload 'org-cycle-agenda-files "org" "\
+Cycle through the files in `org-agenda-files'.
+If the current buffer visits an agenda file, find the next one in the list.
+If the current buffer does not, find the first agenda file.
+
+\(fn)" t nil)
+
+(autoload 'org-submit-bug-report "org" "\
+Submit a bug report on Org-mode 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 Org-mode version and configuration.
+
+\(fn)" t nil)
+
+(autoload 'org-require-autoloaded-modules "org" "\
+Not documented
+
+\(fn)" t nil)
+
+(autoload 'org-reload "org" "\
+Reload all org lisp files.
+With prefix arg UNCOMPILED, load the uncompiled versions.
+
+\(fn &optional UNCOMPILED)" t nil)
+
+(autoload 'org-customize "org" "\
+Call the customize function with org as argument.
+
+\(fn)" t nil)
+
+(autoload 'org-forward-element "org" "\
+Move forward by one element.
+Move to the next element at the same level, when possible.
+
+\(fn)" t nil)
+
+(autoload 'org-backward-element "org" "\
+Move backward by one element.
+Move to the previous element at the same level, when possible.
+
+\(fn)" t nil)
+
+(autoload 'org-up-element "org" "\
+Move to upper element.
+
+\(fn)" t nil)
+
+(defvar org-element-greater-elements)
+
+(autoload 'org-drag-element-backward "org" "\
+Move backward element at point.
+
+\(fn)" t nil)
+
+(autoload 'org-drag-element-forward "org" "\
+Move forward element at point.
+
+\(fn)" t nil)
+
+(autoload 'org-mark-element "org" "\
+Put point at beginning of this element, mark at end.
+
+Interactively, if this command is repeated or (in Transient Mark
+mode) if the mark is active, it marks the next element after the
+ones already marked.
+
+\(fn)" t nil)
+
+(autoload 'org-narrow-to-element "org" "\
+Narrow buffer to current element.
+
+\(fn)" t nil)
+
+(autoload 'org-transpose-element "org" "\
+Transpose current and previous elements, keeping blank lines between.
+Point is moved after both elements.
+
+\(fn)" t nil)
+
+(autoload 'org-unindent-buffer "org" "\
+Un-indent the visible part of the buffer.
+Relative indentation (between items, inside blocks, etc.) isn't
+modified.
+
+\(fn)" t nil)
+
+;;;***
+
+(provide 'org-install)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; org-install.el ends here
diff --git a/lisp/org-irc.el b/lisp/org-irc.el
new file mode 100644
index 0000000..787eed7
--- /dev/null
+++ b/lisp/org-irc.el
@@ -0,0 +1,255 @@
+;;; org-irc.el --- Store links to IRC sessions
+;;
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Philip Jackson <emacs@shellarchive.co.uk>
+;; Keywords: erc, irc, link, org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file implements links to an IRC session from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+;;
+;; Please customize the variable `org-modules' to select
+;; extensions you would like to use, and to deselect those which you don't
+;; want.
+;;
+;; Please note that at the moment only ERC is supported. Other clients
+;; shouldn't be difficult to add though.
+;;
+;; Then set `org-irc-link-to-logs' to non-nil if you would like a
+;; file:/ type link to be created to the current line in the logs or
+;; to t if you would like to create an irc:/ style link.
+;;
+;; Links within an org buffer might look like this:
+;;
+;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]]
+;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]]
+;; [[irc:/irc.freenode.net/]]
+;;
+;; If, when the resulting link is visited, there is no connection to a
+;; requested server then one will be created.
+
+;;; Code:
+
+(require 'org)
+
+;; Declare the function form ERC that we use.
+(declare-function erc-current-logfile "erc-log" (&optional buffer))
+(declare-function erc-prompt "erc" ())
+(declare-function erc-default-target "erc" ())
+(declare-function erc-channel-p "erc" (channel))
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-server-buffer "erc" ())
+(declare-function erc-get-server-nickname-list "erc" ())
+(declare-function erc-cmd-JOIN "erc" (channel &optional key))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+(defvar org-irc-client 'erc
+ "The IRC client to act on.")
+(defvar org-irc-link-to-logs nil
+ "Non-nil will store a link to the logs, nil will store an irc: style link.")
+
+(defvar erc-default-port) ; dynamically scoped from erc.el
+(defvar erc-session-port) ; dynamically scoped form erc-backend.el
+(defvar erc-session-server) ; dynamically scoped form erc-backend.el
+
+;; Generic functions/config (extend these for other clients)
+
+(add-to-list 'org-store-link-functions 'org-irc-store-link)
+
+(org-add-link-type "irc" 'org-irc-visit nil)
+
+(defun org-irc-visit (link)
+ "Parse LINK and dispatch to the correct function based on the client found."
+ (let ((link (org-irc-parse-link link)))
+ (cond
+ ((eq org-irc-client 'erc)
+ (org-irc-visit-erc link))
+ (t
+ (error "ERC only known client")))))
+
+(defun org-irc-parse-link (link)
+ "Parse an IRC LINK and return the attributes found.
+Parse a LINK that looks like server:port/chan/user (port, chan
+and user being optional) and return any of the port, channel or user
+attributes that are found."
+ (let* ((parts (split-string link "/" t))
+ (len (length parts)))
+ (when (or (< len 1) (> len 3))
+ (error "Failed to parse link needed 1-3 parts, got %d" len))
+ (setcar parts (split-string (car parts) ":" t))
+ parts))
+
+;;;###autoload
+(defun org-irc-store-link ()
+ "Dispatch to the appropriate function to store a link to an IRC session."
+ (cond
+ ((eq major-mode 'erc-mode)
+ (org-irc-erc-store-link))))
+
+(defun org-irc-elipsify-description (string &optional after)
+ "Remove unnecessary white space from STRING and add ellipses if necessary.
+Strip starting and ending white space from STRING and replace any
+chars that the value AFTER with '...'"
+ (let* ((after (number-to-string (or after 30)))
+ (replace-map (list (cons "^[ \t]*" "")
+ (cons "[ \t]*$" "")
+ (cons (concat "^\\(.\\{" after
+ "\\}\\).*") "\\1..."))))
+ (mapc (lambda (x)
+ (when (string-match (car x) string)
+ (setq string (replace-match (cdr x) nil nil string))))
+ replace-map)
+ string))
+
+;; ERC specific functions
+
+(defun org-irc-erc-get-line-from-log (erc-line)
+ "Find the best line to link to from the ERC logs given ERC-LINE as a start.
+If the user is on the ERC-prompt then search backward for the
+first non-blank line, otherwise return the current line. The
+result is a cons of the filename and search string."
+ (erc-save-buffer-in-logs)
+ (require 'erc-log)
+ (with-current-buffer (find-file-noselect (erc-current-logfile))
+ (goto-char (point-max))
+ (list
+ (abbreviate-file-name buffer-file-name)
+ ;; can we get a '::' part?
+ (if (string= erc-line (erc-prompt))
+ (progn
+ (goto-char (point-at-bol))
+ (when (search-backward-regexp "^[^ ]" nil t)
+ (buffer-substring-no-properties (point-at-bol)
+ (point-at-eol))))
+ (when (search-backward erc-line nil t)
+ (buffer-substring-no-properties (point-at-bol)
+ (point-at-eol)))))))
+
+(defun org-irc-erc-store-link ()
+ "Store a link to the IRC log file or the session itself.
+Depending on the variable `org-irc-link-to-logs' store either a
+link to the log file for the current session or an irc: link to
+the session itself."
+ (require 'erc-log)
+ (if org-irc-link-to-logs
+ (let* ((erc-line (buffer-substring-no-properties
+ (point-at-bol) (point-at-eol)))
+ (parsed-line (org-irc-erc-get-line-from-log erc-line)))
+ (if (erc-logging-enabled nil)
+ (progn
+ (org-store-link-props
+ :type "file"
+ :description (concat "'" (org-irc-elipsify-description
+ (cadr parsed-line) 20)
+ "' from an IRC conversation")
+ :link (concat "file:" (car parsed-line) "::"
+ (cadr parsed-line)))
+ t)
+ (error "This ERC session is not being logged")))
+ (let* ((link-text (org-irc-get-erc-link))
+ (link (org-irc-parse-link link-text)))
+ (if link-text
+ (progn
+ (org-store-link-props
+ :type "irc"
+ :link (concat "irc:/" link-text)
+ :description (concat "irc session '" link-text "'")
+ :server (car (car link))
+ :port (or (string-to-number (cadr (pop link))) erc-default-port)
+ :nick (pop link))
+ t)
+ (error "Failed to create ('irc:/' style) ERC link")))))
+
+(defun org-irc-get-erc-link ()
+ "Return an org compatible irc:/ link from an ERC buffer."
+ (let* ((session-port (if (numberp erc-session-port)
+ (number-to-string erc-session-port)
+ erc-session-port))
+ (link (concat erc-session-server ":" session-port)))
+ (concat link "/"
+ (if (and (erc-default-target)
+ (erc-channel-p (erc-default-target))
+ (car (get-text-property (point) 'erc-data)))
+ ;; we can get a nick
+ (let ((nick (car (get-text-property (point) 'erc-data))))
+ (concat (erc-default-target) "/" nick))
+ (erc-default-target)))))
+
+(defun org-irc-get-current-erc-port ()
+ "Return the current port as a number.
+Return the current port number or, if none is set, return the ERC
+default."
+ (cond
+ ((stringp erc-session-port)
+ (string-to-number erc-session-port))
+ ((numberp erc-session-port)
+ erc-session-port)
+ (t
+ erc-default-port)))
+
+(defun org-irc-visit-erc (link)
+ "Visit an ERC buffer based on criteria found in LINK."
+ (require 'erc)
+ (require 'erc-log)
+ (let* ((server (car (car link)))
+ (port (or (string-to-number (cadr (pop link))) erc-default-port))
+ (server-buffer)
+ (buffer-list
+ (erc-buffer-filter
+ (lambda nil
+ (let ((tmp-server-buf (erc-server-buffer)))
+ (and tmp-server-buf
+ (with-current-buffer tmp-server-buf
+ (and
+ (eq (org-irc-get-current-erc-port) port)
+ (string= erc-session-server server)
+ (setq server-buffer tmp-server-buf)))))))))
+ (if buffer-list
+ (let ((chan-name (pop link)))
+ ;; if we got a channel name then switch to it or join it
+ (if chan-name
+ (let ((chan-buf (catch 'found
+ (dolist (x buffer-list)
+ (if (string= (buffer-name x) chan-name)
+ (throw 'found x))))))
+ (if chan-buf
+ (progn
+ (org-pop-to-buffer-same-window chan-buf)
+ ;; if we got a nick, and they're in the chan,
+ ;; then start a chat with them
+ (let ((nick (pop link)))
+ (when nick
+ (if (member nick (erc-get-server-nickname-list))
+ (progn
+ (goto-char (point-max))
+ (insert (concat nick ": ")))
+ (error "%s not found in %s" nick chan-name)))))
+ (progn
+ (org-pop-to-buffer-same-window server-buffer)
+ (erc-cmd-JOIN chan-name))))
+ (org-pop-to-buffer-same-window server-buffer)))
+ ;; no server match, make new connection
+ (erc-select :server server :port port))))
+
+(provide 'org-irc)
+
+;;; org-irc.el ends here
diff --git a/lisp/org-jsinfo.el b/lisp/org-jsinfo.el
new file mode 100644
index 0000000..35d43de
--- /dev/null
+++ b/lisp/org-jsinfo.el
@@ -0,0 +1,262 @@
+;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements the support for Sebastian Rose's JavaScript
+;; org-info.js to display an org-mode file exported to HTML in an
+;; Info-like way, or using folding similar to the outline structure
+;; org org-mode itself.
+
+;; Documentation for using this module is in the Org manual. The script
+;; itself is documented by Sebastian Rose in a file distributed with
+;; the script. FIXME: Accurate pointers!
+
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org-exp)
+(require 'org-html)
+
+(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt))
+(add-hook 'org-export-options-filters 'org-infojs-handle-options)
+
+(defgroup org-infojs nil
+ "Options specific for using org-info.js in HTML export of Org-mode files."
+ :tag "Org Export HTML INFOJS"
+ :group 'org-export-html)
+
+(defcustom org-export-html-use-infojs 'when-configured
+ "Should Sebastian Rose's Java Script org-info.js be linked into HTML files?
+This option can be nil or t to never or always use the script. It can
+also be the symbol `when-configured', meaning that the script will be
+linked into the export file if and only if there is a \"#+INFOJS_OPT:\"
+line in the buffer. See also the variable `org-infojs-options'."
+ :group 'org-export-html
+ :group 'org-infojs
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "When configured in buffer" when-configured)
+ (const :tag "Always" t)))
+
+(defconst org-infojs-opts-table
+ '((path PATH "http://orgmode.org/org-info.js")
+ (view VIEW "info")
+ (toc TOC :table-of-contents)
+ (ftoc FIXED_TOC "0")
+ (tdepth TOC_DEPTH "max")
+ (sdepth SECTION_DEPTH "max")
+ (mouse MOUSE_HINT "underline")
+ (buttons VIEW_BUTTONS "0")
+ (ltoc LOCAL_TOC "1")
+ (up LINK_UP :link-up)
+ (home LINK_HOME :link-home))
+ "JavaScript options, long form for script, default values.")
+
+(defvar org-infojs-options)
+(when (and (boundp 'org-infojs-options)
+ (assq 'runs org-infojs-options))
+ (setq org-infojs-options (delq (assq 'runs org-infojs-options)
+ org-infojs-options)))
+
+(defcustom org-infojs-options
+ (mapcar (lambda (x) (cons (car x) (nth 2 x)))
+ org-infojs-opts-table)
+ "Options settings for the INFOJS JavaScript.
+Each of the options must have an entry in `org-export-html/infojs-opts-table'.
+The value can either be a string that will be passed to the script, or
+a property. This property is then assumed to be a property that is defined
+by the Export/Publishing setup of Org.
+The `sdepth' and `tdepth' parameters can also be set to \"max\", which
+means to use the maximum value consistent with other options."
+ :group 'org-infojs
+ :type
+ `(set :greedy t :inline t
+ ,@(mapcar
+ (lambda (x)
+ (list 'cons (list 'const (car x))
+ '(choice
+ (symbol :tag "Publishing/Export property")
+ (string :tag "Value"))))
+ org-infojs-opts-table)))
+
+(defcustom org-infojs-template
+ "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
+/**
+ *
+ * @source: %SCRIPT_PATH
+ *
+ * @licstart The following is the entire license notice for the
+ * JavaScript code in %SCRIPT_PATH.
+ *
+ * Copyright (C) 2012 Sebastian Rose
+ *
+ *
+ * The JavaScript code in this tag is free software: you can
+ * redistribute it and/or modify it under the terms of the GNU
+ * General Public License (GNU GPL) as published by the Free Software
+ * Foundation, either version 3 of the License, or (at your option)
+ * any later version. The code is distributed WITHOUT ANY WARRANTY;
+ * without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+ *
+ * As additional permission under GNU GPL version 3 section 7, you
+ * may distribute non-source (e.g., minimized or compacted) forms of
+ * that code without the copy of the GNU GPL normally required by
+ * section 4, provided you include this license notice and a URL
+ * through which recipients can access the Corresponding Source.
+ *
+ * @licend The above is the entire license notice
+ * for the JavaScript code in %SCRIPT_PATH.
+ *
+ */
+</script>
+
+<script type=\"text/javascript\">
+
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+
+<!--/*--><![CDATA[/*><!--*/
+%MANAGER_OPTIONS
+org_html_manager.setup(); // activate after the parameters are set
+/*]]>*///-->
+</script>"
+ "The template for the export style additions when org-info.js is used.
+Option settings will replace the %MANAGER-OPTIONS cookie."
+ :group 'org-infojs
+ :type 'string)
+
+(defun org-infojs-handle-options (exp-plist)
+ "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly."
+ (if (or (not org-export-html-use-infojs)
+ (and (eq org-export-html-use-infojs 'when-configured)
+ (or (not (plist-get exp-plist :infojs-opt))
+ (string-match "\\<view:nil\\>"
+ (plist-get exp-plist :infojs-opt)))))
+ ;; We do not want to use the script
+ exp-plist
+ ;; We do want to use the script, set it up
+ (let ((template org-infojs-template)
+ (ptoc (plist-get exp-plist :table-of-contents))
+ (hlevels (plist-get exp-plist :headline-levels))
+ tdepth sdepth s v e opt var val table default)
+ (setq sdepth hlevels
+ tdepth hlevels)
+ (if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
+ (setq v (plist-get exp-plist :infojs-opt)
+ table org-infojs-opts-table)
+ (while (setq e (pop table))
+ (setq opt (car e) var (nth 1 e)
+ default (cdr (assoc opt org-infojs-options)))
+ (and (symbolp default) (not (memq default '(t nil)))
+ (setq default (plist-get exp-plist default)))
+ (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
+ (setq val (match-string 1 v))
+ (setq val default))
+ (cond
+ ((eq opt 'path)
+ (setq template
+ (replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
+ ((eq opt 'sdepth)
+ (if (integerp (read val))
+ (setq sdepth (min (read val) hlevels))))
+ ((eq opt 'tdepth)
+ (if (integerp (read val))
+ (setq tdepth (min (read val) hlevels))))
+ (t
+ (setq val
+ (cond
+ ((or (eq val t) (equal val "t")) "1")
+ ((or (eq val nil) (equal val "nil")) "0")
+ ((stringp val) val)
+ (t (format "%s" val))))
+ (push (cons var val) s))))
+
+ ;; Now we set the depth of the *generated* TOC to SDEPTH, because the
+ ;; toc will actually determine the splitting. How much of the toc will
+ ;; actually be displayed is governed by the TDEPTH option.
+ (setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
+
+ ;; The table of contents should not show more sections then we generate
+ (setq tdepth (min tdepth sdepth))
+ (push (cons "TOC_DEPTH" tdepth) s)
+
+ (setq s (mapconcat
+ (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x) (cdr x)))
+ s "\n"))
+ (when (and s (> (length s) 0))
+ (and (string-match "%MANAGER_OPTIONS" template)
+ (setq s (replace-match s t t template))
+ (setq exp-plist
+ (plist-put
+ exp-plist :style-extra
+ (concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
+ ;; This script absolutely needs the table of contents, to we change that
+ ;; setting
+ (if (not (plist-get exp-plist :table-of-contents))
+ (setq exp-plist (plist-put exp-plist :table-of-contents t)))
+ ;; Return the modified property list
+ exp-plist)))
+
+(defun org-infojs-options-inbuffer-template ()
+ (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"
+ (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil)
+ (let ((a (cdr (assoc 'toc org-infojs-options))))
+ (cond ((memq a '(nil t)) a)
+ (t (plist-get (org-infile-export-plist) :table-of-contents))))
+ (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil)
+ (cdr (assoc 'mouse org-infojs-options))
+ (cdr (assoc 'buttons org-infojs-options))
+ (cdr (assoc 'path org-infojs-options))))
+
+(provide 'org-infojs)
+(provide 'org-jsinfo)
+
+;;; org-jsinfo.el ends here
diff --git a/lisp/org-latex.el b/lisp/org-latex.el
new file mode 100644
index 0000000..933fa56
--- /dev/null
+++ b/lisp/org-latex.el
@@ -0,0 +1,2902 @@
+;;; org-latex.el --- LaTeX exporter for org-mode
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;
+;; Emacs Lisp Archive Entry
+;; Filename: org-latex.el
+;; Author: Bastien Guerry <bzg AT gnu DOT org>
+;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
+;; Keywords: org, wp, tex
+;; Description: Converts an org-mode buffer into LaTeX
+
+;; 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 library implements a LaTeX exporter for org-mode.
+;;
+;; It is part of Org and will be autoloaded
+;;
+;; The interactive functions are similar to those of the HTML exporter:
+;;
+;; M-x `org-export-as-latex'
+;; M-x `org-export-as-pdf'
+;; M-x `org-export-as-pdf-and-open'
+;; M-x `org-export-as-latex-batch'
+;; M-x `org-export-as-latex-to-buffer'
+;; M-x `org-export-region-as-latex'
+;; M-x `org-replace-region-by-latex'
+;;
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'footnote)
+(require 'org)
+(require 'org-exp)
+(require 'org-macs)
+(require 'org-beamer)
+
+;;; Variables:
+(defvar org-export-latex-class nil)
+(defvar org-export-latex-class-options nil)
+(defvar org-export-latex-header nil)
+(defvar org-export-latex-append-header nil)
+(defvar org-export-latex-options-plist nil)
+(defvar org-export-latex-todo-keywords-1 nil)
+(defvar org-export-latex-complex-heading-re nil)
+(defvar org-export-latex-not-done-keywords nil)
+(defvar org-export-latex-done-keywords nil)
+(defvar org-export-latex-display-custom-times nil)
+(defvar org-export-latex-all-targets-re nil)
+(defvar org-export-latex-add-level 0)
+(defvar org-export-latex-footmark-seen nil
+ "List of footnotes markers seen so far by exporter.")
+(defvar org-export-latex-sectioning "")
+(defvar org-export-latex-sectioning-depth 0)
+(defvar org-export-latex-special-keyword-regexp
+ (concat "\\<\\(" org-scheduled-string "\\|"
+ org-deadline-string "\\|"
+ org-closed-string"\\)")
+ "Regexp matching special time planning keywords plus the time after it.")
+(defvar org-re-quote) ; dynamically scoped from org.el
+(defvar org-commentsp) ; dynamically scoped from org.el
+
+;;; User variables:
+
+(defgroup org-export-latex nil
+ "Options for exporting Org-mode files to LaTeX."
+ :tag "Org Export LaTeX"
+ :group 'org-export)
+
+(defcustom org-export-latex-default-class "article"
+ "The default LaTeX class."
+ :group 'org-export-latex
+ :type '(string :tag "LaTeX class"))
+
+(defcustom org-export-latex-classes
+ '(("article"
+ "\\documentclass[11pt]{article}"
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
+ ("\\paragraph{%s}" . "\\paragraph*{%s}")
+ ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
+ ("report"
+ "\\documentclass[11pt]{report}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
+ ("book"
+ "\\documentclass[11pt]{book}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
+ ("beamer"
+ "\\documentclass{beamer}"
+ org-beamer-sectioning
+ ))
+ "Alist of LaTeX classes and associated header and structure.
+If #+LaTeX_CLASS is set in the buffer, use its value and the
+associated information. Here is the structure of each cell:
+
+ \(class-name
+ header-string
+ (numbered-section . unnumbered-section\)
+ ...\)
+
+The header string
+-----------------
+
+The HEADER-STRING is the header that will be inserted into the LaTeX file.
+It should contain the \\documentclass macro, and anything else that is needed
+for this setup. To this header, the following commands will be added:
+
+- Calls to \\usepackage for all packages mentioned in the variables
+ `org-export-latex-default-packages-alist' and
+ `org-export-latex-packages-alist'. Thus, your header definitions should
+ avoid to also request these packages.
+
+- Lines specified via \"#+LaTeX_HEADER:\"
+
+If you need more control about the sequence in which the header is built
+up, or if you want to exclude one of these building blocks for a particular
+class, you can use the following macro-like placeholders.
+
+ [DEFAULT-PACKAGES] \\usepackage statements for default packages
+ [NO-DEFAULT-PACKAGES] do not include any of the default packages
+ [PACKAGES] \\usepackage statements for packages
+ [NO-PACKAGES] do not include the packages
+ [EXTRA] the stuff from #+LaTeX_HEADER
+ [NO-EXTRA] do not include #+LaTeX_HEADER stuff
+ [BEAMER-HEADER-EXTRA] the beamer extra headers
+
+So a header like
+
+ \\documentclass{article}
+ [NO-DEFAULT-PACKAGES]
+ [EXTRA]
+ \\providecommand{\\alert}[1]{\\textbf{#1}}
+ [PACKAGES]
+
+will omit the default packages, and will include the #+LaTeX_HEADER lines,
+then have a call to \\providecommand, and then place \\usepackage commands
+based on the content of `org-export-latex-packages-alist'.
+
+If your header or `org-export-latex-default-packages-alist' inserts
+\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with
+a coding system derived from `buffer-file-coding-system'. See also the
+variable `org-export-latex-inputenc-alist' for a way to influence this
+mechanism.
+
+The sectioning structure
+------------------------
+
+The sectioning structure of the class is given by the elements following
+the header string. For each sectioning level, a number of strings is
+specified. A %s formatter is mandatory in each section string and will
+be replaced by the title of the section.
+
+Instead of a cons cell (numbered . unnumbered), you can also provide a list
+of 2 or 4 elements,
+
+ (numbered-open numbered-close)
+
+or
+
+ (numbered-open numbered-close unnumbered-open unnumbered-close)
+
+providing opening and closing strings for a LaTeX environment that should
+represent the document section. The opening clause should have a %s
+to represent the section title.
+
+Instead of a list of sectioning commands, you can also specify a
+function name. That function will be called with two parameters,
+the (reduced) level of the headline, and the headline text. The function
+must return a cons cell with the (possibly modified) headline text, and the
+sectioning list in the cdr."
+ :group 'org-export-latex
+ :type '(repeat
+ (list (string :tag "LaTeX class")
+ (string :tag "LaTeX header")
+ (repeat :tag "Levels" :inline t
+ (choice
+ (cons :tag "Heading"
+ (string :tag " numbered")
+ (string :tag "unnumbered"))
+ (list :tag "Environment"
+ (string :tag "Opening (numbered)")
+ (string :tag "Closing (numbered)")
+ (string :tag "Opening (unnumbered)")
+ (string :tag "Closing (unnumbered)"))
+ (function :tag "Hook computing sectioning"))))))
+
+(defcustom org-export-latex-inputenc-alist nil
+ "Alist of inputenc coding system names, and what should really be used.
+For example, adding an entry
+
+ (\"utf8\" . \"utf8x\")
+
+will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
+are written as utf8 files."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(repeat
+ (cons
+ (string :tag "Derived from buffer")
+ (string :tag "Use this instead"))))
+
+
+(defcustom org-export-latex-emphasis-alist
+ '(("*" "\\textbf{%s}" nil)
+ ("/" "\\emph{%s}" nil)
+ ("_" "\\underline{%s}" nil)
+ ("+" "\\st{%s}" nil)
+ ("=" "\\protectedtexttt" t)
+ ("~" "\\verb" t))
+ "Alist of LaTeX expressions to convert emphasis fontifiers.
+Each element of the list is a list of three elements.
+The first element is the character used as a marker for fontification.
+The second element is a format string to wrap fontified text with.
+If it is \"\\verb\", Org will automatically select a delimiter
+character that is not in the string. \"\\protectedtexttt\" will use \\texttt
+to typeset and try to protect special characters.
+The third element decides whether to protect converted text from other
+conversions."
+ :group 'org-export-latex
+ :type 'alist)
+
+(defcustom org-export-latex-title-command "\\maketitle"
+ "The command used to insert the title just after \\begin{document}.
+If this string contains the formatting specification \"%s\" then
+it will be used as a format string, passing the title as an
+argument."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-export-latex-import-inbuffer-stuff nil
+ "Non-nil means define TeX macros for Org's inbuffer definitions.
+For example \orgTITLE for #+TITLE."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-latex-date-format
+ "\\today"
+ "Format string for \\date{...}."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}"
+ "Markup for TODO keywords, as a printf format.
+This can be a single format for all keywords, a cons cell with separate
+formats for not-done and done states, or an association list with setup
+for individual keywords. If a keyword shows up for which there is no
+markup defined, the first one in the association list will be used."
+ :group 'org-export-latex
+ :type '(choice
+ (string :tag "Default")
+ (cons :tag "Distinguish undone and done"
+ (string :tag "Not-DONE states")
+ (string :tag "DONE states"))
+ (repeat :tag "Per keyword markup"
+ (cons
+ (string :tag "Keyword")
+ (string :tag "Markup")))))
+
+(defcustom org-export-latex-tag-markup "\\textbf{%s}"
+ "Markup for tags, as a printf format."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
+ "A printf format string to be applied to time stamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}"
+ "A printf format string to be applied to inactive time stamps."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
+ "A printf format string to be applied to time stamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-export-latex-href-format "\\href{%s}{%s}"
+ "A printf format string to be applied to href links.
+The format must contain either two %s instances or just one.
+If it contains two %s instances, the first will be filled with
+the link, the second with the link description. If it contains
+only one, the %s will be filled with the link."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
+ "A printf format string to be applied to hyperref links.
+The format must contain one or two %s instances. The first one
+will be filled with the link, the second with its description."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-hyperref-options-format
+ "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n"
+ "A format string for hyperref options.
+When non-nil, it must contain three %s format specifications
+which will respectively be replaced by the document's keywords,
+its description and the Org's version number, as a string. Set
+this option to the empty string if you don't want to include
+hyperref options altogether."
+ :type 'string
+ :version "24.3"
+ :group 'org-export-latex)
+
+(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
+ "Text used to separate footnotes."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-quotes
+ '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'"))
+ ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`")))
+ "Alist for quotes to use when converting english double-quotes.
+
+The CAR of each item in this alist is the language code.
+The CDR of each item in this alist is a list of three CONS:
+- the first CONS defines the opening quote;
+- the second CONS defines the closing quote;
+- the last CONS defines single quotes.
+
+For each item in a CONS, the first string is a regexp
+for allowed characters before/after the quote, the second
+string defines the replacement string for this quote."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(list
+ (cons :tag "Opening quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))
+ (cons :tag "Closing quote"
+ (string :tag "Regexp for char after ")
+ (string :tag "Replacement quote "))
+ (cons :tag "Single quote"
+ (string :tag "Regexp for char before")
+ (string :tag "Replacement quote "))))
+
+(defcustom org-export-latex-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-latex-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-latex-table-caption-above t
+ "When non-nil, the caption is set above the table. When nil,
+the caption is set below the table."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-latex-tables-column-borders nil
+ "When non-nil, grouping columns can cause outer vertical lines in tables.
+When nil, grouping causes only separation lines between groups."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-latex-tables-tstart nil
+ "LaTeX command for top rule for tables."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (string :tag "String")
+ (const :tag "Booktabs default: \\toprule" "\\toprule")))
+
+(defcustom org-export-latex-tables-hline "\\hline"
+ "LaTeX command to use for a rule somewhere in the middle of a table."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (string :tag "String")
+ (const :tag "Standard: \\hline" "\\hline")
+ (const :tag "Booktabs default: \\midrule" "\\midrule")))
+
+(defcustom org-export-latex-tables-tend nil
+ "LaTeX command for bottom rule for tables."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (string :tag "String")
+ (const :tag "Booktabs default: \\bottomrule" "\\bottomrule")))
+
+(defcustom org-export-latex-low-levels 'itemize
+ "How to convert sections below the current level of sectioning.
+This is specified by the `org-export-headline-levels' option or the
+value of \"H:\" in Org's #+OPTION line.
+
+This can be either nil (skip the sections), `description', `itemize',
+or `enumerate' (convert the sections as the corresponding list type), or
+a string to be used instead of \\section{%s}. In this latter case,
+the %s stands here for the inserted headline and is mandatory.
+
+It may also be a list of three string to define a user-defined environment
+that should be used. The first string should be the like
+\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up
+to two occurrences of %s for the title and a label, respectively. The third
+string should be like \"\\end{itemize\"."
+ :group 'org-export-latex
+ :type '(choice (const :tag "Ignore" nil)
+ (const :tag "Convert as descriptive list" description)
+ (const :tag "Convert as itemized list" itemize)
+ (const :tag "Convert as enumerated list" enumerate)
+ (list :tag "User-defined environment"
+ :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s")
+ (string :tag "Start")
+ (string :tag "End")
+ (string :tag "item"))
+ (string :tag "Use a section string" :value "\\subparagraph{%s}")))
+
+(defcustom org-export-latex-list-parameters
+ '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
+ "Parameters for the LaTeX list exporter.
+These parameters will be passed on to `org-list-to-latex', which in turn
+will pass them (combined with the LaTeX default list parameters) to
+`org-list-to-generic'."
+ :group 'org-export-latex
+ :type 'plist)
+
+(defcustom org-export-latex-verbatim-wrap
+ '("\\begin{verbatim}\n" . "\\end{verbatim}")
+ "Environment to be wrapped around a fixed-width section in LaTeX export.
+This is a cons with two strings, to be added before and after the
+fixed-with text.
+
+Defaults to \\begin{verbatim} and \\end{verbatim}."
+ :group 'org-export-translation
+ :group 'org-export-latex
+ :type '(cons (string :tag "Open")
+ (string :tag "Close")))
+
+(defcustom org-export-latex-listings nil
+ "Non-nil means export source code using the listings package.
+This package will fontify source code, possibly even with color.
+If you want to use this, you also need to make LaTeX use the
+listings package, and if you want to have color, the color
+package. Just add these to `org-export-latex-packages-alist',
+for example using customize, or with something like
+
+ (require 'org-latex)
+ (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\"))
+ (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))
+
+Alternatively,
+
+ (setq org-export-latex-listings 'minted)
+
+causes source code to be exported using the minted package as
+opposed to listings. If you want to use minted, you need to add
+the minted package to `org-export-latex-packages-alist', for
+example using customize, or with
+
+ (require 'org-latex)
+ (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\"))
+
+In addition, it is necessary to install
+pygments (http://pygments.org), and to configure the variable
+`org-latex-to-pdf-process' so that the -shell-escape option is
+passed to pdflatex.
+"
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-export-latex-listings-langs
+ '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
+ (c "C") (cc "C++")
+ (fortran "fortran")
+ (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
+ (html "HTML") (xml "XML")
+ (tex "TeX") (latex "TeX")
+ (shell-script "bash")
+ (gnuplot "Gnuplot")
+ (ocaml "Caml") (caml "Caml")
+ (sql "SQL") (sqlite "sql"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language parameter
+for the listings package. If the mode name and the listings name are
+the same, the language does not need an entry in this list - but it does not
+hurt if it is present."
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+(defcustom org-export-latex-listings-w-names t
+ "Non-nil means export names of named code blocks.
+Code blocks exported with the listings package (controlled by the
+`org-export-latex-listings' variable) can be named in the style
+of noweb."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-export-latex-minted-langs
+ '((emacs-lisp "common-lisp")
+ (cc "c++")
+ (cperl "perl")
+ (shell-script "bash")
+ (caml "ocaml"))
+ "Alist mapping languages to their minted language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language parameter
+for the minted package. If the mode name and the listings name are
+the same, the language does not need an entry in this list - but it does not
+hurt if it is present.
+
+Note that minted uses all lower case for language identifiers,
+and that the full list of language identifiers can be obtained
+with:
+pygmentize -L lexers
+"
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+(defcustom org-export-latex-listings-options nil
+ "Association list of options for the latex listings package.
+
+These options are supplied as a comma-separated list to the
+\\lstset command. Each element of the association list should be
+a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-export-latex-listings-options
+ '((\"basicstyle\" \"\\small\")
+ (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
+
+will typeset the code in a small size font with underlined, bold
+black keywords.
+
+Note that the same options will be applied to blocks of all
+languages."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(repeat
+ (list
+ (string :tag "Listings option name ")
+ (string :tag "Listings option value"))))
+
+(defcustom org-export-latex-minted-options nil
+ "Association list of options for the latex minted package.
+
+These options are supplied within square brackets in
+\\begin{minted} environments. Each element of the alist should be
+a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-export-latex-minted-options
+ '((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
+
+will result in src blocks being exported with
+
+\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
+
+as the start of the minted environment. Note that the same
+options will be applied to blocks of all languages."
+ :group 'org-export-latex
+ :version "24.1"
+ :type '(repeat
+ (list
+ (string :tag "Minted option name ")
+ (string :tag "Minted option value"))))
+
+(defvar org-export-latex-custom-lang-environments nil
+ "Association list mapping languages to language-specific latex
+ environments used during export of src blocks by the listings
+ and minted latex packages. For example,
+
+ (setq org-export-latex-custom-lang-environments
+ '((python \"pythoncode\")))
+
+ would have the effect that if org encounters begin_src python
+ during latex export it will output
+
+ \\begin{pythoncode}
+ <src block body>
+ \\end{pythoncode}")
+
+(defcustom org-export-latex-remove-from-headlines
+ '(:todo nil :priority nil :tags nil)
+ "A plist of keywords to remove from headlines. OBSOLETE.
+Non-nil means remove this keyword type from the headline.
+
+Don't remove the keys, just change their values.
+
+Obsolete, this variable is no longer used. Use the separate
+variables `org-export-with-todo-keywords', `org-export-with-priority',
+and `org-export-with-tags' instead."
+ :type 'plist
+ :group 'org-export-latex)
+
+(defcustom org-export-latex-image-default-option "width=.9\\linewidth"
+ "Default option for images."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-default-figure-position "htb"
+ "Default position for latex figures."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-tabular-environment "tabular"
+ "Default environment used to build tables."
+ :group 'org-export-latex
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-latex
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-export-latex-inline-image-extensions
+ '("pdf" "jpeg" "jpg" "png" "ps" "eps")
+ "Extensions of image files that can be inlined into LaTeX.
+Note that the image extension *actually* allowed depend on the way the
+LaTeX file is processed. When used with pdflatex, pdf, jpg and png images
+are OK. When processing through dvi to Postscript, only ps and eps are
+allowed. The default we use here encompasses both."
+ :group 'org-export-latex
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-latex-coding-system nil
+ "Coding system for the exported LaTeX file."
+ :group 'org-export-latex
+ :type 'coding-system)
+
+(defgroup org-export-pdf nil
+ "Options for exporting Org-mode files to PDF, via LaTeX."
+ :tag "Org Export PDF"
+ :group 'org-export-latex
+ :group 'org-export)
+
+(defcustom org-latex-to-pdf-process
+ '("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f")
+ "Commands to process a LaTeX file to a PDF file and process latex
+fragments to pdf files.By default,this is a list of strings,and each of
+strings will be given to the shell as a command. %f in the command will
+be replaced by the full file name, %b by the file base name (i.e. without
+extension) and %o by the base directory of the file.
+
+If you set `org-create-formula-image-program'
+`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a
+sublist which contains your own command(s) for LaTeX fragments
+previewing, like this:
+
+ '(\"xelatex -interaction nonstopmode -output-directory %o %f\"
+ \"xelatex -interaction nonstopmode -output-directory %o %f\"
+ ;; use below command(s) to convert latex fragments
+ (\"xelatex %f\"))
+
+With no such sublist, the default command used to convert LaTeX
+fragments will be the first string in the list.
+
+The reason why this is a list is that it usually takes several runs of
+`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever
+mechanism to detect which of these commands have to be run to get to a stable
+result, and it also does not do any error checking.
+
+By default, Org uses 3 runs of `pdflatex' to do the processing. If you
+have texi2dvi on your system and if that does not cause the infamous
+egrep/locale bug:
+
+ http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
+
+then `texi2dvi' is the superior choice. Org does offer it as one
+of the customize options.
+
+Alternatively, this may be a Lisp function that does the processing, so you
+could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
+This function should accept the file name as its single argument."
+ :group 'org-export-pdf
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "bibtex %b"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "2 runs of xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "xelatex,bibtex,xelatex,xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "bibtex %b"
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "texi2dvi"
+ ("texi2dvi -p -b -c -V %f"))
+ (const :tag "rubber"
+ ("rubber -d --into %o %f"))
+ (function)))
+
+(defcustom org-export-pdf-logfiles
+ '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ "The list of file extensions to consider as LaTeX logfiles."
+ :group 'org-export-pdf
+ :version "24.1"
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-export-pdf-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+These are the .aux, .log, .out, and .toc files."
+ :group 'org-export-pdf
+ :type 'boolean)
+
+;;; Hooks
+
+(defvar org-export-latex-after-initial-vars-hook nil
+ "Hook run before LaTeX export.
+The exact moment is after the initial variables like org-export-latex-class
+have been determined from the environment.")
+
+(defvar org-export-latex-after-blockquotes-hook nil
+ "Hook run during LaTeX export, after blockquote, verse, center are done.")
+
+(defvar org-export-latex-final-hook nil
+ "Hook run in the finalized LaTeX buffer.")
+
+(defvar org-export-latex-after-save-hook nil
+ "Hook run in the finalized LaTeX buffer, after it has been saved.")
+
+;;; Autoload functions:
+
+;;;###autoload
+(defun org-export-as-latex-batch ()
+ "Call `org-export-as-latex', may be used in batch processing.
+For example:
+
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-latex-batch"
+ (org-export-as-latex org-export-headline-levels 'hidden))
+
+;;;###autoload
+(defun org-export-as-latex-to-buffer (arg)
+ "Call `org-export-as-latex` with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to `org-export-as-latex'."
+ (interactive "P")
+ (org-export-as-latex arg nil nil "*Org LaTeX Export*")
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window "*Org LaTeX Export*")))
+
+;;;###autoload
+(defun org-replace-region-by-latex (beg end)
+ "Replace the region from BEG to END with its LaTeX export.
+It assumes the region has `org-mode' syntax, and then convert it to
+LaTeX. This can be used in any buffer. For example, you could
+write an itemized list in `org-mode' syntax in an LaTeX buffer and
+then use this command to convert it."
+ (interactive "r")
+ (let (reg latex buf)
+ (save-window-excursion
+ (if (derived-mode-p 'org-mode)
+ (setq latex (org-export-region-as-latex
+ beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq latex (org-export-region-as-latex
+ (point-min) (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert latex)))
+
+;;;###autoload
+(defun org-export-region-as-latex (beg end &optional body-only buffer)
+ "Convert region from BEG to END in `org-mode' buffer to LaTeX.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted LaTeX. If BUFFER is the symbol `string', return the
+produced LaTeX as a string and leave no buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq latex (org-export-region-as-latex beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (interactive "r\nP")
+ (when (org-called-interactively-p 'any)
+ (setq buffer "*Org LaTeX Export*"))
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-export-as-latex
+ nil nil ext-plist
+ buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+;;;###autoload
+(defun org-export-as-latex (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export current buffer to a LaTeX file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will be exported
+depending on `org-export-latex-low-levels'. The default is to
+convert them as description lists.
+HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with
+external parameters overriding org-mode's default settings, but
+still inferior to file-local settings. When TO-BUFFER is
+non-nil, create a buffer with that name and export to that
+buffer. If TO-BUFFER is the symbol `string', don't leave any
+buffer behind but just return the resulting LaTeX as a string.
+When BODY-ONLY is set, don't produce the file header and footer,
+simply return the content of \\begin{document}...\\end{document},
+without even the \\begin{document} and \\end{document} commands.
+when PUB-DIR is set, use this as the publishing directory."
+ (interactive "P")
+ (when (and (not body-only) arg (listp arg)) (setq body-only t))
+ (run-hooks 'org-export-first-hook)
+
+ ;; Make sure we have a file name when we need it.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (message "Exporting to LaTeX...")
+ (org-unmodified
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill nil))))
+ (org-update-radio-target-regexp)
+ (org-export-latex-set-initial-vars ext-plist arg)
+ (setq org-export-opt-plist org-export-latex-options-plist
+ org-export-footnotes-data (org-footnote-all-labels 'with-defs)
+ org-export-footnotes-seen nil
+ org-export-latex-footmark-seen nil)
+ (org-install-letbind)
+ (run-hooks 'org-export-latex-after-initial-vars-hook)
+ (let* ((wcf (current-window-configuration))
+ (opt-plist
+ (org-export-process-option-filters org-export-latex-options-plist))
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; Make sure the variable contains the updated values.
+ (org-export-latex-options-plist (setq org-export-opt-plist opt-plist))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-export-directory :html opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (title (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "No Title"))
+ (filename
+ (and (not to-buffer)
+ (concat
+ (file-name-as-directory
+ (or pub-dir
+ (org-export-directory :LaTeX org-export-latex-options-plist)))
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get rbeg "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory ;sans-extension
+ (or buffer-file-name
+ (error "Don't know which export file to use")))))
+ ".tex")))
+ (filename
+ (and filename
+ (if (equal (file-truename filename)
+ (file-truename (or buffer-file-name "dummy.org")))
+ (concat filename ".tex")
+ filename)))
+ (auto-insert nil); Avoid any auto-insert stuff for the new file
+ (TeX-master (boundp 'TeX-master))
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string) (get-buffer-create
+ "*Org LaTeX Export*"))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect filename)))
+ (odd org-odd-levels-only)
+ (header (org-export-latex-make-header title opt-plist))
+ (skip (cond (subtree-p nil)
+ (region-p nil)
+ (t (plist-get opt-plist :skip-before-1st-heading))))
+ (text (plist-get opt-plist :text))
+ (org-export-preprocess-hook
+ (cons
+ `(lambda () (org-set-local 'org-complex-heading-regexp
+ ,org-export-latex-complex-heading-re))
+ org-export-preprocess-hook))
+ (first-lines (if skip "" (org-export-latex-first-lines
+ opt-plist
+ (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (point-at-bol 2))
+ rbeg)
+ (if region-p rend))))
+ (coding-system (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system))
+ (coding-system-for-write (or org-export-latex-coding-system
+ coding-system))
+ (save-buffer-coding-system (or org-export-latex-coding-system
+ coding-system))
+ (region (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (text
+ (and text (string-match "\\S-" text)
+ (org-export-preprocess-string
+ text
+ :emph-multiline t
+ :for-backend 'latex
+ :comments nil
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :drawers (plist-get opt-plist :drawers)
+ :timestamps (plist-get opt-plist :timestamps)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :add-text nil
+ :skip-before-1st-heading skip
+ :select-tags nil
+ :exclude-tags nil
+ :LaTeX-fragments nil)))
+ (string-for-export
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend 'latex
+ :comments nil
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :drawers (plist-get opt-plist :drawers)
+ :timestamps (plist-get opt-plist :timestamps)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :add-text (if (eq to-buffer 'string) nil text)
+ :skip-before-1st-heading skip
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :LaTeX-fragments nil)))
+
+ (set-buffer buffer)
+ (erase-buffer)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ ;; insert the header and initial document commands
+ (unless (or (eq to-buffer 'string) body-only)
+ (insert header))
+
+ ;; insert text found in #+TEXT
+ (when (and text (not (eq to-buffer 'string)))
+ (insert (org-export-latex-content
+ text '(lists tables fixed-width keywords))
+ "\n\n"))
+
+ ;; insert lines before the first headline
+ (unless (or skip (string-match "^\\*" first-lines))
+ (insert first-lines))
+
+ ;; export the content of headlines
+ (org-export-latex-global
+ (with-temp-buffer
+ (insert string-for-export)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(\\*+\\) " nil t)
+ (let* ((asters (length (match-string 1)))
+ (level (if odd (- asters 2) (- asters 1))))
+ (setq org-export-latex-add-level
+ (if odd (1- (/ (1+ asters) 2)) (1- asters)))
+ (org-export-latex-parse-global level odd)))))
+
+ ;; finalization
+ (unless body-only (insert "\n\\end{document}"))
+
+ ;; Attach description terms to the \item macro
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t)
+ (delete-region (match-beginning 1) (match-end 1)))
+
+ ;; Relocate the table of contents
+ (goto-char (point-min))
+ (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
+ (replace-match "\\tableofcontents" t t)))
+
+ ;; Cleanup forced line ends in items where they are not needed
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin"
+ nil t)
+ (delete-region (match-beginning 1) (match-end 1)))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*"
+ nil t)
+ (if (looking-at "[\n \t]+")
+ (replace-match "\n")))
+
+ ;; Ensure we have a final newline
+ (goto-char (point-max))
+ (or (eq (char-before) ?\n)
+ (insert ?\n))
+
+ (run-hooks 'org-export-latex-final-hook)
+ (if to-buffer
+ (unless (eq major-mode 'latex-mode) (latex-mode))
+ (save-buffer))
+ (org-export-latex-fix-inputenc)
+ (run-hooks 'org-export-latex-after-save-hook)
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring "LaTeX")
+ (message "Exporting to LaTeX...done"))
+ (prog1
+ (if (eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer)))
+ (current-buffer))
+ (set-window-configuration wcf))))
+
+;;;###autoload
+(defun org-export-as-pdf (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export as LaTeX, then process through to PDF."
+ (interactive "P")
+ (message "Exporting to PDF...")
+ (let* ((wconfig (current-window-configuration))
+ (lbuf (org-export-as-latex arg hidden ext-plist
+ to-buffer body-only pub-dir))
+ (file (buffer-file-name lbuf))
+ (base (file-name-sans-extension (buffer-file-name lbuf)))
+ (pdffile (concat base ".pdf"))
+ (cmds (if (eq org-export-latex-listings 'minted)
+ ;; automatically add -shell-escape when needed
+ (mapcar (lambda (cmd)
+ (replace-regexp-in-string
+ "pdflatex " "pdflatex -shell-escape " cmd))
+ org-latex-to-pdf-process)
+ org-latex-to-pdf-process))
+ (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
+ (bibtex-p (with-current-buffer lbuf
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "\\\\bibliography{" nil t))))
+ cmd output-dir errors)
+ (with-current-buffer outbuf (erase-buffer))
+ (message (concat "Processing LaTeX file " file "..."))
+ (setq output-dir (file-name-directory file))
+ (with-current-buffer lbuf
+ (save-excursion
+ (if (and cmds (symbolp cmds))
+ (funcall cmds (shell-quote-argument file))
+ (while cmds
+ (setq cmd (pop cmds))
+ (cond
+ ((not (listp cmd))
+ (while (string-match "%b" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument base))
+ t t cmd)))
+ (while (string-match "%f" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument file))
+ t t cmd)))
+ (while (string-match "%o" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument output-dir))
+ t t cmd)))
+ (shell-command cmd outbuf)))))))
+ (message (concat "Processing LaTeX file " file "...done"))
+ (setq errors (org-export-latex-get-error outbuf))
+ (if (not (file-exists-p pdffile))
+ (error (concat "PDF file " pdffile " was not produced"
+ (if errors (concat ":" errors "") "")))
+ (set-window-configuration wconfig)
+ (when org-export-pdf-remove-logfiles
+ (dolist (ext org-export-pdf-logfiles)
+ (setq file (concat base "." ext))
+ (and (file-exists-p file) (delete-file file))))
+ (message (concat
+ "Exporting to PDF...done"
+ (if errors
+ (concat ", with some errors:" errors)
+ "")))
+ pdffile)))
+
+(defun org-export-latex-get-error (buf)
+ "Collect the kinds of errors that remain in pdflatex processing."
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-max))
+ (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
+ ;; OK, we are at the location of the final run
+ (let ((pos (point)) (errors "") (case-fold-search t))
+ (if (re-search-forward "Reference.*?undefined" nil t)
+ (setq errors (concat errors " [undefined reference]")))
+ (goto-char pos)
+ (if (re-search-forward "Citation.*?undefined" nil t)
+ (setq errors (concat errors " [undefined citation]")))
+ (goto-char pos)
+ (if (re-search-forward "Undefined control sequence" nil t)
+ (setq errors (concat errors " [undefined control sequence]")))
+ (and (org-string-nw-p errors) errors))))))
+
+;;;###autoload
+(defun org-export-as-pdf-and-open (arg)
+ "Export as LaTeX, then process through to PDF, and open."
+ (interactive "P")
+ (let ((pdffile (org-export-as-pdf arg)))
+ (if pdffile
+ (progn
+ (org-open-file pdffile)
+ (when org-export-kill-product-buffer-when-displayed
+ (kill-buffer (find-buffer-visiting
+ (concat (file-name-sans-extension (buffer-file-name))
+ ".tex")))))
+ (error "PDF file was not produced"))))
+
+;;; Parsing functions:
+
+(defun org-export-latex-parse-global (level odd)
+ "Parse the current buffer recursively, starting at LEVEL.
+If ODD is non-nil, assume the buffer only contains odd sections.
+Return a list reflecting the document structure."
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((cnt 0) output
+ (depth org-export-latex-sectioning-depth))
+ (while (org-re-search-forward-unprotected
+ (concat "^\\(\\(?:\\*\\)\\{"
+ (number-to-string (+ (if odd 2 1) level))
+ "\\}\\) \\(.*\\)$")
+ ;; make sure that there is no upper heading
+ (when (> level 0)
+ (save-excursion
+ (save-match-data
+ (org-re-search-forward-unprotected
+ (concat "^\\(\\(?:\\*\\)\\{"
+ (number-to-string level)
+ "\\}\\) \\(.*\\)$") nil t)))) t)
+ (setq cnt (1+ cnt))
+ (let* ((pos (match-beginning 0))
+ (heading (match-string 2))
+ (nlevel (if odd (/ (+ 3 level) 2) (1+ level))))
+ (save-excursion
+ (narrow-to-region
+ (point)
+ (save-match-data
+ (if (org-re-search-forward-unprotected
+ (concat "^\\(\\(?:\\*\\)\\{"
+ (number-to-string (+ (if odd 2 1) level))
+ "\\}\\) \\(.*\\)$") nil t)
+ (match-beginning 0)
+ (point-max))))
+ (goto-char (point-min))
+ (setq output
+ (append output
+ (list
+ (list
+ `(pos . ,pos)
+ `(level . ,nlevel)
+ `(occur . ,cnt)
+ `(heading . ,heading)
+ `(content . ,(org-export-latex-parse-content))
+ `(subcontent . ,(org-export-latex-parse-subcontent
+ level odd)))))))
+ (widen)))
+ (list output))))
+
+(defun org-export-latex-parse-content ()
+ "Extract the content of a section."
+ (let ((beg (point))
+ (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t)
+ (progn (beginning-of-line) (point))
+ (point-max))))
+ (buffer-substring beg end)))
+
+(defun org-export-latex-parse-subcontent (level odd)
+ "Extract the subcontent of a section at LEVEL.
+If ODD Is non-nil, assume subcontent only contains odd sections."
+ (if (not (org-re-search-forward-unprotected
+ (concat "^\\(\\(?:\\*\\)\\{"
+ (number-to-string (+ (if odd 4 2) level))
+ "\\}\\) \\(.*\\)$")
+ nil t))
+ nil ; subcontent is nil
+ (org-export-latex-parse-global (+ (if odd 2 1) level) odd)))
+
+;;; Rendering functions:
+(defun org-export-latex-global (content)
+ "Export CONTENT to LaTeX.
+CONTENT is an element of the list produced by
+`org-export-latex-parse-global'."
+ (if (eq (car content) 'subcontent)
+ (mapc 'org-export-latex-sub (cdr content))
+ (org-export-latex-sub (car content))))
+
+(defun org-export-latex-sub (subcontent)
+ "Export the list SUBCONTENT to LaTeX.
+SUBCONTENT is an alist containing information about the headline
+and its content."
+ (let ((num (plist-get org-export-latex-options-plist :section-numbers)))
+ (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent)))
+
+(defun org-export-latex-subcontent (subcontent num)
+ "Export each cell of SUBCONTENT to LaTeX.
+If NUM is non-nil export numbered sections, otherwise use unnumbered
+sections. If NUM is an integer, export the highest NUM levels as
+numbered sections and lower levels as unnumbered sections."
+ (let* ((heading (cdr (assoc 'heading subcontent)))
+ (level (- (cdr (assoc 'level subcontent))
+ org-export-latex-add-level))
+ (occur (number-to-string (cdr (assoc 'occur subcontent))))
+ (content (cdr (assoc 'content subcontent)))
+ (subcontent (cadr (assoc 'subcontent subcontent)))
+ (label (org-get-text-property-any 0 'target heading))
+ (label-list (cons label (cdr (assoc label
+ org-export-target-aliases))))
+ (sectioning org-export-latex-sectioning)
+ (depth org-export-latex-sectioning-depth)
+ main-heading sub-heading ctnt)
+ (when (symbolp (car sectioning))
+ (setq sectioning (funcall (car sectioning) level heading))
+ (when sectioning
+ (setq heading (car sectioning)
+ sectioning (cdr sectioning)
+ ;; target property migh have changed...
+ label (org-get-text-property-any 0 'target heading)
+ label-list (cons label (cdr (assoc label
+ org-export-target-aliases)))))
+ (if sectioning (setq sectioning (make-list 10 sectioning)))
+ (setq depth (if sectioning 10000 0)))
+ (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading)
+ (setq main-heading (substring heading 0 (match-beginning 0))
+ sub-heading (substring heading (match-end 0))))
+ (setq heading (org-export-latex-fontify-headline heading)
+ sub-heading (and sub-heading
+ (org-export-latex-fontify-headline sub-heading))
+ main-heading (and main-heading
+ (org-export-latex-fontify-headline main-heading)))
+ (cond
+ ;; Normal conversion
+ ((<= level depth)
+ (let* ((sec (nth (1- level) sectioning))
+ (num (if (integerp num)
+ (>= num level)
+ num))
+ start end)
+ (if (consp (cdr sec))
+ (setq start (nth (if num 0 2) sec)
+ end (nth (if num 1 3) sec))
+ (setq start (if num (car sec) (cdr sec))))
+ (insert (format start (if main-heading main-heading heading)
+ (or sub-heading "")))
+ (insert "\n")
+ (when label
+ (insert (mapconcat (lambda (l) (format "\\label{%s}" l))
+ label-list "\n") "\n"))
+ (insert (org-export-latex-content content))
+ (cond ((stringp subcontent) (insert subcontent))
+ ((listp subcontent)
+ (while (org-looking-back "\n\n") (backward-delete-char 1))
+ (org-export-latex-sub subcontent)))
+ (when (and end (string-match "[^ \t]" end))
+ (let ((hook (org-get-text-property-any 0 'org-insert-hook end)))
+ (and (functionp hook) (funcall hook)))
+ (insert end "\n"))))
+ ;; At a level under the hl option: we can drop this subsection
+ ((> level depth)
+ (cond ((eq org-export-latex-low-levels 'description)
+ (if (string-match "% ends low level$"
+ (buffer-substring (point-at-bol 0) (point)))
+ (delete-region (point-at-bol 0) (point))
+ (insert "\\begin{description}\n"))
+ (insert (format "\n\\item[%s]%s~\n"
+ heading
+ (if label (format "\\label{%s}" label) "")))
+ (insert (org-export-latex-content content))
+ (cond ((stringp subcontent) (insert subcontent))
+ ((listp subcontent) (org-export-latex-sub subcontent)))
+ (insert "\\end{description} % ends low level\n"))
+ ((memq org-export-latex-low-levels '(itemize enumerate))
+ (if (string-match "% ends low level$"
+ (buffer-substring (point-at-bol 0) (point)))
+ (delete-region (point-at-bol 0) (point))
+ (insert (format "\\begin{%s}\n"
+ (symbol-name org-export-latex-low-levels))))
+ (let ((ctnt (org-export-latex-content content)))
+ (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) ""))
+ "\n\\item %s\\\\\n%s%%"
+ "\n\\item %s\n%s%%")
+ heading
+ (if label (format "\\label{%s}" label) "")))
+ (insert ctnt))
+ (cond ((stringp subcontent) (insert subcontent))
+ ((listp subcontent) (org-export-latex-sub subcontent)))
+ (insert (format "\\end{%s} %% ends low level\n"
+ (symbol-name org-export-latex-low-levels))))
+
+ ((and (listp org-export-latex-low-levels)
+ org-export-latex-low-levels)
+ (if (string-match "% ends low level$"
+ (buffer-substring (point-at-bol 0) (point)))
+ (delete-region (point-at-bol 0) (point))
+ (insert (car org-export-latex-low-levels) "\n"))
+ (insert (format (nth 2 org-export-latex-low-levels)
+ heading
+ (if label (format "\\label{%s}" label) "")))
+ (insert (org-export-latex-content content))
+ (cond ((stringp subcontent) (insert subcontent))
+ ((listp subcontent) (org-export-latex-sub subcontent)))
+ (insert (nth 1 org-export-latex-low-levels)
+ " %% ends low level\n"))
+
+ ((stringp org-export-latex-low-levels)
+ (insert (format org-export-latex-low-levels heading) "\n")
+ (when label (insert (format "\\label{%s}\n" label)))
+ (insert (org-export-latex-content content))
+ (cond ((stringp subcontent) (insert subcontent))
+ ((listp subcontent) (org-export-latex-sub subcontent)))))))))
+
+;;; Exporting internals:
+(defun org-export-latex-set-initial-vars (ext-plist level)
+ "Store org local variables required for LaTeX export.
+EXT-PLIST is an optional additional plist.
+LEVEL indicates the default depth for export."
+ (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
+ org-export-latex-done-keywords org-done-keywords
+ org-export-latex-not-done-keywords org-not-done-keywords
+ org-export-latex-complex-heading-re org-complex-heading-regexp
+ org-export-latex-display-custom-times org-display-custom-times
+ org-export-latex-all-targets-re
+ (org-make-target-link-regexp (org-all-targets))
+ org-export-latex-options-plist
+ (org-combine-plists (org-default-export-plist) ext-plist
+ (org-infile-export-plist))
+ org-export-latex-class
+ (or (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (and (looking-at org-complex-heading-regexp)
+ (org-entry-get nil "LaTeX_CLASS" 'selective))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t)
+ (match-string 1))))
+ (plist-get org-export-latex-options-plist :latex-class)
+ org-export-latex-default-class)
+ org-export-latex-class-options
+ (or (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (and (looking-at org-complex-heading-regexp)
+ (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t)
+ (match-string 1))))
+ (plist-get org-export-latex-options-plist :latex-class-options))
+ org-export-latex-class
+ (or (car (assoc org-export-latex-class org-export-latex-classes))
+ (error "No definition for class `%s' in `org-export-latex-classes'"
+ org-export-latex-class))
+ org-export-latex-header
+ (cadr (assoc org-export-latex-class org-export-latex-classes))
+ org-export-latex-sectioning
+ (cddr (assoc org-export-latex-class org-export-latex-classes))
+ org-export-latex-sectioning-depth
+ (or level
+ (let ((hl-levels
+ (plist-get org-export-latex-options-plist :headline-levels))
+ (sec-depth (length org-export-latex-sectioning)))
+ (if (> hl-levels sec-depth) sec-depth hl-levels))))
+ (when (and org-export-latex-class-options
+ (string-match "\\S-" org-export-latex-class-options)
+ (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?"
+ org-export-latex-header))
+ (setq org-export-latex-header
+ (concat (substring org-export-latex-header 0 (match-end 1))
+ org-export-latex-class-options
+ (substring org-export-latex-header (match-end 0))))))
+
+(defvar org-export-latex-format-toc-function
+ 'org-export-latex-format-toc-default
+ "The function formatting returning the string to create the table of contents.
+The function mus take one parameter, the depth of the table of contents.")
+
+(defun org-export-latex-make-header (title opt-plist)
+ "Make the LaTeX header and return it as a string.
+TITLE is the current title from the buffer or region.
+OPT-PLIST is the options plist for current buffer."
+ (let ((toc (plist-get opt-plist :table-of-contents))
+ (author (org-export-apply-macros-in-string
+ (plist-get opt-plist :author)))
+ (email (replace-regexp-in-string
+ "_" "\\\\_"
+ (org-export-apply-macros-in-string
+ (plist-get opt-plist :email))))
+ (description (org-export-apply-macros-in-string
+ (plist-get opt-plist :description)))
+ (keywords (org-export-apply-macros-in-string
+ (plist-get opt-plist :keywords))))
+ (concat
+ (if (plist-get opt-plist :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; insert LaTeX custom header and packages from the list
+ (org-splice-latex-header
+ (org-export-apply-macros-in-string org-export-latex-header)
+ org-export-latex-default-packages-alist
+ org-export-latex-packages-alist nil
+ (org-export-apply-macros-in-string
+ (plist-get opt-plist :latex-header-extra)))
+ ;; append another special variable
+ (org-export-apply-macros-in-string org-export-latex-append-header)
+ ;; define alert if not yet defined
+ "\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
+ ;; insert the title
+ (format
+ "\n\n\\title{%s}\n"
+ (org-export-latex-fontify-headline title))
+ ;; insert author info
+ (if (plist-get opt-plist :author-info)
+ (format "\\author{%s%s}\n"
+ (org-export-latex-fontify-headline (or author user-full-name))
+ (if (and (plist-get opt-plist :email-info) email
+ (string-match "\\S-" email))
+ (format "\\thanks{%s}" email)
+ ""))
+ (format "%%\\author{%s}\n"
+ (org-export-latex-fontify-headline (or author user-full-name))))
+ ;; insert the date
+ (format "\\date{%s}\n"
+ (format-time-string
+ (or (plist-get opt-plist :date)
+ org-export-latex-date-format)))
+ ;; add some hyperref options
+ (format org-export-latex-hyperref-options-format
+ (org-export-latex-fontify-headline keywords)
+ (org-export-latex-fontify-headline description)
+ (org-version))
+ ;; beginning of the document
+ "\n\\begin{document}\n\n"
+ ;; insert the title command
+ (when (string-match "\\S-" title)
+ (if (string-match "%s" org-export-latex-title-command)
+ (format org-export-latex-title-command title)
+ org-export-latex-title-command))
+ "\n\n"
+ ;; table of contents
+ (when (and org-export-with-toc
+ (plist-get opt-plist :section-numbers))
+ (funcall org-export-latex-format-toc-function
+ (cond ((numberp toc)
+ (min toc (plist-get opt-plist :headline-levels)))
+ (toc (plist-get opt-plist :headline-levels))))))))
+
+(defun org-export-latex-format-toc-default (depth)
+ (when depth
+ (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n"
+ depth)))
+
+(defun org-export-latex-first-lines (opt-plist &optional beg end)
+ "Export the first lines before first headline.
+If BEG is non-nil, it is the beginning of the region.
+If END is non-nil, it is the end of the region."
+ (save-excursion
+ (goto-char (or beg (point-min)))
+ (let* ((pt (point))
+ (end (if (re-search-forward
+ (concat "^" (org-get-limited-outline-regexp)) end t)
+ (goto-char (match-beginning 0))
+ (goto-char (or end (point-max))))))
+ (prog1
+ (org-export-latex-content
+ (org-export-preprocess-string
+ (buffer-substring pt end)
+ :for-backend 'latex
+ :emph-multiline t
+ :add-text nil
+ :comments nil
+ :skip-before-1st-heading nil
+ :LaTeX-fragments nil
+ :timestamps (plist-get opt-plist :timestamps)
+ :footnotes (plist-get opt-plist :footnotes)))
+ (org-unmodified
+ (let ((inhibit-read-only t)
+ (limit (max pt (1- end))))
+ (add-text-properties pt limit
+ '(:org-license-to-kill t))
+ (save-excursion
+ (goto-char pt)
+ (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t)
+ (let ((case-fold-search t))
+ (unless (org-string-match-p
+ "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)"
+ (match-string 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(:org-license-to-kill t))))))))))))
+
+
+(defvar org-export-latex-header-defs nil
+ "The header definitions that might be used in the LaTeX body.")
+
+(defun org-export-latex-content (content &optional exclude-list)
+ "Convert CONTENT string to LaTeX.
+Don't perform conversions that are in EXCLUDE-LIST. Recognized
+conversion types are: quotation-marks, emphasis, sub-superscript,
+links, keywords, lists, tables, fixed-width"
+ (with-temp-buffer
+ (org-install-letbind)
+ (insert content)
+ (unless (memq 'timestamps exclude-list)
+ (org-export-latex-time-stamps))
+ (unless (memq 'quotation-marks exclude-list)
+ (org-export-latex-quotation-marks))
+ (unless (memq 'emphasis exclude-list)
+ (when (plist-get org-export-latex-options-plist :emphasize)
+ (org-export-latex-fontify)))
+ (unless (memq 'sub-superscript exclude-list)
+ (org-export-latex-special-chars
+ (plist-get org-export-latex-options-plist :sub-superscript)))
+ (unless (memq 'links exclude-list)
+ (org-export-latex-links))
+ (unless (memq 'keywords exclude-list)
+ (org-export-latex-keywords))
+ (unless (memq 'lists exclude-list)
+ (org-export-latex-lists))
+ (unless (memq 'tables exclude-list)
+ (org-export-latex-tables
+ (plist-get org-export-latex-options-plist :tables)))
+ (unless (memq 'fixed-width exclude-list)
+ (org-export-latex-fixed-width
+ (plist-get org-export-latex-options-plist :fixed-width)))
+ ;; return string
+ (buffer-substring (point-min) (point-max))))
+
+(defun org-export-latex-protect-string (s)
+ "Add the org-protected property to string S."
+ (add-text-properties 0 (length s) '(org-protected t) s) s)
+
+(defun org-export-latex-protect-char-in-string (char-list string)
+ "Add org-protected text-property to char from CHAR-LIST in STRING."
+ (with-temp-buffer
+ (save-match-data
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward (regexp-opt char-list) nil t)
+ (add-text-properties (match-beginning 0)
+ (match-end 0) '(org-protected t)))
+ (buffer-string))))
+
+(defun org-export-latex-keywords-maybe (&optional remove-list)
+ "Maybe remove keywords depending on rules in REMOVE-LIST."
+ (goto-char (point-min))
+ (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
+ (case-fold-search nil)
+ (todo-markup org-export-latex-todo-keyword-markup)
+ fmt)
+ ;; convert TODO keywords
+ (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
+ (if (plist-get remove-list :todo)
+ (replace-match "")
+ (setq fmt (cond
+ ((stringp todo-markup) todo-markup)
+ ((and (consp todo-markup) (stringp (car todo-markup)))
+ (if (member (match-string 1) org-export-latex-done-keywords)
+ (cdr todo-markup) (car todo-markup)))
+ (t (cdr (or (assoc (match-string 1) todo-markup)
+ (car todo-markup))))))
+ (replace-match (org-export-latex-protect-string
+ (format fmt (match-string 1))) t t)))
+ ;; convert priority string
+ (when (re-search-forward "\\[\\\\#.\\]" nil t)
+ (if (plist-get remove-list :priority)
+ (replace-match "")
+ (replace-match (format "\\textbf{%s}" (match-string 0)) t t)))
+ ;; convert tags
+ (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t)
+ (if (or (not org-export-with-tags)
+ (plist-get remove-list :tags))
+ (replace-match "")
+ (replace-match
+ (org-export-latex-protect-string
+ (format org-export-latex-tag-markup
+ (save-match-data
+ (replace-regexp-in-string
+ "\\([_#]\\)" "\\\\\\1" (match-string 0)))))
+ t t)))))
+
+(defun org-export-latex-fontify-headline (string)
+ "Fontify special words in STRING."
+ (with-temp-buffer
+ ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
+ ;; the beginning of the buffer - inserting "\n" is safe here though.
+ (insert "\n" string)
+
+ ;; Preserve math snippets
+
+ (let* ((matchers (plist-get org-format-latex-options :matchers))
+ (re-list org-latex-regexps)
+ beg end re e m n block off)
+ ;; Check the different regular expressions
+ (while (setq e (pop re-list))
+ (setq m (car e) re (nth 1 e) n (nth 2 e)
+ block (if (nth 3 e) "\n\n" ""))
+ (setq off (if (member m '("$" "$1")) 1 0))
+ (when (and (member m matchers) (not (equal m "begin")))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
+ (add-text-properties beg end
+ '(org-protected t org-latex-math t))))))
+
+ ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
+ (unless (eq (char-before (match-beginning 1)) ?\\)
+ (org-if-unprotected-1
+ (replace-match (org-export-latex-protect-string
+ (concat "\\" (match-string 1)
+ "{}")) t t)))))
+ (goto-char (point-min))
+ (let ((re (concat "\\\\\\([a-zA-Z]+\\)"
+ "\\(?:<[^<>\n]*>\\)*"
+ "\\(?:\\[[^][\n]*?\\]\\)*"
+ "\\(?:<[^<>\n]*>\\)*"
+ "\\("
+ (org-create-multibrace-regexp "{" "}" 3)
+ "\\)\\{1,3\\}")))
+ (while (re-search-forward re nil t)
+ (unless (or
+ ;; check for comment line
+ (save-excursion (goto-char (match-beginning 0))
+ (org-in-indented-comment-line))
+ ;; Check if this is a defined entity, so that is may need conversion
+ (org-entity-get (match-string 1)))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-protected t)))))
+ (when (plist-get org-export-latex-options-plist :emphasize)
+ (org-export-latex-fontify))
+ (org-export-latex-time-stamps)
+ (org-export-latex-quotation-marks)
+ (org-export-latex-keywords-maybe)
+ (org-export-latex-special-chars
+ (plist-get org-export-latex-options-plist :sub-superscript))
+ (org-export-latex-links)
+ (org-trim (buffer-string))))
+
+(defun org-export-latex-time-stamps ()
+ "Format time stamps."
+ (goto-char (point-min))
+ (let ((org-display-custom-times org-export-latex-display-custom-times))
+ (while (re-search-forward org-ts-regexp-both nil t)
+ (org-if-unprotected-at (1- (point))
+ (replace-match
+ (org-export-latex-protect-string
+ (format (if (string= "<" (substring (match-string 0) 0 1))
+ org-export-latex-timestamp-markup
+ org-export-latex-timestamp-inactive-markup)
+ (substring (org-translate-time (match-string 0)) 1 -1)))
+ t t)))))
+
+(defun org-export-latex-quotation-marks ()
+ "Export quotation marks depending on language conventions."
+ (mapc (lambda(l)
+ (goto-char (point-min))
+ (while (re-search-forward (car l) nil t)
+ (let ((rpl (concat (match-string 1)
+ (org-export-latex-protect-string
+ (copy-sequence (cdr l))))))
+ (org-if-unprotected-1
+ (replace-match rpl t t)))))
+ (cdr (or (assoc (plist-get org-export-latex-options-plist :language)
+ org-export-latex-quotes)
+ ;; falls back on english
+ (assoc "en" org-export-latex-quotes)))))
+
+(defun org-export-latex-special-chars (sub-superscript)
+ "Export special characters to LaTeX.
+If SUB-SUPERSCRIPT is non-nil, convert \\ and ^.
+See the `org-export-latex.el' code for a complete conversion table."
+ (goto-char (point-min))
+ (mapc (lambda(c)
+ (goto-char (point-min))
+ (while (re-search-forward c nil t)
+ ;; Put the point where to check for org-protected
+ (unless (get-text-property (match-beginning 2) 'org-protected)
+ (cond ((member (match-string 2) '("\\$" "$"))
+ (if (equal (match-string 2) "\\$")
+ nil
+ (replace-match "\\$" t t)))
+ ((member (match-string 2) '("&" "%" "#"))
+ (if (equal (match-string 1) "\\")
+ (replace-match (match-string 2) t t)
+ (replace-match (concat (match-string 1) "\\"
+ (match-string 2)) t t)
+ (backward-char 1)))
+ ((equal (match-string 2) "...")
+ (replace-match
+ (concat (match-string 1)
+ (org-export-latex-protect-string "\\ldots{}")) t t))
+ ((equal (match-string 2) "~")
+ (cond ((equal (match-string 1) "\\") nil)
+ ((eq 'org-link (get-text-property 0 'face (match-string 2)))
+ (replace-match (concat (match-string 1) "\\~") t t))
+ (t (replace-match
+ (org-export-latex-protect-string
+ (concat (match-string 1) "\\~{}")) t t))))
+ ((member (match-string 2) '("{" "}"))
+ (unless (save-match-data (org-inside-latex-math-p))
+ (if (equal (match-string 1) "\\")
+ (replace-match (match-string 2) t t)
+ (replace-match (concat (match-string 1) "\\"
+ (match-string 2)) t t)))))
+ (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p)))
+ (cond ((equal (match-string 2) "\\")
+ (replace-match (or (save-match-data
+ (org-export-latex-treat-backslash-char
+ (match-string 1)
+ (or (match-string 3) "")))
+ "") t t)
+ (when (and (get-text-property (1- (point)) 'org-entity)
+ (looking-at "{}"))
+ ;; OK, this was an entity replacement, and the user
+ ;; had terminated the entity with {}. Make sure
+ ;; {} is protected as well, and remove the extra {}
+ ;; inserted by the conversion.
+ (put-text-property (point) (+ 2 (point)) 'org-protected t)
+ (if (save-excursion (goto-char (max (- (point) 2) (point-min)))
+ (looking-at "{}"))
+ (replace-match ""))
+ (forward-char 2))
+ (backward-char 1))
+ ((member (match-string 2) '("_" "^"))
+ (replace-match (or (save-match-data
+ (org-export-latex-treat-sub-super-char
+ sub-superscript
+ (match-string 2)
+ (match-string 1)
+ (match-string 3))) "") t t)
+ (backward-char 1)))))))
+ '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$"
+ "\\(\\(\\\\?\\$\\)\\)"
+ "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)"
+ "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)"
+ "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)"
+ ;; (?\< . "\\textless{}")
+ ;; (?\> . "\\textgreater{}")
+ )))
+
+(defun org-inside-latex-math-p ()
+ (get-text-property (point) 'org-latex-math))
+
+(defun org-export-latex-treat-sub-super-char
+ (subsup char string-before string-after)
+ "Convert the \"_\" and \"^\" characters to LaTeX.
+SUBSUP corresponds to the ^: option in the #+OPTIONS line.
+Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
+ (cond ((equal string-before "\\")
+ (concat string-before char string-after))
+ ((and (string-match "\\S-+" string-after))
+ ;; this is part of a math formula
+ (cond ((eq 'org-link (get-text-property 0 'face char))
+ (concat string-before "\\" char string-after))
+ ((save-match-data (org-inside-latex-math-p))
+ (if subsup
+ (cond ((eq 1 (length string-after))
+ (concat string-before char string-after))
+ ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after)
+ (format "%s%s{%s}" string-before char
+ (match-string 1 string-after))))))
+ ((and (> (length string-after) 1)
+ (or (eq subsup t)
+ (and (equal subsup '{}) (eq (string-to-char string-after) ?\{)))
+ (or (string-match "[{]?\\([^}]+\\)[}]?" string-after)
+ (string-match "[(]?\\([^)]+\\)[)]?" string-after)))
+
+ (org-export-latex-protect-string
+ (format "%s$%s{%s}$" string-before char
+ (if (and (> (match-end 1) (1+ (match-beginning 1)))
+ (not (equal (substring string-after 0 2) "{\\")))
+ (concat "\\mathrm{" (match-string 1 string-after) "}")
+ (match-string 1 string-after)))))
+ ((eq subsup t) (concat string-before "$" char string-after "$"))
+ (t (org-export-latex-protect-string
+ (concat string-before "\\" char "{}" string-after)))))
+ (t (org-export-latex-protect-string
+ (concat string-before "\\" char "{}" string-after)))))
+
+(defun org-export-latex-treat-backslash-char (string-before string-after)
+ "Convert the \"$\" special character to LaTeX.
+The conversion is made depending of STRING-BEFORE and STRING-AFTER."
+ (let ((ass (org-entity-get string-after)))
+ (cond
+ (ass (org-add-props
+ (if (nth 2 ass)
+ (concat string-before
+ (org-export-latex-protect-string
+ (concat "$" (nth 1 ass) "$")))
+ (concat string-before (org-export-latex-protect-string
+ (nth 1 ass))))
+ nil 'org-entity t))
+ ((and (not (string-match "^[ \n\t]" string-after))
+ (not (string-match "[ \t]\\'\\|^" string-before)))
+ ;; backslash is inside a word
+ (concat string-before
+ (org-export-latex-protect-string
+ (concat "\\textbackslash{}" string-after))))
+ ((not (or (equal string-after "")
+ (string-match "^[ \t\n]" string-after)))
+ ;; backslash might escape a character (like \#) or a user TeX
+ ;; macro (like \setcounter)
+ (concat string-before
+ (org-export-latex-protect-string (concat "\\" string-after))))
+ ((and (string-match "^[ \t\n]" string-after)
+ (string-match "[ \t\n]\\'" string-before))
+ ;; backslash is alone, convert it to $\backslash$
+ (org-export-latex-protect-string
+ (concat string-before "\\textbackslash{}" string-after)))
+ (t (org-export-latex-protect-string
+ (concat string-before "\\textbackslash{}" string-after))))))
+
+(defun org-export-latex-keywords ()
+ "Convert special keywords to LaTeX."
+ (goto-char (point-min))
+ (while (re-search-forward org-export-latex-special-keyword-regexp nil t)
+ (replace-match (format org-export-latex-timestamp-keyword-markup
+ (match-string 0)) t t)
+ (save-excursion
+ (beginning-of-line 1)
+ (unless (looking-at ".*\n[ \t]*\n")
+ (end-of-line 1)
+ (insert "\n")))))
+
+(defun org-export-latex-fixed-width (opt)
+ "When OPT is non-nil convert fixed-width sections to LaTeX."
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
+ (unless (get-text-property (point) 'org-example)
+ (if opt
+ (progn (goto-char (match-beginning 0))
+ (insert "\\begin{verbatim}\n")
+ (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
+ (replace-match (concat (match-string 1)
+ (match-string 2)) t t)
+ (forward-line))
+ (insert "\\end{verbatim}\n"))
+ (progn (goto-char (match-beginning 0))
+ (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
+ (replace-match (concat "%" (match-string 1)
+ (match-string 2)) t t)
+ (forward-line)))))))
+
+(defvar org-table-last-alignment) ; defined in org-table.el
+(defvar org-table-last-column-widths) ; defined in org-table.el
+(declare-function orgtbl-to-latex "org-table" (table params) t)
+(defun org-export-latex-tables (insert)
+ "Convert tables to LaTeX and INSERT it."
+ ;; First, get the table.el tables
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t)
+ (org-if-unprotected
+ (require 'table)
+ (org-export-latex-convert-table.el-table)))
+
+ ;; And now the Org-mode tables
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([ \t]*\\)|" nil t)
+ (org-if-unprotected-at (1- (point))
+ (org-table-align)
+ (let* ((beg (org-table-begin))
+ (end (org-table-end))
+ (raw-table (buffer-substring beg end))
+ (org-table-last-alignment (copy-sequence org-table-last-alignment))
+ (org-table-last-column-widths (copy-sequence
+ org-table-last-column-widths))
+ fnum fields line lines olines gr colgropen line-fmt align
+ caption width shortn label attr hfmt floatp placement
+ longtblp tblenv tabular-env)
+ (if org-export-latex-tables-verbatim
+ (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
+ "\\end{verbatim}\n")))
+ (apply 'delete-region (list beg end))
+ (insert (org-export-latex-protect-string tbl)))
+ (progn
+ (setq caption (org-find-text-property-in-string
+ 'org-caption raw-table)
+ shortn (org-find-text-property-in-string
+ 'org-caption-shortn raw-table)
+ attr (org-find-text-property-in-string
+ 'org-attributes raw-table)
+ label (org-find-text-property-in-string
+ 'org-label raw-table)
+ longtblp (and attr (stringp attr)
+ (string-match "\\<longtable\\>" attr))
+ tblenv (if (and attr (stringp attr))
+ (cond ((string-match "\\<sidewaystable\\>" attr)
+ "sidewaystable")
+ ((or (string-match (regexp-quote "table*") attr)
+ (string-match "\\<multicolumn\\>" attr))
+ "table*")
+ (t "table"))
+ "table")
+ tabular-env
+ (if (and attr (stringp attr)
+ (string-match "\\(tabular.\\)" attr))
+ (match-string 1 attr)
+ org-export-latex-tabular-environment)
+ width (and attr (stringp attr)
+ (string-match "\\<width=\\([^ \t\n\r]+\\)" attr)
+ (match-string 1 attr))
+ align (and attr (stringp attr)
+ (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
+ (match-string 1 attr))
+ hfmt (and attr (stringp attr)
+ (string-match "\\<hfmt=\\(\\S-+\\)" attr)
+ (match-string 1 attr))
+ floatp (or caption label (string= "table*" tblenv))
+ placement (if (and attr
+ (stringp attr)
+ (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
+ (match-string 1 attr)
+ (concat
+ "[" org-latex-default-figure-position "]")))
+ (setq caption (and caption (org-export-latex-fontify-headline caption)))
+ (setq lines (org-split-string raw-table "\n"))
+ (apply 'delete-region (list beg end))
+ (when org-export-table-remove-special-lines
+ (setq lines (org-table-clean-before-export lines 'maybe-quoted)))
+ (when org-table-clean-did-remove-column
+ (pop org-table-last-alignment)
+ (pop org-table-last-column-widths))
+ ;; make a format string to reflect alignment
+ (setq olines lines)
+ (while (and (not line-fmt) (setq line (pop olines)))
+ (unless (string-match "^[ \t]*|-" line)
+ (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (setq fnum (make-vector (length fields) 0))
+ (setq line-fmt
+ (mapconcat
+ (lambda (x)
+ (setq gr (pop org-table-colgroup-info))
+ (format "%s%%s%s"
+ (cond ((eq gr :start)
+ (prog1 (if colgropen "|" "|")
+ (setq colgropen t)))
+ ((eq gr :startend)
+ (prog1 (if colgropen "|" "|")
+ (setq colgropen nil)))
+ (t ""))
+ (if (memq gr '(:end :startend))
+ (progn (setq colgropen nil) "|")
+ "")))
+ fnum ""))))
+ ;; fix double || in line-fmt
+ (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt))
+ ;; maybe remove the first and last "|"
+ (when (and (not org-export-latex-tables-column-borders)
+ (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt))
+ (setq line-fmt (match-string 2 line-fmt)))
+ ;; format alignment
+ (unless align
+ (setq align (apply 'format
+ (cons line-fmt
+ (mapcar (lambda (x) (if x "r" "l"))
+ org-table-last-alignment)))))
+ ;; prepare the table to send to orgtbl-to-latex
+ (setq lines
+ (mapcar
+ (lambda(elem)
+ (or (and (string-match "[ \t]*|-+" elem) 'hline)
+ (org-split-string
+ (progn (set-text-properties 0 (length elem) nil elem)
+ (org-trim elem)) "|")))
+ lines))
+ (when insert
+ (insert (org-export-latex-protect-string
+ (concat
+ (if longtblp
+ (concat "\\begin{longtable}{" align "}\n")
+ (if floatp
+ (format "\\begin{%s}%s\n" tblenv placement)))
+ (if (and floatp org-export-latex-table-caption-above)
+ (format
+ "\\caption%s{%s} %s"
+ (if shortn (concat "[" shortn "]") "")
+ (or caption "")
+ (if label (format "\\label{%s}" label) "")))
+ (if (and longtblp caption org-export-latex-table-caption-above)
+ "\\\\\n" "\n")
+ (if (and org-export-latex-tables-centered (not longtblp))
+ "\\begin{center}\n")
+ (if (not longtblp)
+ (format "\\begin{%s}%s{%s}\n"
+ tabular-env
+ (if width (format "{%s}" width) "")
+ align))
+ (orgtbl-to-latex
+ lines
+ `(:tstart ,org-export-latex-tables-tstart
+ :tend ,org-export-latex-tables-tend
+ :hline ,org-export-latex-tables-hline
+ :skipheadrule ,longtblp
+ :hfmt ,hfmt
+ :hlend ,(if longtblp
+ (format "\\\\
+%s
+\\endhead
+%s\\multicolumn{%d}{r}{Continued on next page}\\
+\\endfoot
+\\endlastfoot"
+ org-export-latex-tables-hline
+ org-export-latex-tables-hline
+ (length org-table-last-alignment))
+ nil)))
+ (if (not longtblp) (format "\n\\end{%s}" tabular-env))
+ (if longtblp "\n" (if org-export-latex-tables-centered
+ "\n\\end{center}\n" "\n"))
+ (if (and floatp (not org-export-latex-table-caption-above))
+ (format
+ "\\caption%s{%s} %s"
+ (if shortn (concat "[" shortn "]") "")
+ (or caption "")
+ (if label (format "\\label{%s}" label) "")))
+ (if longtblp
+ "\\end{longtable}"
+ (if floatp (format "\\end{%s}" tblenv)))))
+ "\n\n"))))))))
+
+(defun org-export-latex-convert-table.el-table ()
+ "Replace table.el table at point with LaTeX code."
+ (let (tbl caption shortn label line floatp attr align rmlines)
+ (setq line (buffer-substring (point-at-bol) (point-at-eol))
+ label (org-get-text-property-any 0 'org-label line)
+ caption (org-get-text-property-any 0 'org-caption line)
+ shortn (org-get-text-property-any 0 'org-caption-shortn line)
+ attr (org-get-text-property-any 0 'org-attributes line)
+ align (and attr (stringp attr)
+ (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr)
+ (match-string 1 attr))
+ rmlines (and attr (stringp attr)
+ (string-match "\\<rmlines\\>" attr))
+ floatp (or label caption))
+ (and (get-buffer "*org-export-table*")
+ (kill-buffer (get-buffer "*org-export-table*")))
+ (table-generate-source 'latex "*org-export-table*" "caption")
+ (setq tbl (with-current-buffer "*org-export-table*"
+ (buffer-string)))
+ (while (string-match "^%.*\n" tbl)
+ (setq tbl (replace-match "" t t tbl)))
+ ;; fix the hlines
+ (when rmlines
+ (let ((n 0) lines)
+ (setq lines (mapcar (lambda (x)
+ (if (string-match "^\\\\hline$" x)
+ (progn
+ (setq n (1+ n))
+ (if (= n 2) x nil))
+ x))
+ (org-split-string tbl "\n")))
+ (setq tbl (mapconcat 'identity (delq nil lines) "\n"))))
+ (when (and align (string-match "\\\\begin{tabular}{.*}" tbl))
+ (setq tbl (replace-match (concat "\\begin{tabular}{" align "}")
+ t t tbl)))
+ (and (get-buffer "*org-export-table*")
+ (kill-buffer (get-buffer "*org-export-table*")))
+ (beginning-of-line 0)
+ (while (looking-at "[ \t]*\\(|\\|\\+-\\)")
+ (delete-region (point) (1+ (point-at-eol))))
+ (when org-export-latex-tables-centered
+ (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}")))
+ (when floatp
+ (setq tbl (concat "\\begin{table}\n"
+ (if (not org-export-latex-table-caption-above) tbl)
+ (format "\\caption%s{%s%s}\n"
+ (if shortn (format "[%s]" shortn) "")
+ (if label (format "\\label{%s}" label) "")
+ (or caption ""))
+ (if org-export-latex-table-caption-above tbl)
+ "\n\\end{table}\n")))
+ (insert (org-export-latex-protect-string tbl))))
+
+(defun org-export-latex-fontify ()
+ "Convert fontification to LaTeX."
+ (goto-char (point-min))
+ (while (re-search-forward org-emph-re nil t)
+ ;; The match goes one char after the *string*, except at the end of a line
+ (let ((emph (assoc (match-string 3)
+ org-export-latex-emphasis-alist))
+ (beg (match-beginning 0))
+ (end (match-end 0))
+ rpl s)
+ (unless emph
+ (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\""
+ (match-string 3)))
+ (unless (or (and (get-text-property (- (point) 2) 'org-protected)
+ (not (get-text-property
+ (- (point) 2) 'org-verbatim-emph)))
+ (equal (char-after (match-beginning 3))
+ (char-after (1+ (match-beginning 3))))
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (save-match-data
+ (and (org-at-table-p)
+ (string-match
+ "[|\n]" (buffer-substring beg end)))))
+ (and (equal (match-string 3) "+")
+ (save-match-data
+ (string-match "\\`-+\\'" (match-string 4)))))
+ (setq s (match-string 4))
+ (setq rpl (concat (match-string 1)
+ (org-export-latex-emph-format (cadr emph)
+ (match-string 4))
+ (match-string 5)))
+ (if (caddr emph)
+ (setq rpl (org-export-latex-protect-string rpl))
+ (save-match-data
+ (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl)
+ (progn
+ (add-text-properties (match-beginning 1) (match-end 1)
+ '(org-protected t) rpl)
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(org-protected t) rpl)))))
+ (replace-match rpl t t)))
+ (backward-char)))
+
+(defun org-export-latex-emph-format (format string)
+ "Format an emphasis string and handle the \\verb special case."
+ (when (member format '("\\verb" "\\protectedtexttt"))
+ (save-match-data
+ (if (equal format "\\verb")
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (catch 'exit
+ (loop for i from 0 to (1- (length ll)) do
+ (if (not (string-match (regexp-quote (substring ll i (1+ i)))
+ string))
+ (progn
+ (setq format (concat "\\verb" (substring ll i (1+ i))
+ "%s" (substring ll i (1+ i))))
+ (throw 'exit nil))))))
+ (let ((start 0)
+ (trans '(("\\" . "\\textbackslash{}")
+ ("~" . "\\textasciitilde{}")
+ ("^" . "\\textasciicircum{}")))
+ (rtn "") char)
+ (while (string-match "[\\{}$%&_#~^]" string)
+ (setq char (match-string 0 string))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring string
+ 0 (match-beginning 0)))))
+ (setq string (substring string (1+ (match-beginning 0))))
+ (setq char (or (cdr (assoc char trans)) (concat "\\" char))
+ rtn (concat rtn char)))
+ (setq string (concat rtn string) format "\\texttt{%s}")
+ (while (string-match "--" string)
+ (setq string (replace-match "-{}-" t t string)))))))
+ (format format string))
+
+(defun org-export-latex-links ()
+ ;; Make sure to use the LaTeX hyperref and graphicx package
+ ;; or send some warnings.
+ "Convert links to LaTeX."
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-analytic-regexp++ nil t)
+ (org-if-unprotected-1
+ (goto-char (match-beginning 0))
+ (let* ((re-radio org-export-latex-all-targets-re)
+ (remove (list (match-beginning 0) (match-end 0)))
+ (raw-path (org-extract-attributes (match-string 3)))
+ (full-raw-path (concat (match-string 1) raw-path))
+ (desc (match-string 5))
+ (type (or (match-string 2)
+ (if (or (file-name-absolute-p raw-path)
+ (string-match "^\\.\\.?/" raw-path))
+ "file")))
+ (coderefp (equal type "coderef"))
+ (caption (org-find-text-property-in-string 'org-caption raw-path))
+ (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path))
+ (attr (or (org-find-text-property-in-string 'org-attributes raw-path)
+ (plist-get org-export-latex-options-plist :latex-image-options)))
+ (label (org-find-text-property-in-string 'org-label raw-path))
+ imgp radiop fnc
+ ;; define the path of the link
+ (path (cond
+ ((member type '("coderef"))
+ raw-path)
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((and re-radio (string-match re-radio raw-path))
+ (setq radiop t))
+ ((equal type "mailto")
+ (concat type ":" raw-path))
+ ((equal type "file")
+ (if (and (org-file-image-p
+ (expand-file-name
+ raw-path)
+ org-export-latex-inline-image-extensions)
+ (or (get-text-property 0 'org-no-description
+ raw-path)
+ (equal desc full-raw-path)))
+ (setq imgp t)
+ (progn (when (string-match "\\(.+\\)::.+" raw-path)
+ (setq raw-path (match-string 1 raw-path)))
+ (if (file-exists-p raw-path)
+ (concat type "://" (expand-file-name raw-path))
+ (concat type "://" (org-export-directory
+ :LaTeX org-export-latex-options-plist)
+ raw-path))))))))
+ ;; process with link inserting
+ (apply 'delete-region remove)
+ (setq caption (and caption (org-export-latex-fontify-headline caption)))
+ (cond ((and imgp
+ (plist-get org-export-latex-options-plist :inline-images))
+ ;; OK, we need to inline an image
+ (insert
+ (org-export-latex-format-image raw-path caption label attr shortn)))
+ (coderefp
+ (insert (format
+ (org-export-get-coderef-format path desc)
+ (cdr (assoc path org-export-code-refs)))))
+ (radiop (insert (format org-export-latex-hyperref-format
+ (org-solidify-link-text raw-path) desc)))
+ ((not type)
+ (insert (format org-export-latex-hyperref-format
+ (org-remove-initial-hash
+ (org-solidify-link-text raw-path))
+ desc)))
+ (path
+ (when (org-at-table-p)
+ ;; There is a strange problem when we have a link in a table,
+ ;; ampersands then cause a problem. I think this must be
+ ;; a LaTeX issue, but we here implement a work-around anyway.
+ (setq path (org-export-latex-protect-amp path)
+ desc (org-export-latex-protect-amp desc)))
+ (insert
+ (if (string-match "%s.*%s" org-export-latex-href-format)
+ (format org-export-latex-href-format path desc)
+ (format org-export-latex-href-format path))))
+
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for formatting the link
+ (insert
+ (save-match-data
+ (funcall fnc (org-link-unescape raw-path) desc 'latex))))
+ ;; Unrecognized path type
+ (t (insert (format org-export-latex-link-with-unknown-path-format desc))))))))
+
+
+(defun org-export-latex-format-image (path caption label attr &optional shortn)
+ "Format the image element, depending on user settings."
+ (let (ind floatp wrapp multicolumnp placement figenv)
+ (setq floatp (or caption label))
+ (setq ind (org-get-text-property-any 0 'original-indentation path))
+ (when (and attr (stringp attr))
+ (if (string-match "[ \t]*\\<wrap\\>" attr)
+ (setq wrapp t floatp nil attr (replace-match "" t t attr)))
+ (if (string-match "[ \t]*\\<float\\>" attr)
+ (setq wrapp nil floatp t attr (replace-match "" t t attr)))
+ (if (string-match "[ \t]*\\<multicolumn\\>" attr)
+ (setq multicolumnp t attr (replace-match "" t t attr))))
+
+ (setq placement
+ (cond
+ (wrapp "{l}{0.5\\textwidth}")
+ (floatp (concat "[" org-latex-default-figure-position "]"))
+ (t "")))
+
+ (when (and attr (stringp attr)
+ (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
+ (setq placement (match-string 1 attr)
+ attr (replace-match "" t t attr)))
+ (setq attr (and attr (org-trim attr)))
+ (when (or (not attr) (= (length attr) 0))
+ (setq attr (cond (floatp "width=0.7\\textwidth")
+ (wrapp "width=0.48\\textwidth")
+ (t attr))))
+ (setq figenv
+ (cond
+ (wrapp "\\begin{wrapfigure}%placement
+\\centering
+\\includegraphics[%attr]{%path}
+\\caption%shortn{%labelcmd%caption}
+\\end{wrapfigure}")
+ (multicolumnp "\\begin{figure*}%placement
+\\centering
+\\includegraphics[%attr]{%path}
+\\caption%shortn{%labelcmd%caption}
+\\end{figure*}")
+ (floatp "\\begin{figure}%placement
+\\centering
+\\includegraphics[%attr]{%path}
+\\caption%shortn{%labelcmd%caption}
+\\end{figure}")
+ (t "\\includegraphics[%attr]{%path}")))
+
+
+ (setq figenv (mapconcat 'identity (split-string figenv "\n")
+ (save-excursion (beginning-of-line 1)
+ (looking-at "[ \t]*")
+ (concat "\n" (match-string 0)))))
+
+ (if (and (not label) (not caption)
+ (string-match "^\\\\caption{.*\n" figenv))
+ (setq figenv (replace-match "" t t figenv)))
+ (org-add-props
+ (org-fill-template
+ figenv
+ (list (cons "path"
+ (if (file-name-absolute-p path)
+ (expand-file-name path)
+ path))
+ (cons "attr" attr)
+ (cons "shortn" (if shortn (format "[%s]" shortn) ""))
+ (cons "labelcmd" (if label (format "\\label{%s}"
+ label)""))
+ (cons "caption" (or caption ""))
+ (cons "placement" (or placement ""))))
+ nil 'original-indentation ind)))
+
+(defun org-export-latex-protect-amp (s)
+ (while (string-match "\\([^\\\\]\\)\\(&\\)" s)
+ (setq s (replace-match (concat (match-string 1 s) "\\" (match-string 2 s))
+ t t s)))
+ s)
+
+(defun org-remove-initial-hash (s)
+ (if (string-match "\\`#" s)
+ (substring s 1)
+ s))
+(defvar org-latex-entities) ; defined below
+(defvar org-latex-entities-regexp) ; defined below
+
+(defun org-export-latex-preprocess (parameters)
+ "Clean stuff in the LaTeX export."
+ ;; Replace footnotes.
+ (when (plist-get parameters :footnotes)
+ (goto-char (point-min))
+ (let (ref)
+ (while (setq ref (org-footnote-get-next-reference))
+ (let* ((beg (nth 1 ref))
+ (lbl (car ref))
+ (def (nth 1 (assoc (string-to-number lbl)
+ (mapcar (lambda (e) (cdr e))
+ org-export-footnotes-seen)))))
+ ;; Fix body for footnotes ending on a link or a list and
+ ;; remove definition from buffer.
+ (setq def
+ (concat def
+ (if (string-match "ORG-LIST-END-MARKER\\'" def)
+ "\n" " ")))
+ (org-footnote-delete-definitions lbl)
+ ;; Compute string to insert (FNOTE), and protect the outside
+ ;; macro from further transformation. When footnote at
+ ;; point is referring to a previously defined footnote, use
+ ;; \footnotemark. Otherwise, use \footnote.
+ (let ((fnote (if (member lbl org-export-latex-footmark-seen)
+ (org-export-latex-protect-string
+ (format "\\footnotemark[%s]" lbl))
+ (push lbl org-export-latex-footmark-seen)
+ (concat (org-export-latex-protect-string "\\footnote{")
+ def
+ (org-export-latex-protect-string "}"))))
+ ;; Check if another footnote is immediately following.
+ ;; If so, add a separator in-between.
+ (sep (org-export-latex-protect-string
+ (if (save-excursion (goto-char (1- (nth 2 ref)))
+ (let ((next (org-footnote-get-next-reference)))
+ (and next (= (nth 1 next) (nth 2 ref)))))
+ org-export-latex-footnote-separator ""))))
+ (when (org-at-heading-p)
+ (setq fnote (concat (org-export-latex-protect-string "\\protect")
+ fnote)))
+ ;; Ensure a footnote at column 0 cannot end a list
+ ;; containing it.
+ (put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
+ ;; Replace footnote reference with FNOTE and, maybe, SEP.
+ ;; `save-excursion' is required if there are two footnotes
+ ;; in a row. In that case, point would be left at the
+ ;; beginning of the second one, and
+ ;; `org-footnote-get-next-reference' would then skip it.
+ (goto-char beg)
+ (delete-region beg (nth 2 ref))
+ (save-excursion (insert fnote sep)))))))
+
+ ;; Remove footnote section tag for LaTeX
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "^" footnote-section-tag-regexp) nil t)
+ (org-if-unprotected
+ (replace-match "")))
+ ;; Remove any left-over footnote definition.
+ (mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
+ org-export-footnotes-data)
+ (mapc (lambda (fn) (org-footnote-delete-definitions fn))
+ org-export-latex-footmark-seen)
+
+ ;; Preserve line breaks
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\\\\\" nil t)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-protected t)))
+
+ ;; Preserve latex environments
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
+ (org-if-unprotected
+ (let* ((start (progn (beginning-of-line) (point)))
+ (end (and (re-search-forward
+ (concat "^[ \t]*\\\\end{"
+ (regexp-quote (match-string 1))
+ "}") nil t)
+ (point-at-eol))))
+ (if end
+ (add-text-properties start end '(org-protected t))
+ (goto-char (point-at-eol))))))
+
+ ;; Preserve math snippets
+ (let* ((matchers (plist-get org-format-latex-options :matchers))
+ (re-list org-latex-regexps)
+ beg end re e m n block off)
+ ;; Check the different regular expressions
+ (while (setq e (pop re-list))
+ (setq m (car e) re (nth 1 e) n (nth 2 e)
+ block (if (nth 3 e) "\n\n" ""))
+ (setq off (if (member m '("$" "$1")) 1 0))
+ (when (and (member m matchers) (not (equal m "begin")))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
+ (add-text-properties beg end '(org-protected t org-latex-math t))))))
+
+ ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
+ (unless (eq (char-before (match-beginning 1)) ?\\)
+ (org-if-unprotected-1
+ (replace-match (org-export-latex-protect-string
+ (concat "\\" (match-string 1)
+ "{}")) t t)))))
+
+ ;; Convert blockquotes
+ (goto-char (point-min))
+ (while (search-forward "ORG-BLOCKQUOTE-START" nil t)
+ (org-replace-match-keep-properties "\\begin{quote}" t t))
+ (goto-char (point-min))
+ (while (search-forward "ORG-BLOCKQUOTE-END" nil t)
+ (org-replace-match-keep-properties "\\end{quote}" t t))
+
+ ;; Convert verse
+ (goto-char (point-min))
+ (while (search-forward "ORG-VERSE-START" nil t)
+ (org-replace-match-keep-properties "\\begin{verse}" t t)
+ (beginning-of-line 2)
+ (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp)))
+ (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)")
+ (goto-char (match-end 1))
+ (org-replace-match-keep-properties
+ (org-export-latex-protect-string
+ (concat "\\hspace*{1cm}" (match-string 2))) t t)
+ (beginning-of-line 1))
+ (if (looking-at "[ \t]*$")
+ (insert (org-export-latex-protect-string "\\vspace*{1em}"))
+ (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$")
+ (end-of-line 1)
+ (insert "\\\\")))
+ (beginning-of-line 2))
+ (and (looking-at "[ \t]*ORG-VERSE-END.*")
+ (org-replace-match-keep-properties "\\end{verse}" t t)))
+
+ ;; Convert #+INDEX to LaTeX \\index.
+ (goto-char (point-min))
+ (let ((case-fold-search t) entry)
+ (while (re-search-forward
+ "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$"
+ nil t)
+ (setq entry
+ (save-match-data
+ (org-export-latex-protect-string
+ (org-export-latex-fontify-headline (match-string 1)))))
+ (replace-match (format "\\index{%s}" entry) t t)))
+
+ ;; Convert center
+ (goto-char (point-min))
+ (while (search-forward "ORG-CENTER-START" nil t)
+ (org-replace-match-keep-properties "\\begin{center}" t t))
+ (goto-char (point-min))
+ (while (search-forward "ORG-CENTER-END" nil t)
+ (org-replace-match-keep-properties "\\end{center}" t t))
+
+ (run-hooks 'org-export-latex-after-blockquotes-hook)
+
+ ;; Convert horizontal rules
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
+ (org-if-unprotected
+ (replace-match (org-export-latex-protect-string "\\hrule") t t)))
+
+ ;; Protect LaTeX commands like \command[...]{...} or \command{...}
+ (goto-char (point-min))
+ (let ((re (concat
+ "\\\\\\([a-zA-Z]+\\*?\\)"
+ "\\(?:<[^<>\n]*>\\)*"
+ "\\(?:\\[[^][\n]*?\\]\\)*"
+ "\\(?:<[^<>\n]*>\\)*"
+ "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
+ (while (re-search-forward re nil t)
+ (unless (or
+ ;; Check for comment line.
+ (save-excursion (goto-char (match-beginning 0))
+ (org-in-indented-comment-line))
+ ;; Check if this is a defined entity, so that is may
+ ;; need conversion.
+ (org-entity-get (match-string 1))
+ ;; Do not protect interior of footnotes. Those have
+ ;; already been taken care of earlier in the function.
+ ;; Yet, keep looking inside them for more commands.
+ (and (equal (match-string 1) "footnote")
+ (goto-char (match-end 1))))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-protected t)))))
+
+ ;; Special case for \nbsp
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t)
+ (org-if-unprotected
+ (replace-match (org-export-latex-protect-string "~"))))
+
+ ;; Protect LaTeX entities
+ (goto-char (point-min))
+ (while (re-search-forward org-latex-entities-regexp nil t)
+ (org-if-unprotected
+ (add-text-properties (match-beginning 0) (match-end 0)
+ '(org-protected t))))
+
+ ;; Replace radio links
+ (goto-char (point-min))
+ (while (re-search-forward
+ (concat "<<<?" org-export-latex-all-targets-re
+ ">>>?\\((INVISIBLE)\\)?") nil t)
+ (org-if-unprotected-at (+ (match-beginning 0) 2)
+ (replace-match
+ (concat
+ (org-export-latex-protect-string
+ (format "\\label{%s}" (save-match-data (org-solidify-link-text
+ (match-string 1)))))
+ (if (match-string 2) "" (match-string 1)))
+ t t)))
+
+ ;; Delete @<...> constructs
+ ;; Thanks to Daniel Clemente for this regexp
+ (goto-char (point-min))
+ (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
+ (org-if-unprotected
+ (replace-match ""))))
+
+(defun org-export-latex-fix-inputenc ()
+ "Set the coding system in inputenc to what the buffer is."
+ (let* ((cs buffer-file-coding-system)
+ (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs))
+ "utf8")))
+ (when opt
+ ;; Translate if that is requested
+ (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt))
+ ;; find the \usepackage statement and replace the option
+ (goto-char (point-min))
+ (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
+ nil t)
+ (goto-char (match-beginning 1))
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert opt))
+ (and buffer-file-name
+ (save-buffer)))))
+
+;;; List handling:
+
+(defun org-export-latex-lists ()
+ "Convert plain text lists in current buffer into LaTeX lists."
+ ;; `org-list-end-re' output has changed since preprocess from
+ ;; org-exp.el. Make sure it is taken into account.
+ (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
+ (mapc
+ (lambda (e)
+ ;; For each type of context allowed for list export (E), find
+ ;; every list, parse it, delete it and insert resulting
+ ;; conversion to latex (RES), while keeping the same
+ ;; `original-indentation' property.
+ (let (res)
+ (goto-char (point-min))
+ (while (re-search-forward (org-item-beginning-re) nil t)
+ (when (and (eq (get-text-property (point) 'list-context) e)
+ (not (get-text-property (point) 'org-example)))
+ (beginning-of-line)
+ (setq res
+ (org-list-to-latex
+ ;; Narrowing is needed because we're converting
+ ;; from inner functions to outer ones.
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (org-list-parse-list t))
+ org-export-latex-list-parameters))
+ ;; Extend previous value of original-indentation to the
+ ;; whole string
+ (insert (org-add-props res nil 'original-indentation
+ (org-find-text-property-in-string
+ 'original-indentation res)))))))
+ ;; List of allowed contexts for export, and the default one.
+ (append org-list-export-context '(nil)))))
+
+(defconst org-latex-entities
+ '("\\!"
+ "\\'"
+ "\\+"
+ "\\,"
+ "\\-"
+ "\\:"
+ "\\;"
+ "\\<"
+ "\\="
+ "\\>"
+ "\\Huge"
+ "\\LARGE"
+ "\\Large"
+ "\\Styles"
+ "\\\\"
+ "\\`"
+ "\\\""
+ "\\addcontentsline"
+ "\\address"
+ "\\addtocontents"
+ "\\addtocounter"
+ "\\addtolength"
+ "\\addvspace"
+ "\\alph"
+ "\\appendix"
+ "\\arabic"
+ "\\author"
+ "\\begin{array}"
+ "\\begin{center}"
+ "\\begin{description}"
+ "\\begin{enumerate}"
+ "\\begin{eqnarray}"
+ "\\begin{equation}"
+ "\\begin{figure}"
+ "\\begin{flushleft}"
+ "\\begin{flushright}"
+ "\\begin{itemize}"
+ "\\begin{list}"
+ "\\begin{minipage}"
+ "\\begin{picture}"
+ "\\begin{quotation}"
+ "\\begin{quote}"
+ "\\begin{tabbing}"
+ "\\begin{table}"
+ "\\begin{tabular}"
+ "\\begin{thebibliography}"
+ "\\begin{theorem}"
+ "\\begin{titlepage}"
+ "\\begin{verbatim}"
+ "\\begin{verse}"
+ "\\bf"
+ "\\bf"
+ "\\bibitem"
+ "\\bigskip"
+ "\\cdots"
+ "\\centering"
+ "\\circle"
+ "\\cite"
+ "\\cleardoublepage"
+ "\\clearpage"
+ "\\cline"
+ "\\closing"
+ "\\dashbox"
+ "\\date"
+ "\\ddots"
+ "\\dotfill"
+ "\\em"
+ "\\fbox"
+ "\\flushbottom"
+ "\\fnsymbol"
+ "\\footnote"
+ "\\footnotemark"
+ "\\footnotesize"
+ "\\footnotetext"
+ "\\frac"
+ "\\frame"
+ "\\framebox"
+ "\\hfill"
+ "\\hline"
+ "\\hrulespace"
+ "\\hspace"
+ "\\huge"
+ "\\hyphenation"
+ "\\include"
+ "\\includeonly"
+ "\\indent"
+ "\\input"
+ "\\it"
+ "\\kill"
+ "\\label"
+ "\\large"
+ "\\ldots"
+ "\\line"
+ "\\linebreak"
+ "\\linethickness"
+ "\\listoffigures"
+ "\\listoftables"
+ "\\location"
+ "\\makebox"
+ "\\maketitle"
+ "\\mark"
+ "\\mbox"
+ "\\medskip"
+ "\\multicolumn"
+ "\\multiput"
+ "\\newcommand"
+ "\\newcounter"
+ "\\newenvironment"
+ "\\newfont"
+ "\\newlength"
+ "\\newline"
+ "\\newpage"
+ "\\newsavebox"
+ "\\newtheorem"
+ "\\nocite"
+ "\\nofiles"
+ "\\noindent"
+ "\\nolinebreak"
+ "\\nopagebreak"
+ "\\normalsize"
+ "\\onecolumn"
+ "\\opening"
+ "\\oval"
+ "\\overbrace"
+ "\\overline"
+ "\\pagebreak"
+ "\\pagenumbering"
+ "\\pageref"
+ "\\pagestyle"
+ "\\par"
+ "\\parbox"
+ "\\put"
+ "\\raggedbottom"
+ "\\raggedleft"
+ "\\raggedright"
+ "\\raisebox"
+ "\\ref"
+ "\\rm"
+ "\\roman"
+ "\\rule"
+ "\\savebox"
+ "\\sc"
+ "\\scriptsize"
+ "\\setcounter"
+ "\\setlength"
+ "\\settowidth"
+ "\\sf"
+ "\\shortstack"
+ "\\signature"
+ "\\sl"
+ "\\small"
+ "\\smallskip"
+ "\\sqrt"
+ "\\tableofcontents"
+ "\\telephone"
+ "\\thanks"
+ "\\thispagestyle"
+ "\\tiny"
+ "\\title"
+ "\\tt"
+ "\\twocolumn"
+ "\\typein"
+ "\\typeout"
+ "\\underbrace"
+ "\\underline"
+ "\\usebox"
+ "\\usecounter"
+ "\\value"
+ "\\vdots"
+ "\\vector"
+ "\\verb"
+ "\\vfill"
+ "\\vline"
+ "\\vspace")
+ "A list of LaTeX commands to be protected when performing conversion.")
+
+(defconst org-latex-entities-regexp
+ (let (names rest)
+ (dolist (x org-latex-entities)
+ (if (string-match "[a-zA-Z]$" x)
+ (push x names)
+ (push x rest)))
+ (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)"
+ "\\|\\(" (regexp-opt (nreverse rest)) "\\)")))
+
+(provide 'org-export-latex)
+(provide 'org-latex)
+
+;;; org-latex.el ends here
diff --git a/lisp/org-list.el b/lisp/org-list.el
new file mode 100644
index 0000000..10f5e6e
--- /dev/null
+++ b/lisp/org-list.el
@@ -0,0 +1,3295 @@
+;;; org-list.el --- Plain lists for Org-mode
+;;
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Bastien Guerry <bzg AT gnu DOT org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code dealing with plain lists in Org-mode.
+
+;; The core concept behind lists is their structure. A structure is
+;; a snapshot of the list, in the shape of a data tree (see
+;; `org-list-struct').
+
+;; Once the list structure is stored, it is possible to make changes
+;; on it that will be mirrored to the real list or to get information
+;; about the list, using accessors and methods provided in the
+;; library. Most of them require the use of one or two helper
+;; functions, namely `org-list-parents-alist' and
+;; `org-list-prevs-alist'.
+
+;; Structure is eventually applied to the buffer with
+;; `org-list-write-struct'. This function repairs (bullets,
+;; indentation, checkboxes) the list in the process. It should be
+;; called near the end of any function working on structures.
+
+;; Thus, a function applying to lists should usually follow this
+;; template:
+
+;; 1. Verify point is in a list and grab item beginning (with the same
+;; function `org-in-item-p'). If the function requires the cursor
+;; to be at item's bullet, `org-at-item-p' is more selective. It
+;; is also possible to move point to the closest item with
+;; `org-list-search-backward', or `org-list-search-forward',
+;; applied to the function `org-item-beginning-re'.
+
+;; 2. Get list structure with `org-list-struct'.
+
+;; 3. Compute one, or both, helper functions,
+;; (`org-list-parents-alist', `org-list-prevs-alist') depending on
+;; needed accessors.
+
+;; 4. Proceed with the modifications, using methods and accessors.
+
+;; 5. Verify and apply structure to buffer, using
+;; `org-list-write-struct'.
+
+;; 6. If changes made to the list might have modified check-boxes,
+;; call `org-update-checkbox-count-maybe'.
+
+;; Computing a structure can be a costly operation on huge lists (a
+;; few thousand lines long). Thus, code should follow the rule:
+;; "collect once, use many". As a corollary, it is usually a bad idea
+;; to use directly an interactive function inside the code, as those,
+;; being independent entities, read the whole list structure another
+;; time.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org-macs)
+(require 'org-compat)
+
+(defvar org-M-RET-may-split-line)
+(defvar org-auto-align-tags)
+(defvar org-blank-before-new-entry)
+(defvar org-clock-string)
+(defvar org-closed-string)
+(defvar org-deadline-string)
+(defvar org-description-max-indent)
+(defvar org-drawers)
+(defvar org-odd-levels-only)
+(defvar org-scheduled-string)
+(defvar org-ts-regexp)
+(defvar org-ts-regexp-both)
+
+(declare-function org-at-heading-p "org" (&optional ignored))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-combine-plists "org" (&rest plists))
+(declare-function org-count "org" (cl-item cl-seq))
+(declare-function org-current-level "org" ())
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+(declare-function org-fix-tags-on-the-fly "org" ())
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-in-block-p "org" (names))
+(declare-function org-in-regexp "org" (re &optional nlines visually))
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+(declare-function org-level-increment "org" ())
+(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-at-heading-p "org" (&optional invisible-ok))
+(declare-function org-previous-line-empty-p "org" ())
+(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-reduced-level "org" (L))
+(declare-function org-show-subtree "org" ())
+(declare-function org-time-string-to-seconds "org" (s))
+(declare-function org-timer-hms-to-secs "org-timer" (hms))
+(declare-function org-timer-item "org-timer" (&optional arg))
+(declare-function org-trim "org" (s))
+(declare-function org-uniquify "org" (list))
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-flag-region "outline" (from to flag))
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-previous-heading "outline" ())
+
+
+
+;;; Configuration variables
+
+(defgroup org-plain-lists nil
+ "Options concerning plain lists in Org-mode."
+ :tag "Org Plain lists"
+ :group 'org-structure)
+
+(defcustom org-cycle-include-plain-lists t
+ "When t, make TAB cycle visibility on plain list items.
+Cycling plain lists works only when the cursor is on a plain list
+item. When the cursor is on an outline heading, plain lists are
+treated as text. This is the most stable way of handling this,
+which is why it is the default.
+
+When this is the symbol `integrate', then during cycling, plain
+list items will *temporarily* be interpreted as outline headlines
+with a level given by 1000+i where i is the indentation of the
+bullet. This setting can lead to strange effects when switching
+visibility to `children', because the first \"child\" in a
+subtree decides what children should be listed. If that first
+\"child\" is a plain list item with an implied large level
+number, all true children and grand children of the outline
+heading will be exposed in a children' view."
+ :group 'org-plain-lists
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "With cursor in plain list (recommended)" t)
+ (const :tag "As children of outline headings" integrate)))
+
+(defcustom org-list-demote-modify-bullet nil
+ "Default bullet type installed when demoting an item.
+This is an association list, for each bullet type, this alist will point
+to the bullet that should be used when this item is demoted.
+For example,
+
+ (setq org-list-demote-modify-bullet
+ '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
+
+will make
+
+ + Movies
+ + Silence of the Lambs
+ + My Cousin Vinny
+ + Books
+ + The Hunt for Red October
+ + The Road to Omaha
+
+into
+
+ + Movies
+ - Silence of the Lambs
+ - My Cousin Vinny
+ + Books
+ - The Hunt for Red October
+ - The Road to Omaha"
+ :group 'org-plain-lists
+ :type '(repeat
+ (cons
+ (choice :tag "If the current bullet is "
+ (const "-")
+ (const "+")
+ (const "*")
+ (const "1.")
+ (const "1)"))
+ (choice :tag "demotion will change it to"
+ (const "-")
+ (const "+")
+ (const "*")
+ (const "1.")
+ (const "1)")))))
+
+(defcustom org-plain-list-ordered-item-terminator t
+ "The character that makes a line with leading number an ordered list item.
+Valid values are ?. and ?\). To get both terminators, use t."
+ :group 'org-plain-lists
+ :type '(choice (const :tag "dot like in \"2.\"" ?.)
+ (const :tag "paren like in \"2)\"" ?\))
+ (const :tag "both" t)))
+
+(defcustom org-alphabetical-lists nil
+ "Non-nil means single character alphabetical bullets are allowed.
+Both uppercase and lowercase are handled. Lists with more than
+26 items will fallback to standard numbering. Alphabetical
+counters like \"[@c]\" will be recognized."
+ :group 'org-plain-lists
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-list-two-spaces-after-bullet-regexp nil
+ "A regular expression matching bullets that should have 2 spaces after them.
+When nil, no bullet will have two spaces after them. When
+a string, it will be used as a regular expression. When the
+bullet type of a list is changed, the new bullet type will be
+matched against this regexp. If it matches, there will be two
+spaces instead of one after the bullet in each item of the list."
+ :group 'org-plain-lists
+ :type '(choice
+ (const :tag "never" nil)
+ (regexp)))
+
+(defcustom org-empty-line-terminates-plain-lists nil
+ "Non-nil means an empty line ends all plain list levels.
+Otherwise, two of them will be necessary."
+ :group 'org-plain-lists
+ :type 'boolean)
+
+(defcustom org-list-automatic-rules '((checkbox . t)
+ (indent . t))
+ "Non-nil means apply set of rules when acting on lists.
+By default, automatic actions are taken when using
+ \\[org-meta-return], \\[org-metaright], \\[org-metaleft],
+ \\[org-shiftmetaright], \\[org-shiftmetaleft],
+ \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
+ \\[org-insert-todo-heading]. You can disable individually these
+ rules by setting them to nil. Valid rules are:
+
+checkbox when non-nil, checkbox statistics is updated each time
+ you either insert a new checkbox or toggle a checkbox.
+indent when non-nil, indenting or outdenting list top-item
+ with its subtree will move the whole list and
+ outdenting a list whose bullet is * to column 0 will
+ change that bullet to \"-\"."
+ :group 'org-plain-lists
+ :version "24.1"
+ :type '(alist :tag "Sets of rules"
+ :key-type
+ (choice
+ (const :tag "Checkbox" checkbox)
+ (const :tag "Indent" indent))
+ :value-type
+ (boolean :tag "Activate" :value t)))
+
+(defcustom org-list-use-circular-motion nil
+ "Non-nil means commands implying motion in lists should be cyclic.
+
+In that case, the item following the last item is the first one,
+and the item preceding the first item is the last one.
+
+This affects the behavior of \\[org-move-item-up],
+ \\[org-move-item-down], \\[org-next-item] and
+ \\[org-previous-item]."
+ :group 'org-plain-lists
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-checkbox-statistics-hook nil
+ "Hook that is run whenever Org thinks checkbox statistics should be updated.
+This hook runs even if checkbox rule in
+`org-list-automatic-rules' does not apply, so it can be used to
+implement alternative ways of collecting statistics
+information.")
+
+(defcustom org-hierarchical-checkbox-statistics t
+ "Non-nil means checkbox statistics counts only the state of direct children.
+When nil, all boxes below the cookie are counted.
+This can be set to nil on a per-node basis using a COOKIE_DATA property
+with the word \"recursive\" in the value."
+ :group 'org-plain-lists
+ :type 'boolean)
+
+(defcustom org-description-max-indent 20
+ "Maximum indentation for the second line of a description list.
+When the indentation would be larger than this, it will become
+5 characters instead."
+ :group 'org-plain-lists
+ :type 'integer)
+
+(defcustom org-list-indent-offset 0
+ "Additional indentation for sub-items in a list.
+By setting this to a small number, usually 1 or 2, one can more
+clearly distinguish sub-items in a list."
+ :group 'org-plain-lists
+ :version "24.1"
+ :type 'integer)
+
+(defcustom org-list-radio-list-templates
+ '((latex-mode "% BEGIN RECEIVE ORGLST %n
+% END RECEIVE ORGLST %n
+\\begin{comment}
+#+ORGLST: SEND %n org-list-to-latex
+-
+\\end{comment}\n")
+ (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
+@c END RECEIVE ORGLST %n
+@ignore
+#+ORGLST: SEND %n org-list-to-texinfo
+-
+@end ignore\n")
+ (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
+<!-- END RECEIVE ORGLST %n -->
+<!--
+#+ORGLST: SEND %n org-list-to-html
+-
+-->\n"))
+ "Templates for radio lists in different major modes.
+All occurrences of %n in a template will be replaced with the name of the
+list, obtained by prompting the user."
+ :group 'org-plain-lists
+ :type '(repeat
+ (list (symbol :tag "Major mode")
+ (string :tag "Format"))))
+
+(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
+ "docbook" "html" "latex" "odt")
+ "Names of blocks where lists are not allowed.
+Names must be in lower case.")
+
+(defvar org-list-export-context '(block inlinetask)
+ "Context types where lists will be interpreted during export.
+
+Valid types are `drawer', `inlinetask' and `block'. More
+specifically, type `block' is determined by the variable
+`org-list-forbidden-blocks'.")
+
+
+
+;;; Predicates and regexps
+
+(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n"
+ "^[ \t]*\n[ \t]*\n")
+ "Regex corresponding to the end of a list.
+It depends on `org-empty-line-terminates-plain-lists'.")
+
+(defconst org-list-full-item-re
+ (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?"
+ "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?")
+ "Matches a list item and puts everything into groups:
+group 1: bullet
+group 2: counter
+group 3: checkbox
+group 4: description tag")
+
+(defun org-item-re ()
+ "Return the correct regular expression for plain lists."
+ (let ((term (cond
+ ((eq org-plain-list-ordered-item-terminator t) "[.)]")
+ ((= org-plain-list-ordered-item-terminator ?\)) ")")
+ ((= org-plain-list-ordered-item-terminator ?.) "\\.")
+ (t "[.)]")))
+ (alpha (if org-alphabetical-lists "\\|[A-Za-z]" "")))
+ (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
+ "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
+
+(defsubst org-item-beginning-re ()
+ "Regexp matching the beginning of a plain list item."
+ (concat "^" (org-item-re)))
+
+(defun org-list-at-regexp-after-bullet-p (regexp)
+ "Is point at a list item with REGEXP after bullet?"
+ (and (org-at-item-p)
+ (save-excursion
+ (goto-char (match-end 0))
+ (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?"
+ (if org-alphabetical-lists
+ "\\([0-9]+\\|[A-Za-z]\\)"
+ "[0-9]+")
+ "\\][ \t]*\\)")))
+ ;; Ignore counter if any
+ (when (looking-at counter-re) (goto-char (match-end 0))))
+ (looking-at regexp))))
+
+(defun org-list-in-valid-context-p ()
+ "Is point in a context where lists are allowed?"
+ (not (org-in-block-p org-list-forbidden-blocks)))
+
+(defun org-in-item-p ()
+ "Return item beginning position when in a plain list, nil otherwise."
+ (save-excursion
+ (beginning-of-line)
+ (let* ((case-fold-search t)
+ (context (org-list-context))
+ (lim-up (car context))
+ (drawers-re (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask)
+ (org-inlinetask-outline-regexp)))
+ (item-re (org-item-re))
+ ;; Indentation isn't meaningful when point starts at an empty
+ ;; line or an inline task.
+ (ind-ref (if (or (looking-at "^[ \t]*$")
+ (and inlinetask-re (looking-at inlinetask-re)))
+ 10000
+ (org-get-indentation))))
+ (cond
+ ((eq (nth 2 context) 'invalid) nil)
+ ((looking-at item-re) (point))
+ (t
+ ;; Detect if cursor in amidst `org-list-end-re'. First, count
+ ;; number HL of hard lines it takes, then call `org-in-regexp'
+ ;; to compute its boundaries END-BOUNDS. When point is
+ ;; in-between, move cursor before regexp beginning.
+ (let ((hl 0) (i -1) end-bounds)
+ (when (and (progn
+ (while (setq i (string-match
+ "[\r\n]" org-list-end-re (1+ i)))
+ (setq hl (1+ hl)))
+ (setq end-bounds (org-in-regexp org-list-end-re hl)))
+ (>= (point) (car end-bounds))
+ (< (point) (cdr end-bounds)))
+ (goto-char (car end-bounds))
+ (forward-line -1)))
+ ;; Look for an item, less indented that reference line.
+ (catch 'exit
+ (while t
+ (let ((ind (org-get-indentation)))
+ (cond
+ ;; This is exactly what we want.
+ ((and (looking-at item-re) (< ind ind-ref))
+ (throw 'exit (point)))
+ ;; At upper bound of search or looking at the end of a
+ ;; previous list: search is over.
+ ((<= (point) lim-up) (throw 'exit nil))
+ ((looking-at org-list-end-re) (throw 'exit nil))
+ ;; Skip blocks, drawers, inline-tasks, blank lines
+ ((and (looking-at "^[ \t]*#\\+end_")
+ (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
+ ((and (looking-at "^[ \t]*:END:")
+ (re-search-backward drawers-re lim-up t))
+ (beginning-of-line))
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (org-inlinetask-goto-beginning)
+ (forward-line -1))
+ ((looking-at "^[ \t]*$") (forward-line -1))
+ ;; Text at column 0 cannot belong to a list: stop.
+ ((zerop ind) (throw 'exit nil))
+ ;; Normal text less indented than reference line, take
+ ;; it as new reference.
+ ((< ind ind-ref)
+ (setq ind-ref ind)
+ (forward-line -1))
+ (t (forward-line -1)))))))))))
+
+(defun org-at-item-p ()
+ "Is point in a line starting a hand-formatted item?"
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at (org-item-re)) (org-list-in-valid-context-p))))
+
+(defun org-at-item-bullet-p ()
+ "Is point at the bullet of a plain list item?"
+ (and (org-at-item-p)
+ (not (member (char-after) '(?\ ?\t)))
+ (< (point) (match-end 0))))
+
+(defun org-at-item-timer-p ()
+ "Is point at a line starting a plain list item with a timer?"
+ (org-list-at-regexp-after-bullet-p
+ "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
+
+(defun org-at-item-description-p ()
+ "Is point at a description list item?"
+ (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)"))
+
+(defun org-at-item-checkbox-p ()
+ "Is point at a line starting a plain-list item with a checklet?"
+ (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
+
+(defun org-at-item-counter-p ()
+ "Is point at a line starting a plain-list item with a counter?"
+ (and (org-at-item-p)
+ (looking-at org-list-full-item-re)
+ (match-string 2)))
+
+
+
+;;; Structures and helper functions
+
+(defun org-list-context ()
+ "Determine context, and its boundaries, around point.
+
+Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX
+are boundaries and CONTEXT is a symbol among `drawer', `block',
+`invalid', `inlinetask' and nil.
+
+Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
+ (save-match-data
+ (save-excursion
+ (org-with-limited-levels
+ (beginning-of-line)
+ (let ((case-fold-search t) (pos (point)) beg end context-type
+ ;; Get positions of surrounding headings. This is the
+ ;; default context.
+ (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t))
+ (point)))
+ (point-min)))
+ (lim-down (or (save-excursion (outline-next-heading)) (point-max))))
+ ;; Is point inside a drawer?
+ (let ((end-re "^[ \t]*:END:")
+ ;; Can't use org-drawers-regexp as this function might
+ ;; be called in buffers not in Org mode.
+ (beg-re (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$")))
+ (when (save-excursion
+ (and (not (looking-at beg-re))
+ (not (looking-at end-re))
+ (setq beg (and (re-search-backward beg-re lim-up t)
+ (1+ (point-at-eol))))
+ (setq end (or (and (re-search-forward end-re lim-down t)
+ (1- (match-beginning 0)))
+ lim-down))
+ (>= end pos)))
+ (setq lim-up beg lim-down end context-type 'drawer)))
+ ;; Is point strictly in a block, and of which type?
+ (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type)
+ (when (save-excursion
+ (and (not (looking-at block-re))
+ (setq beg (and (re-search-backward block-re lim-up t)
+ (1+ (point-at-eol))))
+ (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)")
+ (setq type (downcase (match-string 1)))
+ (goto-char beg)
+ (setq end (or (and (re-search-forward block-re lim-down t)
+ (1- (point-at-bol)))
+ lim-down))
+ (>= end pos)
+ (equal (downcase (match-string 1)) "end")))
+ (setq lim-up beg lim-down end
+ context-type (if (member type org-list-forbidden-blocks)
+ 'invalid 'block))))
+ ;; Is point in an inlinetask?
+ (when (and (featurep 'org-inlinetask)
+ (save-excursion
+ (let* ((beg-re (org-inlinetask-outline-regexp))
+ (end-re (concat beg-re "END[ \t]*$")))
+ (and (not (looking-at "^\\*+"))
+ (setq beg (and (re-search-backward beg-re lim-up t)
+ (1+ (point-at-eol))))
+ (not (looking-at end-re))
+ (setq end (and (re-search-forward end-re lim-down t)
+ (1- (match-beginning 0))))
+ (> (point) pos)))))
+ (setq lim-up beg lim-down end context-type 'inlinetask))
+ ;; Return context boundaries and type.
+ (list lim-up lim-down context-type))))))
+
+(defun org-list-struct ()
+ "Return structure of list at point.
+
+A list structure is an alist where key is point at item, and
+values are:
+1. indentation,
+2. bullet with trailing whitespace,
+3. bullet counter, if any,
+4. checkbox, if any,
+5. description tag, if any,
+6. position at item end.
+
+Thus the following list, where numbers in parens are
+point-at-bol:
+
+- [X] first item (1)
+ 1. sub-item 1 (18)
+ 5. [@5] sub-item 2 (34)
+ some other text belonging to first item (55)
+- last item (97)
+ + tag :: description (109)
+ (131)
+
+will get the following structure:
+
+\(\(1 0 \"- \" nil \"[X]\" nil 97\)
+ \(18 2 \"1. \" nil nil nil 34\)
+ \(34 2 \"5. \" \"5\" nil nil 55\)
+ \(97 0 \"- \" nil nil nil 131\)
+ \(109 2 \"+ \" nil nil \"tag\" 131\)
+
+Assume point is at an item."
+ (save-excursion
+ (beginning-of-line)
+ (let* ((case-fold-search t)
+ (context (org-list-context))
+ (lim-up (car context))
+ (lim-down (nth 1 context))
+ (text-min-ind 10000)
+ (item-re (org-item-re))
+ (drawers-re (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask)
+ (org-inlinetask-outline-regexp)))
+ (beg-cell (cons (point) (org-get-indentation)))
+ ind itm-lst itm-lst-2 end-lst end-lst-2 struct
+ (assoc-at-point
+ (function
+ ;; Return association at point.
+ (lambda (ind)
+ (looking-at org-list-full-item-re)
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data (string-match "[-+*]" bullet))
+ (match-string-no-properties 4)))))))
+ (end-before-blank
+ (function
+ ;; Ensure list ends at the first blank line.
+ (lambda ()
+ (skip-chars-backward " \r\t\n")
+ (min (1+ (point-at-eol)) lim-down)))))
+ ;; 1. Read list from starting item to its beginning, and save
+ ;; top item position and indentation in BEG-CELL. Also store
+ ;; ending position of items in END-LST.
+ (save-excursion
+ (catch 'exit
+ (while t
+ (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
+ (org-get-indentation))))
+ (cond
+ ((<= (point) lim-up)
+ ;; At upward limit: if we ended at an item, store it,
+ ;; else dismiss useless data recorded above BEG-CELL.
+ ;; Jump to part 2.
+ (throw 'exit
+ (setq itm-lst
+ (if (or (not (looking-at item-re))
+ (get-text-property (point) 'org-example))
+ (memq (assq (car beg-cell) itm-lst) itm-lst)
+ (setq beg-cell (cons (point) ind))
+ (cons (funcall assoc-at-point ind) itm-lst)))))
+ ;; At a verbatim block, go before its beginning. Move
+ ;; from eol to ensure `previous-single-property-change'
+ ;; will return a value.
+ ((get-text-property (point) 'org-example)
+ (goto-char (previous-single-property-change
+ (point-at-eol) 'org-example nil lim-up))
+ (forward-line -1))
+ ;; Looking at a list ending regexp. Dismiss useless
+ ;; data recorded above BEG-CELL. Jump to part 2.
+ ((looking-at org-list-end-re)
+ (throw 'exit
+ (setq itm-lst
+ (memq (assq (car beg-cell) itm-lst) itm-lst))))
+ ;; Point is at an item. Add data to ITM-LST. It may
+ ;; also end a previous item: save it in END-LST. If
+ ;; ind is less or equal than BEG-CELL and there is no
+ ;; end at this ind or lesser, this item becomes the new
+ ;; BEG-CELL.
+ ((looking-at item-re)
+ (push (funcall assoc-at-point ind) itm-lst)
+ (push (cons ind (point)) end-lst)
+ (when (< ind text-min-ind) (setq beg-cell (cons (point) ind)))
+ (forward-line -1))
+ ;; Skip blocks, drawers, inline tasks, blank lines.
+ ((and (looking-at "^[ \t]*#\\+end_")
+ (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
+ ((and (looking-at "^[ \t]*:END:")
+ (re-search-backward drawers-re lim-up t))
+ (beginning-of-line))
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (org-inlinetask-goto-beginning)
+ (forward-line -1))
+ ((looking-at "^[ \t]*$")
+ (forward-line -1))
+ ;; From there, point is not at an item. Interpret
+ ;; line's indentation:
+ ;; - text at column 0 is necessarily out of any list.
+ ;; Dismiss data recorded above BEG-CELL. Jump to
+ ;; part 2.
+ ;; - any other case may be an ending position for an
+ ;; hypothetical item above. Store it and proceed.
+ ((zerop ind)
+ (throw 'exit
+ (setq itm-lst
+ (memq (assq (car beg-cell) itm-lst) itm-lst))))
+ (t
+ (when (< ind text-min-ind) (setq text-min-ind ind))
+ (push (cons ind (point)) end-lst)
+ (forward-line -1)))))))
+ ;; 2. Read list from starting point to its end, that is until we
+ ;; get out of context, or that a non-item line is less or
+ ;; equally indented than BEG-CELL's cdr. Also, store ending
+ ;; position of items in END-LST-2.
+ (catch 'exit
+ (while t
+ (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
+ (org-get-indentation))))
+ (cond
+ ((>= (point) lim-down)
+ ;; At downward limit: this is de facto the end of the
+ ;; list. Save point as an ending position, and jump to
+ ;; part 3.
+ (throw 'exit
+ (push (cons 0 (funcall end-before-blank)) end-lst-2)))
+ ;; At a verbatim block, move to its end. Point is at bol
+ ;; and 'org-example property is set by whole lines:
+ ;; `next-single-property-change' always return a value.
+ ((get-text-property (point) 'org-example)
+ (goto-char
+ (next-single-property-change (point) 'org-example nil lim-down)))
+ ;; Looking at a list ending regexp. Save point as an
+ ;; ending position and jump to part 3.
+ ((looking-at org-list-end-re)
+ (throw 'exit (push (cons 0 (point)) end-lst-2)))
+ ((looking-at item-re)
+ ;; Point is at an item. Add data to ITM-LST-2. It may
+ ;; also end a previous item, so save it in END-LST-2.
+ (push (funcall assoc-at-point ind) itm-lst-2)
+ (push (cons ind (point)) end-lst-2)
+ (forward-line 1))
+ ;; Skip inline tasks and blank lines along the way
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (org-inlinetask-goto-end))
+ ((looking-at "^[ \t]*$")
+ (forward-line 1))
+ ;; Ind is lesser or equal than BEG-CELL's. The list is
+ ;; over: store point as an ending position and jump to
+ ;; part 3.
+ ((<= ind (cdr beg-cell))
+ (throw 'exit
+ (push (cons 0 (funcall end-before-blank)) end-lst-2)))
+ ;; Else, if ind is lesser or equal than previous item's,
+ ;; this is an ending position: store it. In any case,
+ ;; skip block or drawer at point, and move to next line.
+ (t
+ (when (<= ind (nth 1 (car itm-lst-2)))
+ (push (cons ind (point)) end-lst-2))
+ (cond
+ ((and (looking-at "^[ \t]*#\\+begin_")
+ (re-search-forward "^[ \t]*#\\+end_" lim-down t)))
+ ((and (looking-at drawers-re)
+ (re-search-forward "^[ \t]*:END:" lim-down t))))
+ (forward-line 1))))))
+ (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
+ end-lst (append end-lst (cdr (nreverse end-lst-2))))
+ ;; 3. Associate each item to its end position.
+ (org-list-struct-assoc-end struct end-lst)
+ ;; 4. Return STRUCT
+ struct)))
+
+(defun org-list-struct-assoc-end (struct end-list)
+ "Associate proper ending point to items in STRUCT.
+
+END-LIST is a pseudo-alist where car is indentation and cdr is
+ending position.
+
+This function modifies STRUCT."
+ (let ((endings end-list))
+ (mapc
+ (lambda (elt)
+ (let ((pos (car elt))
+ (ind (nth 1 elt)))
+ ;; Remove end candidates behind current item.
+ (while (or (<= (cdar endings) pos))
+ (pop endings))
+ ;; Add end position to item assoc.
+ (let ((old-end (nthcdr 6 elt))
+ (new-end (assoc-default ind endings '<=)))
+ (if old-end
+ (setcar old-end new-end)
+ (setcdr elt (append (cdr elt) (list new-end)))))))
+ struct)))
+
+(defun org-list-prevs-alist (struct)
+ "Return alist between item and previous item in STRUCT."
+ (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e)))
+ struct)))
+ (mapcar (lambda (e)
+ (let ((prev (car (rassq (car e) item-end-alist))))
+ (cons (car e) prev)))
+ struct)))
+
+(defun org-list-parents-alist (struct)
+ "Return alist between item and parent in STRUCT."
+ (let* ((ind-to-ori (list (list (nth 1 (car struct)))))
+ (top-item (org-list-get-top-point struct))
+ (prev-pos (list top-item)))
+ (cons prev-pos
+ (mapcar (lambda (item)
+ (let ((pos (car item))
+ (ind (nth 1 item))
+ (prev-ind (caar ind-to-ori)))
+ (push pos prev-pos)
+ (cond
+ ((> prev-ind ind)
+ ;; A sub-list is over. Find the associated
+ ;; origin in IND-TO-ORI. If it cannot be
+ ;; found (ill-formed list), set its parent as
+ ;; the first item less indented. If there is
+ ;; none, make it a top-level item.
+ (setq ind-to-ori
+ (or (member (assq ind ind-to-ori) ind-to-ori)
+ (catch 'exit
+ (mapc
+ (lambda (e)
+ (when (< (car e) ind)
+ (throw 'exit (member e ind-to-ori))))
+ ind-to-ori)
+ (list (list ind)))))
+ (cons pos (cdar ind-to-ori)))
+ ;; A sub-list starts. Every item at IND will
+ ;; have previous item as its parent.
+ ((< prev-ind ind)
+ (let ((origin (nth 1 prev-pos)))
+ (push (cons ind origin) ind-to-ori)
+ (cons pos origin)))
+ ;; Another item in the same sub-list: it shares
+ ;; the same parent as the previous item.
+ (t (cons pos (cdar ind-to-ori))))))
+ (cdr struct)))))
+
+
+
+;;; Accessors
+
+(defsubst org-list-get-nth (n key struct)
+ "Return the Nth value of KEY in STRUCT."
+ (nth n (assq key struct)))
+
+(defun org-list-set-nth (n key struct new)
+ "Set the Nth value of KEY in STRUCT to NEW.
+\nThis function modifies STRUCT."
+ (setcar (nthcdr n (assq key struct)) new))
+
+(defsubst org-list-get-ind (item struct)
+ "Return indentation of ITEM in STRUCT."
+ (org-list-get-nth 1 item struct))
+
+(defun org-list-set-ind (item struct ind)
+ "Set indentation of ITEM in STRUCT to IND.
+\nThis function modifies STRUCT."
+ (org-list-set-nth 1 item struct ind))
+
+(defsubst org-list-get-bullet (item struct)
+ "Return bullet of ITEM in STRUCT."
+ (org-list-get-nth 2 item struct))
+
+(defun org-list-set-bullet (item struct bullet)
+ "Set bullet of ITEM in STRUCT to BULLET.
+\nThis function modifies STRUCT."
+ (org-list-set-nth 2 item struct bullet))
+
+(defsubst org-list-get-counter (item struct)
+ "Return counter of ITEM in STRUCT."
+ (org-list-get-nth 3 item struct))
+
+(defsubst org-list-get-checkbox (item struct)
+ "Return checkbox of ITEM in STRUCT or nil."
+ (org-list-get-nth 4 item struct))
+
+(defun org-list-set-checkbox (item struct checkbox)
+ "Set checkbox of ITEM in STRUCT to CHECKBOX.
+\nThis function modifies STRUCT."
+ (org-list-set-nth 4 item struct checkbox))
+
+(defsubst org-list-get-tag (item struct)
+ "Return end position of ITEM in STRUCT."
+ (org-list-get-nth 5 item struct))
+
+(defun org-list-get-item-end (item struct)
+ "Return end position of ITEM in STRUCT."
+ (org-list-get-nth 6 item struct))
+
+(defun org-list-get-item-end-before-blank (item struct)
+ "Return point at end of ITEM in STRUCT, before any blank line.
+Point returned is at end of line."
+ (save-excursion
+ (goto-char (org-list-get-item-end item struct))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+
+(defun org-list-get-parent (item struct parents)
+ "Return parent of ITEM or nil.
+STRUCT is the list structure. PARENTS is the alist of parents,
+as returned by `org-list-parents-alist'."
+ (let ((parents (or parents (org-list-parents-alist struct))))
+ (cdr (assq item parents))))
+
+(defun org-list-has-child-p (item struct)
+ "Non-nil if ITEM has a child.
+
+STRUCT is the list structure.
+
+Value returned is the position of the first child of ITEM."
+ (let ((ind (org-list-get-ind item struct))
+ (child-maybe (car (nth 1 (member (assq item struct) struct)))))
+ (when (and child-maybe
+ (< ind (org-list-get-ind child-maybe struct)))
+ child-maybe)))
+
+(defun org-list-get-next-item (item struct prevs)
+ "Return next item in same sub-list as ITEM, or nil.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (car (rassq item prevs)))
+
+(defun org-list-get-prev-item (item struct prevs)
+ "Return previous item in same sub-list as ITEM, or nil.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (cdr (assq item prevs)))
+
+(defun org-list-get-subtree (item struct)
+ "List all items having ITEM as a common ancestor, or nil.
+STRUCT is the list structure."
+ (let* ((item-end (org-list-get-item-end item struct))
+ (sub-struct (cdr (member (assq item struct) struct)))
+ subtree)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((pos (car e)))
+ (if (< pos item-end) (push pos subtree) (throw 'exit nil))))
+ sub-struct))
+ (nreverse subtree)))
+
+(defun org-list-get-all-items (item struct prevs)
+ "List all items in the same sub-list as ITEM.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (let ((prev-item item)
+ (next-item item)
+ before-item after-item)
+ (while (setq prev-item (org-list-get-prev-item prev-item struct prevs))
+ (push prev-item before-item))
+ (while (setq next-item (org-list-get-next-item next-item struct prevs))
+ (push next-item after-item))
+ (append before-item (list item) (nreverse after-item))))
+
+(defun org-list-get-children (item struct parents)
+ "List all children of ITEM, or nil.
+STRUCT is the list structure. PARENTS is the alist of parents,
+as returned by `org-list-parents-alist'."
+ (let (all child)
+ (while (setq child (car (rassq item parents)))
+ (setq parents (cdr (member (assq child parents) parents)))
+ (push child all))
+ (nreverse all)))
+
+(defun org-list-get-top-point (struct)
+ "Return point at beginning of list.
+STRUCT is the list structure."
+ (caar struct))
+
+(defun org-list-get-bottom-point (struct)
+ "Return point at bottom of list.
+STRUCT is the list structure."
+ (apply 'max
+ (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct)))
+
+(defun org-list-get-list-begin (item struct prevs)
+ "Return point at beginning of sub-list ITEM belongs.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (let ((first-item item) prev-item)
+ (while (setq prev-item (org-list-get-prev-item first-item struct prevs))
+ (setq first-item prev-item))
+ first-item))
+
+(defalias 'org-list-get-first-item 'org-list-get-list-begin)
+
+(defun org-list-get-last-item (item struct prevs)
+ "Return point at last item of sub-list ITEM belongs.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (let ((last-item item) next-item)
+ (while (setq next-item (org-list-get-next-item last-item struct prevs))
+ (setq last-item next-item))
+ last-item))
+
+(defun org-list-get-list-end (item struct prevs)
+ "Return point at end of sub-list ITEM belongs.
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'."
+ (org-list-get-item-end (org-list-get-last-item item struct prevs) struct))
+
+(defun org-list-get-list-type (item struct prevs)
+ "Return the type of the list containing ITEM, as a symbol.
+
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'.
+
+Possible types are `descriptive', `ordered' and `unordered'. The
+type is determined by the first item of the list."
+ (let ((first (org-list-get-list-begin item struct prevs)))
+ (cond
+ ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
+ ((org-list-get-tag first struct) 'descriptive)
+ (t 'unordered))))
+
+(defun org-list-get-item-number (item struct prevs parents)
+ "Return ITEM's sequence number.
+
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'. PARENTS is the
+alist of ancestors, as returned by `org-list-parents-alist'.
+
+Return value is a list of integers. Counters have an impact on
+that value."
+ (let ((get-relative-number
+ (function
+ (lambda (item struct prevs)
+ ;; Return relative sequence number of ITEM in the sub-list
+ ;; it belongs. STRUCT is the list structure. PREVS is
+ ;; the alist of previous items.
+ (let ((seq 0) (pos item) counter)
+ (while (and (not (setq counter (org-list-get-counter pos struct)))
+ (setq pos (org-list-get-prev-item pos struct prevs)))
+ (incf seq))
+ (if (not counter) (1+ seq)
+ (cond
+ ((string-match "[A-Za-z]" counter)
+ (+ (- (string-to-char (upcase (match-string 0 counter))) 64)
+ seq))
+ ((string-match "[0-9]+" counter)
+ (+ (string-to-number (match-string 0 counter)) seq))
+ (t (1+ seq)))))))))
+ ;; Cons each parent relative number into return value (OUT).
+ (let ((out (list (funcall get-relative-number item struct prevs)))
+ (parent item))
+ (while (setq parent (org-list-get-parent parent struct parents))
+ (push (funcall get-relative-number parent struct prevs) out))
+ ;; Return value.
+ out)))
+
+
+
+;;; Searching
+
+(defun org-list-search-generic (search re bound noerr)
+ "Search a string in valid contexts for lists.
+Arguments SEARCH, RE, BOUND and NOERR are similar to those used
+in `re-search-forward'."
+ (catch 'exit
+ (let ((origin (point)))
+ (while t
+ ;; 1. No match: return to origin or bound, depending on NOERR.
+ (unless (funcall search re bound noerr)
+ (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound))
+ nil)))
+ ;; 2. Match in valid context: return point. Else, continue
+ ;; searching.
+ (when (org-list-in-valid-context-p) (throw 'exit (point)))))))
+
+(defun org-list-search-backward (regexp &optional bound noerror)
+ "Like `re-search-backward' but stop only where lists are recognized.
+Arguments REGEXP, BOUND and NOERROR are similar to those used in
+`re-search-backward'."
+ (org-list-search-generic #'re-search-backward
+ regexp (or bound (point-min)) noerror))
+
+(defun org-list-search-forward (regexp &optional bound noerror)
+ "Like `re-search-forward' but stop only where lists are recognized.
+Arguments REGEXP, BOUND and NOERROR are similar to those used in
+`re-search-forward'."
+ (org-list-search-generic #'re-search-forward
+ regexp (or bound (point-max)) noerror))
+
+
+
+;;; Methods on structures
+
+(defsubst org-list-bullet-string (bullet)
+ "Return BULLET with the correct number of whitespaces.
+It determines the number of whitespaces to append by looking at
+`org-list-two-spaces-after-bullet-regexp'."
+ (save-match-data
+ (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp
+ (string-match
+ org-list-two-spaces-after-bullet-regexp bullet))
+ " "
+ " ")))
+ (string-match "\\S-+\\([ \t]*\\)" bullet)
+ (replace-match spaces nil nil bullet 1))))
+
+(defun org-list-swap-items (beg-A beg-B struct)
+ "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
+
+Blank lines at the end of items are left in place. Item
+visibility is preserved. Return the new structure after the
+changes.
+
+Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
+to the same sub-list.
+
+This function modifies STRUCT."
+ (save-excursion
+ (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
+ (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
+ (end-A (org-list-get-item-end beg-A struct))
+ (end-B (org-list-get-item-end beg-B struct))
+ (size-A (- end-A-no-blank beg-A))
+ (size-B (- end-B-no-blank beg-B))
+ (body-A (buffer-substring beg-A end-A-no-blank))
+ (body-B (buffer-substring beg-B end-B-no-blank))
+ (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
+ (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
+ (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
+ ;; Store overlays responsible for visibility status. We
+ ;; also need to store their boundaries as they will be
+ ;; removed from buffer.
+ (overlays (cons
+ (mapcar (lambda (ov)
+ (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-A end-A))
+ (mapcar (lambda (ov)
+ (list ov (overlay-start ov) (overlay-end ov)))
+ (overlays-in beg-B end-B)))))
+ ;; 1. Move effectively items in buffer.
+ (goto-char beg-A)
+ (delete-region beg-A end-B-no-blank)
+ (insert (concat body-B between-A-no-blank-and-B body-A))
+ ;; 2. Now modify struct. No need to re-read the list, the
+ ;; transformation is just a shift of positions. Some special
+ ;; attention is required for items ending at END-A and END-B
+ ;; as empty spaces are not moved there. In others words,
+ ;; item BEG-A will end with whitespaces that were at the end
+ ;; of BEG-B and the same applies to BEG-B.
+ (mapc (lambda (e)
+ (let ((pos (car e)))
+ (cond
+ ((< pos beg-A))
+ ((memq pos sub-A)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+ (setcar (nthcdr 6 e)
+ (+ end-e (- end-B-no-blank end-A-no-blank)))
+ (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+ ((memq pos sub-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (- (+ pos beg-A) beg-B))
+ (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+ (when (= end-e end-B)
+ (setcar (nthcdr 6 e)
+ (+ beg-A size-B (- end-A end-A-no-blank))))))
+ ((< pos beg-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- size-B size-A)))
+ (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+ struct)
+ (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ ;; Restore visibility status, by moving overlays to their new
+ ;; position.
+ (mapc (lambda (ov)
+ (move-overlay
+ (car ov)
+ (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
+ (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
+ (car overlays))
+ (mapc (lambda (ov)
+ (move-overlay (car ov)
+ (+ (nth 1 ov) (- beg-A beg-B))
+ (+ (nth 2 ov) (- beg-A beg-B))))
+ (cdr overlays))
+ ;; Return structure.
+ struct)))
+
+(defun org-list-separating-blank-lines-number (pos struct prevs)
+ "Return number of blank lines that should separate items in list.
+
+POS is the position of point where `org-list-insert-item' was called.
+
+STRUCT is the list structure. PREVS is the alist of previous
+items, as returned by `org-list-prevs-alist'.
+
+Assume point is at item's beginning. If the item is alone, apply
+some heuristics to guess the result."
+ (save-excursion
+ (let ((item (point))
+ (insert-blank-p
+ (cdr (assq 'plain-list-item org-blank-before-new-entry)))
+ usr-blank
+ (count-blanks
+ (function
+ (lambda ()
+ ;; Count blank lines above beginning of line.
+ (save-excursion
+ (count-lines (goto-char (point-at-bol))
+ (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))))))
+ (cond
+ ;; Trivial cases where there should be none.
+ ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ;; When `org-blank-before-new-entry' says so, it is 1.
+ ((eq insert-blank-p t) 1)
+ ;; `plain-list-item' is 'auto. Count blank lines separating
+ ;; neighbours items in list.
+ (t (let ((next-p (org-list-get-next-item item struct prevs)))
+ (cond
+ ;; Is there a next item?
+ (next-p (goto-char next-p)
+ (funcall count-blanks))
+ ;; Is there a previous item?
+ ((org-list-get-prev-item item struct prevs)
+ (funcall count-blanks))
+ ;; User inserted blank lines, trust him.
+ ((and (> pos (org-list-get-item-end-before-blank item struct))
+ (> (save-excursion (goto-char pos)
+ (setq usr-blank (funcall count-blanks)))
+ 0))
+ usr-blank)
+ ;; Are there blank lines inside the list so far?
+ ((save-excursion
+ (goto-char (org-list-get-top-point struct))
+ (org-list-search-forward
+ "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t))
+ 1)
+ ;; Default choice: no blank line.
+ (t 0))))))))
+
+(defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet)
+ "Insert a new list item at POS and return the new structure.
+If POS is before first character after bullet of the item, the
+new item will be created before the current one.
+
+STRUCT is the list structure. PREVS is the the alist of previous
+items, as returned by `org-list-prevs-alist'.
+
+Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
+after the bullet. Cursor will be after this text once the
+function ends.
+
+This function modifies STRUCT."
+ (let ((case-fold-search t))
+ ;; 1. Get information about list: position of point with regards
+ ;; to item start (BEFOREP), blank lines number separating items
+ ;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P).
+ (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin))))
+ (item-end (org-list-get-item-end item struct))
+ (item-end-no-blank (org-list-get-item-end-before-blank item struct))
+ (beforep
+ (progn
+ (looking-at org-list-full-item-re)
+ ;; Do not count tag in a non-descriptive list.
+ (<= pos (if (and (match-beginning 4)
+ (save-match-data
+ (string-match "[.)]" (match-string 1))))
+ (match-beginning 4)
+ (match-end 0)))))
+ (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
+ (blank-nb (org-list-separating-blank-lines-number
+ pos struct prevs))
+ ;; 2. Build the new item to be created. Concatenate same
+ ;; bullet as item, checkbox, text AFTER-BULLET if
+ ;; provided, and text cut from point to end of item
+ ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on
+ ;; BEFOREP and SPLIT-LINE-P. The difference of size
+ ;; between what was cut and what was inserted in buffer
+ ;; is stored in SIZE-OFFSET.
+ (ind (org-list-get-ind item struct))
+ (ind-size (if indent-tabs-mode
+ (+ (/ ind tab-width) (mod ind tab-width))
+ ind))
+ (bullet (org-list-bullet-string (org-list-get-bullet item struct)))
+ (box (when checkbox "[ ]"))
+ (text-cut
+ (and (not beforep) split-line-p
+ (progn
+ (goto-char pos)
+ ;; If POS is greater than ITEM-END, then point is
+ ;; in some white lines after the end of the list.
+ ;; Those must be removed, or they will be left,
+ ;; stacking up after the list.
+ (when (< item-end pos)
+ (delete-region (1- item-end) (point-at-eol)))
+ (skip-chars-backward " \r\t\n")
+ (setq pos (point))
+ (delete-and-extract-region pos item-end-no-blank))))
+ (body (concat bullet (when box (concat box " ")) after-bullet
+ (and text-cut
+ (if (string-match "\\`[ \t]+" text-cut)
+ (replace-match "" t t text-cut)
+ text-cut))))
+ (item-sep (make-string (1+ blank-nb) ?\n))
+ (item-size (+ ind-size (length body) (length item-sep)))
+ (size-offset (- item-size (length text-cut))))
+ ;; 4. Insert effectively item into buffer.
+ (goto-char item)
+ (org-indent-to-column ind)
+ (insert body item-sep)
+ ;; 5. Add new item to STRUCT.
+ (mapc (lambda (e)
+ (let ((p (car e)) (end (nth 6 e)))
+ (cond
+ ;; Before inserted item, positions don't change but
+ ;; an item ending after insertion has its end shifted
+ ;; by SIZE-OFFSET.
+ ((< p item)
+ (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset))))
+ ;; Trivial cases where current item isn't split in
+ ;; two. Just shift every item after new one by
+ ;; ITEM-SIZE.
+ ((or beforep (not split-line-p))
+ (setcar e (+ p item-size))
+ (setcar (nthcdr 6 e) (+ end item-size)))
+ ;; Item is split in two: elements before POS are just
+ ;; shifted by ITEM-SIZE. In the case item would end
+ ;; after split POS, ending is only shifted by
+ ;; SIZE-OFFSET.
+ ((< p pos)
+ (setcar e (+ p item-size))
+ (if (< end pos)
+ (setcar (nthcdr 6 e) (+ end item-size))
+ (setcar (nthcdr 6 e) (+ end size-offset))))
+ ;; Elements after POS are moved into new item.
+ ;; Length of ITEM-SEP has to be removed as ITEM-SEP
+ ;; doesn't appear in buffer yet.
+ ((< p item-end)
+ (setcar e (+ p size-offset (- item pos (length item-sep))))
+ (if (= end item-end)
+ (setcar (nthcdr 6 e) (+ item item-size))
+ (setcar (nthcdr 6 e)
+ (+ end size-offset
+ (- item pos (length item-sep))))))
+ ;; Elements at ITEM-END or after are only shifted by
+ ;; SIZE-OFFSET.
+ (t (setcar e (+ p size-offset))
+ (setcar (nthcdr 6 e) (+ end size-offset))))))
+ struct)
+ (push (list item ind bullet nil box nil (+ item item-size)) struct)
+ (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ ;; 6. If not BEFOREP, new item must appear after ITEM, so
+ ;; exchange ITEM with the next item in list. Position cursor
+ ;; after bullet, counter, checkbox, and label.
+ (if beforep
+ (goto-char item)
+ (setq struct (org-list-swap-items item (+ item item-size) struct))
+ (goto-char (org-list-get-next-item
+ item struct (org-list-prevs-alist struct))))
+ struct)))
+
+(defun org-list-delete-item (item struct)
+ "Remove ITEM from the list and return the new structure.
+
+STRUCT is the list structure."
+ (let* ((end (org-list-get-item-end item struct))
+ (beg (if (= (org-list-get-bottom-point struct) end)
+ ;; If ITEM ends with the list, delete blank lines
+ ;; before it.
+ (save-excursion
+ (goto-char item)
+ (skip-chars-backward " \r\t\n")
+ (min (1+ (point-at-eol)) (point-max)))
+ item)))
+ ;; Remove item from buffer.
+ (delete-region beg end)
+ ;; Remove item from structure and shift others items accordingly.
+ ;; Don't forget to shift also ending position when appropriate.
+ (let ((size (- end beg)))
+ (delq nil (mapcar (lambda (e)
+ (let ((pos (car e)))
+ (cond
+ ((< pos item)
+ (let ((end-e (nth 6 e)))
+ (cond
+ ((< end-e item) e)
+ ((= end-e item)
+ (append (butlast e) (list beg)))
+ (t
+ (append (butlast e) (list (- end-e size)))))))
+ ((< pos end) nil)
+ (t
+ (cons (- pos size)
+ (append (butlast (cdr e))
+ (list (- (nth 6 e) size))))))))
+ struct)))))
+
+(defun org-list-send-item (item dest struct)
+ "Send ITEM to destination DEST.
+
+STRUCT is the list structure.
+
+DEST can have various values.
+
+If DEST is a buffer position, the function will assume it points
+to another item in the same list as ITEM, and will move the
+latter just before the former.
+
+If DEST is `begin' (respectively `end'), ITEM will be moved at
+the beginning (respectively end) of the list it belongs to.
+
+If DEST is a string like \"N\", where N is an integer, ITEM will
+be moved at the Nth position in the list.
+
+If DEST is `kill', ITEM will be deleted and its body will be
+added to the kill-ring.
+
+If DEST is `delete', ITEM will be deleted.
+
+Visibility of item is preserved.
+
+This function returns, destructively, the new list structure."
+ (let* ((prevs (org-list-prevs-alist struct))
+ (item-end (org-list-get-item-end item struct))
+ ;; Grab full item body minus its bullet.
+ (body (org-trim
+ (buffer-substring
+ (save-excursion
+ (goto-char item)
+ (looking-at
+ (concat "[ \t]*"
+ (regexp-quote (org-list-get-bullet item struct))))
+ (match-end 0))
+ item-end)))
+ ;; Change DEST into a buffer position. A trick is needed
+ ;; when ITEM is meant to be sent at the end of the list.
+ ;; Indeed, by setting locally `org-M-RET-may-split-line' to
+ ;; nil and insertion point (INS-POINT) to the first line's
+ ;; end of the last item, we ensure the new item will be
+ ;; inserted after the last item, and not after any of its
+ ;; hypothetical sub-items.
+ (ins-point (cond
+ ((or (eq dest 'kill) (eq dest 'delete)))
+ ((eq dest 'begin)
+ (setq dest (org-list-get-list-begin item struct prevs)))
+ ((eq dest 'end)
+ (setq dest (org-list-get-list-end item struct prevs))
+ (save-excursion
+ (goto-char (org-list-get-last-item item struct prevs))
+ (point-at-eol)))
+ ((string-match "\\`[0-9]+\\'" dest)
+ (let* ((all (org-list-get-all-items item struct prevs))
+ (len (length all))
+ (index (mod (string-to-number dest) len)))
+ (if (not (zerop index))
+ (setq dest (nth (1- index) all))
+ ;; Send ITEM at the end of the list.
+ (setq dest (org-list-get-list-end item struct prevs))
+ (save-excursion
+ (goto-char
+ (org-list-get-last-item item struct prevs))
+ (point-at-eol)))))
+ (t dest)))
+ (org-M-RET-may-split-line nil)
+ ;; Store visibility.
+ (visibility (overlays-in item item-end)))
+ (cond
+ ((eq dest 'delete) (org-list-delete-item item struct))
+ ((eq dest 'kill)
+ (kill-new body)
+ (org-list-delete-item item struct))
+ ((and (integerp dest) (/= item ins-point))
+ (setq item (copy-marker item))
+ (setq struct (org-list-insert-item ins-point struct prevs nil body))
+ ;; 1. Structure returned by `org-list-insert-item' may not be
+ ;; accurate, as it cannot see sub-items included in BODY.
+ ;; Thus, first compute the real structure so far.
+ (let ((moved-items
+ (cons (marker-position item)
+ (org-list-get-subtree (marker-position item) struct)))
+ (new-end (org-list-get-item-end (point) struct))
+ (old-end (org-list-get-item-end (marker-position item) struct))
+ (new-item (point))
+ (shift (- (point) item)))
+ ;; 1.1. Remove the item just created in structure.
+ (setq struct (delete (assq new-item struct) struct))
+ ;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM.
+ (setq struct (sort
+ (append
+ struct
+ (mapcar (lambda (e)
+ (let* ((cell (assq e struct))
+ (pos (car cell))
+ (end (nth 6 cell)))
+ (cons (+ pos shift)
+ (append (butlast (cdr cell))
+ (list (if (= end old-end)
+ new-end
+ (+ end shift)))))))
+ moved-items))
+ (lambda (e1 e2) (< (car e1) (car e2))))))
+ ;; 2. Restore visibility.
+ (mapc (lambda (ov)
+ (move-overlay ov
+ (+ (overlay-start ov) (- (point) item))
+ (+ (overlay-end ov) (- (point) item))))
+ visibility)
+ ;; 3. Eventually delete extra copy of the item and clean marker.
+ (prog1 (org-list-delete-item (marker-position item) struct)
+ (move-marker item nil)))
+ (t struct))))
+
+(defun org-list-struct-outdent (start end struct parents)
+ "Outdent items between positions START and END.
+
+STRUCT is the list structure. PARENTS is the alist of items'
+parents, as returned by `org-list-parents-alist'.
+
+START is included, END excluded."
+ (let* (acc
+ (out (lambda (cell)
+ (let* ((item (car cell))
+ (parent (cdr cell)))
+ (cond
+ ;; Item not yet in zone: keep association.
+ ((< item start) cell)
+ ;; Item out of zone: follow associations in ACC.
+ ((>= item end)
+ (let ((convert (and parent (assq parent acc))))
+ (if convert (cons item (cdr convert)) cell)))
+ ;; Item has no parent: error
+ ((not parent)
+ (error "Cannot outdent top-level items"))
+ ;; Parent is outdented: keep association.
+ ((>= parent start)
+ (push (cons parent item) acc) cell)
+ (t
+ ;; Parent isn't outdented: reparent to grand-parent.
+ (let ((grand-parent (org-list-get-parent
+ parent struct parents)))
+ (push (cons parent item) acc)
+ (cons item grand-parent))))))))
+ (mapcar out parents)))
+
+(defun org-list-struct-indent (start end struct parents prevs)
+ "Indent items between positions START and END.
+
+STRUCT is the list structure. PARENTS is the alist of parents
+and PREVS is the alist of previous items, returned by,
+respectively, `org-list-parents-alist' and
+`org-list-prevs-alist'.
+
+START is included and END excluded.
+
+STRUCT may be modified if `org-list-demote-modify-bullet' matches
+bullets between START and END."
+ (let* (acc
+ (set-assoc (lambda (cell) (push cell acc) cell))
+ (change-bullet-maybe
+ (function
+ (lambda (item)
+ (let ((new-bul-p
+ (cdr (assoc
+ ;; Normalize ordered bullets.
+ (let ((bul (org-trim
+ (org-list-get-bullet item struct))))
+ (cond ((string-match "[A-Z]\\." bul) "A.")
+ ((string-match "[A-Z])" bul) "A)")
+ ((string-match "[a-z]\\." bul) "a.")
+ ((string-match "[a-z])" bul) "a)")
+ ((string-match "[0-9]\\." bul) "1.")
+ ((string-match "[0-9])" bul) "1)")
+ (t bul)))
+ org-list-demote-modify-bullet))))
+ (when new-bul-p (org-list-set-bullet item struct new-bul-p))))))
+ (ind
+ (lambda (cell)
+ (let* ((item (car cell))
+ (parent (cdr cell)))
+ (cond
+ ;; Item not yet in zone: keep association.
+ ((< item start) cell)
+ ((>= item end)
+ ;; Item out of zone: follow associations in ACC.
+ (let ((convert (assq parent acc)))
+ (if convert (cons item (cdr convert)) cell)))
+ (t
+ ;; Item is in zone...
+ (let ((prev (org-list-get-prev-item item struct prevs)))
+ ;; Check if bullet needs to be changed.
+ (funcall change-bullet-maybe item)
+ (cond
+ ;; First item indented but not parent: error
+ ((and (not prev) (< parent start))
+ (error "Cannot indent the first item of a list"))
+ ;; First item and parent indented: keep same
+ ;; parent.
+ ((not prev) (funcall set-assoc cell))
+ ;; Previous item not indented: reparent to it.
+ ((< prev start) (funcall set-assoc (cons item prev)))
+ ;; Previous item indented: reparent like it.
+ (t
+ (funcall set-assoc
+ (cons item (cdr (assq prev acc)))))))))))))
+ (mapcar ind parents)))
+
+
+
+;;; Repairing structures
+
+(defun org-list-use-alpha-bul-p (first struct prevs)
+ "Non-nil if list starting at FIRST can have alphabetical bullets.
+
+STRUCT is list structure. PREVS is the alist of previous items,
+as returned by `org-list-prevs-alist'."
+ (and org-alphabetical-lists
+ (catch 'exit
+ (let ((item first) (ascii 64) (case-fold-search nil))
+ ;; Pretend that bullets are uppercase and check if alphabet
+ ;; is sufficient, taking counters into account.
+ (while item
+ (let ((bul (org-list-get-bullet item struct))
+ (count (org-list-get-counter item struct)))
+ ;; Virtually determine current bullet
+ (if (and count (string-match "[a-zA-Z]" count))
+ ;; Counters are not case-sensitive.
+ (setq ascii (string-to-char (upcase count)))
+ (setq ascii (1+ ascii)))
+ ;; Test if bullet would be over z or Z.
+ (if (> ascii 90)
+ (throw 'exit nil)
+ (setq item (org-list-get-next-item item struct prevs)))))
+ ;; All items checked. All good.
+ t))))
+
+(defun org-list-inc-bullet-maybe (bullet)
+ "Increment BULLET if applicable."
+ (let ((case-fold-search nil))
+ (cond
+ ;; Num bullet: increment it.
+ ((string-match "[0-9]+" bullet)
+ (replace-match
+ (number-to-string (1+ (string-to-number (match-string 0 bullet))))
+ nil nil bullet))
+ ;; Alpha bullet: increment it.
+ ((string-match "[A-Za-z]" bullet)
+ (replace-match
+ (char-to-string (1+ (string-to-char (match-string 0 bullet))))
+ nil nil bullet))
+ ;; Unordered bullet: leave it.
+ (t bullet))))
+
+(defun org-list-struct-fix-bul (struct prevs)
+ "Verify and correct bullets in STRUCT.
+PREVS is the alist of previous items, as returned by
+`org-list-prevs-alist'.
+
+This function modifies STRUCT."
+ (let ((case-fold-search nil)
+ (fix-bul
+ (function
+ ;; Set bullet of ITEM in STRUCT, depending on the type of
+ ;; first item of the list, the previous bullet and counter
+ ;; if any.
+ (lambda (item)
+ (let* ((prev (org-list-get-prev-item item struct prevs))
+ (prev-bul (and prev (org-list-get-bullet prev struct)))
+ (counter (org-list-get-counter item struct))
+ (bullet (org-list-get-bullet item struct))
+ (alphap (and (not prev)
+ (org-list-use-alpha-bul-p item struct prevs))))
+ (org-list-set-bullet
+ item struct
+ (org-list-bullet-string
+ (cond
+ ;; Alpha counter in alpha list: use counter.
+ ((and prev counter
+ (string-match "[a-zA-Z]" counter)
+ (string-match "[a-zA-Z]" prev-bul))
+ ;; Use cond to be sure `string-match' is used in
+ ;; both cases.
+ (let ((real-count
+ (cond
+ ((string-match "[a-z]" prev-bul) (downcase counter))
+ ((string-match "[A-Z]" prev-bul) (upcase counter)))))
+ (replace-match real-count nil nil prev-bul)))
+ ;; Num counter in a num list: use counter.
+ ((and prev counter
+ (string-match "[0-9]+" counter)
+ (string-match "[0-9]+" prev-bul))
+ (replace-match counter nil nil prev-bul))
+ ;; No counter: increase, if needed, previous bullet.
+ (prev
+ (org-list-inc-bullet-maybe (org-list-get-bullet prev struct)))
+ ;; Alpha counter at first item: use counter.
+ ((and counter (org-list-use-alpha-bul-p item struct prevs)
+ (string-match "[A-Za-z]" counter)
+ (string-match "[A-Za-z]" bullet))
+ (let ((real-count
+ (cond
+ ((string-match "[a-z]" bullet) (downcase counter))
+ ((string-match "[A-Z]" bullet) (upcase counter)))))
+ (replace-match real-count nil nil bullet)))
+ ;; Num counter at first item: use counter.
+ ((and counter
+ (string-match "[0-9]+" counter)
+ (string-match "[0-9]+" bullet))
+ (replace-match counter nil nil bullet))
+ ;; First bullet is alpha uppercase: use "A".
+ ((and alphap (string-match "[A-Z]" bullet))
+ (replace-match "A" nil nil bullet))
+ ;; First bullet is alpha lowercase: use "a".
+ ((and alphap (string-match "[a-z]" bullet))
+ (replace-match "a" nil nil bullet))
+ ;; First bullet is num: use "1".
+ ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet)
+ (replace-match "1" nil nil bullet))
+ ;; Not an ordered list: keep bullet.
+ (t bullet)))))))))
+ (mapc fix-bul (mapcar 'car struct))))
+
+(defun org-list-struct-fix-ind (struct parents &optional bullet-size)
+ "Verify and correct indentation in STRUCT.
+
+PARENTS is the alist of parents, as returned by
+`org-list-parents-alist'.
+
+If numeric optional argument BULLET-SIZE is set, assume all
+bullets in list have this length to determine new indentation.
+
+This function modifies STRUCT."
+ (let* ((ancestor (org-list-get-top-point struct))
+ (top-ind (org-list-get-ind ancestor struct))
+ (new-ind
+ (lambda (item)
+ (let ((parent (org-list-get-parent item struct parents)))
+ (if parent
+ ;; Indent like parent + length of parent's bullet +
+ ;; sub-list offset.
+ (org-list-set-ind
+ item struct (+ (or bullet-size
+ (length
+ (org-list-get-bullet parent struct)))
+ (org-list-get-ind parent struct)
+ org-list-indent-offset))
+ ;; If no parent, indent like top-point.
+ (org-list-set-ind item struct top-ind))))))
+ (mapc new-ind (mapcar 'car (cdr struct)))))
+
+(defun org-list-struct-fix-box (struct parents prevs &optional ordered)
+ "Verify and correct checkboxes in STRUCT.
+
+PARENTS is the alist of parents and PREVS is the alist of
+previous items, as returned by, respectively,
+`org-list-parents-alist' and `org-list-prevs-alist'.
+
+If ORDERED is non-nil, a checkbox can only be checked when every
+checkbox before it is checked too. If there was an attempt to
+break this rule, the function will return the blocking item. In
+all others cases, the return value will be nil.
+
+This function modifies STRUCT."
+ (let ((all-items (mapcar 'car struct))
+ (set-parent-box
+ (function
+ (lambda (item)
+ (let* ((box-list
+ (mapcar (lambda (child)
+ (org-list-get-checkbox child struct))
+ (org-list-get-children item struct parents))))
+ (org-list-set-checkbox
+ item struct
+ (cond
+ ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]")
+ ((member "[-]" box-list) "[-]")
+ ((member "[X]" box-list) "[X]")
+ ((member "[ ]" box-list) "[ ]")
+ ;; Parent has no boxed child: leave box as-is.
+ (t (org-list-get-checkbox item struct))))))))
+ parent-list)
+ ;; 1. List all parents with a checkbox.
+ (mapc
+ (lambda (e)
+ (let* ((parent (org-list-get-parent e struct parents))
+ (parent-box-p (org-list-get-checkbox parent struct)))
+ (when (and parent-box-p (not (memq parent parent-list)))
+ (push parent parent-list))))
+ all-items)
+ ;; 2. Sort those parents by decreasing indentation.
+ (setq parent-list (sort parent-list
+ (lambda (e1 e2)
+ (> (org-list-get-ind e1 struct)
+ (org-list-get-ind e2 struct)))))
+ ;; 3. For each parent, get all children's checkboxes to determine
+ ;; and set its checkbox accordingly.
+ (mapc set-parent-box parent-list)
+ ;; 4. If ORDERED is set, see if we need to uncheck some boxes.
+ (when ordered
+ (let* ((box-list
+ (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items))
+ (after-unchecked (member "[ ]" box-list)))
+ ;; There are boxes checked after an unchecked one: fix that.
+ (when (member "[X]" after-unchecked)
+ (let ((index (- (length struct) (length after-unchecked))))
+ (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]"))
+ (nthcdr index all-items))
+ ;; Verify once again the structure, without ORDERED.
+ (org-list-struct-fix-box struct parents prevs nil)
+ ;; Return blocking item.
+ (nth index all-items)))))))
+
+(defun org-list-struct-fix-item-end (struct)
+ "Verify and correct each item end position in STRUCT.
+
+This function modifies STRUCT."
+ (let (end-list acc-end)
+ (mapc (lambda (e)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (end-pos (org-list-get-item-end pos struct)))
+ (unless (assq end-pos struct)
+ ;; To determine real ind of an ending position that is
+ ;; not at an item, we have to find the item it belongs
+ ;; to: it is the last item (ITEM-UP), whose ending is
+ ;; further than the position we're interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons
+ ;; Else part is for the bottom point.
+ (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
+ end-pos)
+ end-list)))
+ (push (cons ind-pos pos) end-list)
+ (push (cons end-pos pos) acc-end)))
+ struct)
+ (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
+ (org-list-struct-assoc-end struct end-list)))
+
+(defun org-list-struct-apply-struct (struct old-struct)
+ "Apply set difference between STRUCT and OLD-STRUCT to the buffer.
+
+OLD-STRUCT is the structure before any modifications, and STRUCT
+the structure to be applied. The function will only modify parts
+of the list which have changed.
+
+Initial position of cursor is restored after the changes."
+ (let* ((origin (point-marker))
+ (inlinetask-re (and (featurep 'org-inlinetask)
+ (org-inlinetask-outline-regexp)))
+ (item-re (org-item-re))
+ (shift-body-ind
+ (function
+ ;; Shift the indentation between END and BEG by DELTA.
+ ;; Start from the line before END.
+ (lambda (end beg delta)
+ (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (while (or (> (point) beg)
+ (and (= (point) beg)
+ (not (looking-at item-re))))
+ (cond
+ ;; Skip inline tasks.
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (org-inlinetask-goto-beginning))
+ ;; Shift only non-empty lines.
+ ((org-looking-at-p "^[ \t]*\\S-")
+ (let ((i (org-get-indentation)))
+ (org-indent-line-to (+ i delta)))))
+ (forward-line -1)))))
+ (modify-item
+ (function
+ ;; Replace ITEM first line elements with new elements from
+ ;; STRUCT, if appropriate.
+ (lambda (item)
+ (goto-char item)
+ (let* ((new-ind (org-list-get-ind item struct))
+ (old-ind (org-get-indentation))
+ (new-bul (org-list-bullet-string
+ (org-list-get-bullet item struct)))
+ (old-bul (org-list-get-bullet item old-struct))
+ (new-box (org-list-get-checkbox item struct)))
+ (looking-at org-list-full-item-re)
+ ;; a. Replace bullet
+ (unless (equal old-bul new-bul)
+ (replace-match new-bul nil nil nil 1))
+ ;; b. Replace checkbox.
+ (cond
+ ((equal (match-string 3) new-box))
+ ((and (match-string 3) new-box)
+ (replace-match new-box nil nil nil 3))
+ ((match-string 3)
+ (looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
+ (replace-match "" nil nil nil 1))
+ (t (let ((counterp (match-end 2)))
+ (goto-char (if counterp (1+ counterp) (match-end 1)))
+ (insert (concat new-box (unless counterp " "))))))
+ ;; c. Indent item to appropriate column.
+ (unless (= new-ind old-ind)
+ (delete-region (goto-char (point-at-bol))
+ (progn (skip-chars-forward " \t") (point)))
+ (indent-to new-ind)))))))
+ ;; 1. First get list of items and position endings. We maintain
+ ;; two alists: ITM-SHIFT, determining indentation shift needed
+ ;; at item, and END-POS, a pseudo-alist where key is ending
+ ;; position and value point.
+ (let (end-list acc-end itm-shift all-ends sliced-struct)
+ (mapc (lambda (e)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (ind-old (org-list-get-ind pos old-struct))
+ (bul-pos (org-list-get-bullet pos struct))
+ (bul-old (org-list-get-bullet pos old-struct))
+ (ind-shift (- (+ ind-pos (length bul-pos))
+ (+ ind-old (length bul-old))))
+ (end-pos (org-list-get-item-end pos old-struct)))
+ (push (cons pos ind-shift) itm-shift)
+ (unless (assq end-pos old-struct)
+ ;; To determine real ind of an ending position that
+ ;; is not at an item, we have to find the item it
+ ;; belongs to: it is the last item (ITEM-UP), whose
+ ;; ending is further than the position we're
+ ;; interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons end-pos item-up) end-list)))
+ (push (cons end-pos pos) acc-end)))
+ old-struct)
+ ;; 2. Slice the items into parts that should be shifted by the
+ ;; same amount of indentation. The slices are returned in
+ ;; reverse order so changes modifying buffer do not change
+ ;; positions they refer to.
+ (setq all-ends (sort (append (mapcar 'car itm-shift)
+ (org-uniquify (mapcar 'car end-list)))
+ '<))
+ (while (cdr all-ends)
+ (let* ((up (pop all-ends))
+ (down (car all-ends))
+ (ind (if (assq up struct)
+ (cdr (assq up itm-shift))
+ (cdr (assq (cdr (assq up end-list)) itm-shift)))))
+ (push (list down up ind) sliced-struct)))
+ ;; 3. Shift each slice in buffer, provided delta isn't 0, from
+ ;; end to beginning. Take a special action when beginning is
+ ;; at item bullet.
+ (mapc (lambda (e)
+ (unless (zerop (nth 2 e)) (apply shift-body-ind e))
+ (let* ((beg (nth 1 e))
+ (cell (assq beg struct)))
+ (unless (or (not cell) (equal cell (assq beg old-struct)))
+ (funcall modify-item beg))))
+ sliced-struct))
+ ;; 4. Go back to initial position and clean marker.
+ (goto-char origin)
+ (move-marker origin nil)))
+
+(defun org-list-write-struct (struct parents &optional old-struct)
+ "Correct bullets, checkboxes and indentation in list at point.
+
+STRUCT is the list structure. PARENTS is the alist of parents,
+as returned by `org-list-parents-alist'.
+
+When non-nil, optional argument OLD-STRUCT is the reference
+structure of the list. It should be provided whenever STRUCT
+doesn't correspond anymore to the real list in buffer."
+ ;; Order of functions matters here: checkboxes and endings need
+ ;; correct indentation to be set, and indentation needs correct
+ ;; bullets.
+ ;;
+ ;; 0. Save a copy of structure before modifications
+ (let ((old-struct (or old-struct (copy-tree struct))))
+ ;; 1. Set a temporary, but coherent with PARENTS, indentation in
+ ;; order to get items endings and bullets properly
+ (org-list-struct-fix-ind struct parents 2)
+ ;; 2. Fix each item end to get correct prevs alist.
+ (org-list-struct-fix-item-end struct)
+ ;; 3. Get bullets right.
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ ;; 4. Now get real indentation.
+ (org-list-struct-fix-ind struct parents)
+ ;; 5. Eventually fix checkboxes.
+ (org-list-struct-fix-box struct parents prevs))
+ ;; 6. Apply structure modifications to buffer.
+ (org-list-struct-apply-struct struct old-struct)))
+
+
+
+;;; Misc Tools
+
+(defun org-apply-on-list (function init-value &rest args)
+ "Call FUNCTION on each item of the list at point.
+FUNCTION must be called with at least one argument: INIT-VALUE,
+that will contain the value returned by the function at the
+previous item, plus ARGS extra arguments.
+
+FUNCTION is applied on items in reverse order.
+
+As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\)
+will return the number of items in the current list.
+
+Sublists of the list are skipped. Cursor is always at the
+beginning of the item."
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (item (copy-marker (point-at-bol)))
+ (all (org-list-get-all-items (marker-position item) struct prevs))
+ (value init-value))
+ (mapc (lambda (e)
+ (goto-char e)
+ (setq value (apply function value args)))
+ (nreverse all))
+ (goto-char item)
+ (move-marker item nil)
+ value))
+
+(defun org-list-set-item-visibility (item struct view)
+ "Set visibility of ITEM in STRUCT to VIEW.
+
+Possible values are: `folded', `children' or `subtree'. See
+`org-cycle' for more information."
+ (cond
+ ((eq view 'folded)
+ (let ((item-end (org-list-get-item-end-before-blank item struct)))
+ ;; Hide from eol
+ (outline-flag-region (save-excursion (goto-char item) (point-at-eol))
+ item-end t)))
+ ((eq view 'children)
+ ;; First show everything.
+ (org-list-set-item-visibility item struct 'subtree)
+ ;; Then fold every child.
+ (let* ((parents (org-list-parents-alist struct))
+ (children (org-list-get-children item struct parents)))
+ (mapc (lambda (e)
+ (org-list-set-item-visibility e struct 'folded))
+ children)))
+ ((eq view 'subtree)
+ ;; Show everything
+ (let ((item-end (org-list-get-item-end item struct)))
+ (outline-flag-region item item-end nil)))))
+
+(defun org-list-item-body-column (item)
+ "Return column at which body of ITEM should start."
+ (let (bpos bcol tpos tcol)
+ (save-excursion
+ (goto-char item)
+ (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
+ (setq bpos (match-beginning 1) tpos (match-end 0)
+ bcol (progn (goto-char bpos) (current-column))
+ tcol (progn (goto-char tpos) (current-column)))
+ (when (> tcol (+ bcol org-description-max-indent))
+ (setq tcol (+ bcol 5))))
+ tcol))
+
+
+
+;;; Interactive functions
+
+(defalias 'org-list-get-item-begin 'org-in-item-p)
+
+(defun org-beginning-of-item ()
+ "Go to the beginning of the current item.
+Throw an error when not in a list."
+ (interactive)
+ (let ((begin (org-in-item-p)))
+ (if begin (goto-char begin) (error "Not in an item"))))
+
+(defun org-beginning-of-item-list ()
+ "Go to the beginning item of the current list or sublist.
+Throw an error when not in a list."
+ (interactive)
+ (let ((begin (org-in-item-p)))
+ (if (not begin)
+ (error "Not in an item")
+ (goto-char begin)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct)))
+ (goto-char (org-list-get-list-begin begin struct prevs))))))
+
+(defun org-end-of-item-list ()
+ "Go to the end of the current list or sublist.
+Throw an error when not in a list."
+ (interactive)
+ (let ((begin (org-in-item-p)))
+ (if (not begin)
+ (error "Not in an item")
+ (goto-char begin)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct)))
+ (goto-char (org-list-get-list-end begin struct prevs))))))
+
+(defun org-end-of-item ()
+ "Go to the end of the current item.
+Throw an error when not in a list."
+ (interactive)
+ (let ((begin (org-in-item-p)))
+ (if (not begin)
+ (error "Not in an item")
+ (goto-char begin)
+ (let ((struct (org-list-struct)))
+ (goto-char (org-list-get-item-end begin struct))))))
+
+(defun org-previous-item ()
+ "Move to the beginning of the previous item.
+Throw an error when not in a list. Also throw an error when at
+first item, unless `org-list-use-circular-motion' is non-nil."
+ (interactive)
+ (let ((item (org-in-item-p)))
+ (if (not item)
+ (error "Not in an item")
+ (goto-char item)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (prevp (org-list-get-prev-item item struct prevs)))
+ (cond
+ (prevp (goto-char prevp))
+ (org-list-use-circular-motion
+ (goto-char (org-list-get-last-item item struct prevs)))
+ (t (error "On first item")))))))
+
+(defun org-next-item ()
+ "Move to the beginning of the next item.
+Throw an error when not in a list. Also throw an error when at
+last item, unless `org-list-use-circular-motion' is non-nil."
+ (interactive)
+ (let ((item (org-in-item-p)))
+ (if (not item)
+ (error "Not in an item")
+ (goto-char item)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (prevp (org-list-get-next-item item struct prevs)))
+ (cond
+ (prevp (goto-char prevp))
+ (org-list-use-circular-motion
+ (goto-char (org-list-get-first-item item struct prevs)))
+ (t (error "On last item")))))))
+
+(defun org-move-item-down ()
+ "Move the item at point down, i.e. swap with following item.
+Sub-items (items with larger indentation) are considered part of
+the item, so this really moves item trees."
+ (interactive)
+ (unless (org-at-item-p) (error "Not at an item"))
+ (let* ((col (current-column))
+ (item (point-at-bol))
+ (struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (next-item (org-list-get-next-item (point-at-bol) struct prevs)))
+ (unless (or next-item org-list-use-circular-motion)
+ (error "Cannot move this item further down"))
+ (if (not next-item)
+ (setq struct (org-list-send-item item 'begin struct))
+ (setq struct (org-list-swap-items item next-item struct))
+ (goto-char
+ (org-list-get-next-item item struct (org-list-prevs-alist struct))))
+ (org-list-write-struct struct (org-list-parents-alist struct))
+ (org-move-to-column col)))
+
+(defun org-move-item-up ()
+ "Move the item at point up, i.e. swap with previous item.
+Sub-items (items with larger indentation) are considered part of
+the item, so this really moves item trees."
+ (interactive)
+ (unless (org-at-item-p) (error "Not at an item"))
+ (let* ((col (current-column))
+ (item (point-at-bol))
+ (struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (prev-item (org-list-get-prev-item (point-at-bol) struct prevs)))
+ (unless (or prev-item org-list-use-circular-motion)
+ (error "Cannot move this item further up"))
+ (if (not prev-item)
+ (setq struct (org-list-send-item item 'end struct))
+ (setq struct (org-list-swap-items prev-item item struct)))
+ (org-list-write-struct struct (org-list-parents-alist struct))
+ (org-move-to-column col)))
+
+(defun org-insert-item (&optional checkbox)
+ "Insert a new item at the current level.
+If cursor is before first character after bullet of the item, the
+new item will be created before the current one.
+
+If CHECKBOX is non-nil, add a checkbox next to the bullet.
+
+Return t when things worked, nil when we are not in an item, or
+item is invisible."
+ (let ((itemp (org-in-item-p))
+ (pos (point)))
+ ;; If cursor isn't is a list or if list is invisible, return nil.
+ (unless (or (not itemp)
+ (save-excursion
+ (goto-char itemp)
+ (outline-invisible-p)))
+ (if (save-excursion
+ (goto-char itemp)
+ (org-at-item-timer-p))
+ ;; Timer list: delegate to `org-timer-item'.
+ (progn (org-timer-item) t)
+ (let* ((struct (save-excursion (goto-char itemp)
+ (org-list-struct)))
+ (prevs (org-list-prevs-alist struct))
+ ;; If we're in a description list, ask for the new term.
+ (desc (when (eq (org-list-get-list-type itemp struct prevs)
+ 'descriptive)
+ (concat (read-string "Term: ") " :: "))))
+ (setq struct
+ (org-list-insert-item pos struct prevs checkbox desc))
+ (org-list-write-struct struct (org-list-parents-alist struct))
+ (when checkbox (org-update-checkbox-count-maybe))
+ (looking-at org-list-full-item-re)
+ (goto-char (if (and (match-beginning 4)
+ (save-match-data
+ (string-match "[.)]" (match-string 1))))
+ (match-beginning 4)
+ (match-end 0)))
+ t)))))
+
+(defun org-list-repair ()
+ "Fix indentation, bullets and checkboxes is the list at point."
+ (interactive)
+ (unless (org-at-item-p) (error "This is not a list"))
+ (let* ((struct (org-list-struct))
+ (parents (org-list-parents-alist struct)))
+ (org-list-write-struct struct parents)))
+
+(defun org-cycle-list-bullet (&optional which)
+ "Cycle through the different itemize/enumerate bullets.
+This cycle the entire list level through the sequence:
+
+ `-' -> `+' -> `*' -> `1.' -> `1)'
+
+If WHICH is a valid string, use that as the new bullet. If WHICH
+is an integer, 0 means `-', 1 means `+' etc. If WHICH is
+`previous', cycle backwards."
+ (interactive "P")
+ (unless (org-at-item-p) (error "Not at an item"))
+ (save-excursion
+ (beginning-of-line)
+ (let* ((struct (org-list-struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (list-beg (org-list-get-first-item (point) struct prevs))
+ (bullet (org-list-get-bullet list-beg struct))
+ (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
+ (case-fold-search nil)
+ (current (cond
+ ((string-match "[a-z]\\." bullet) "a.")
+ ((string-match "[a-z])" bullet) "a)")
+ ((string-match "[A-Z]\\." bullet) "A.")
+ ((string-match "[A-Z])" bullet) "A)")
+ ((string-match "\\." bullet) "1.")
+ ((string-match ")" bullet) "1)")
+ (t (org-trim bullet))))
+ ;; Compute list of possible bullets, depending on context.
+ (bullet-list
+ (append '("-" "+" )
+ ;; *-bullets are not allowed at column 0.
+ (unless (looking-at "\\S-") '("*"))
+ ;; Description items cannot be numbered.
+ (unless (or (eq org-plain-list-ordered-item-terminator ?\))
+ (org-at-item-description-p))
+ '("1."))
+ (unless (or (eq org-plain-list-ordered-item-terminator ?.)
+ (org-at-item-description-p))
+ '("1)"))
+ (unless (or (not alpha-p)
+ (eq org-plain-list-ordered-item-terminator ?\))
+ (org-at-item-description-p))
+ '("a." "A."))
+ (unless (or (not alpha-p)
+ (eq org-plain-list-ordered-item-terminator ?.)
+ (org-at-item-description-p))
+ '("a)" "A)"))))
+ (len (length bullet-list))
+ (item-index (- len (length (member current bullet-list))))
+ (get-value (lambda (index) (nth (mod index len) bullet-list)))
+ (new (cond
+ ((member which bullet-list) which)
+ ((numberp which) (funcall get-value which))
+ ((eq 'previous which) (funcall get-value (1- item-index)))
+ (t (funcall get-value (1+ item-index))))))
+ ;; Use a short variation of `org-list-write-struct' as there's
+ ;; no need to go through all the steps.
+ (let ((old-struct (copy-tree struct)))
+ (org-list-set-bullet list-beg struct (org-list-bullet-string new))
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (org-list-struct-apply-struct struct old-struct)))))
+
+(defun org-toggle-checkbox (&optional toggle-presence)
+ "Toggle the checkbox in the current line.
+With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
+double prefix, set checkbox to [-].
+
+When there is an active region, toggle status or presence of the
+first checkbox there, and make every item inside have the same
+status or presence, respectively.
+
+If the cursor is in a headline, apply this to all checkbox items
+in the text below the heading, taking as reference the first item
+in subtree, ignoring drawers."
+ (interactive "P")
+ (save-excursion
+ (let* (singlep
+ block-item
+ lim-up
+ lim-down
+ (drawer-re (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
+ "\\|" org-deadline-string
+ "\\|" org-closed-string
+ "\\|" org-clock-string "\\)"
+ " *[[<]\\([^]>]+\\)[]>]"))
+ (orderedp (org-entry-get nil "ORDERED"))
+ (bounds
+ ;; In a region, start at first item in region.
+ (cond
+ ((org-region-active-p)
+ (let ((limit (region-end)))
+ (goto-char (region-beginning))
+ (if (org-list-search-forward (org-item-beginning-re) limit t)
+ (setq lim-up (point-at-bol))
+ (error "No item in region"))
+ (setq lim-down (copy-marker limit))))
+ ((org-at-heading-p)
+ ;; On an heading, start at first item after drawers and
+ ;; time-stamps (scheduled, etc.).
+ (let ((limit (save-excursion (outline-next-heading) (point))))
+ (forward-line 1)
+ (while (or (looking-at drawer-re) (looking-at keyword-re))
+ (if (looking-at keyword-re)
+ (forward-line 1)
+ (re-search-forward "^[ \t]*:END:" limit nil)))
+ (if (org-list-search-forward (org-item-beginning-re) limit t)
+ (setq lim-up (point-at-bol))
+ (error "No item in subtree"))
+ (setq lim-down (copy-marker limit))))
+ ;; Just one item: set SINGLEP flag.
+ ((org-at-item-p)
+ (setq singlep t)
+ (setq lim-up (point-at-bol)
+ lim-down (copy-marker (point-at-eol))))
+ (t (error "Not at an item or heading, and no active region"))))
+ ;; Determine the checkbox going to be applied to all items
+ ;; within bounds.
+ (ref-checkbox
+ (progn
+ (goto-char lim-up)
+ (let ((cbox (and (org-at-item-checkbox-p) (match-string 1))))
+ (cond
+ ((equal toggle-presence '(16)) "[-]")
+ ((equal toggle-presence '(4))
+ (unless cbox "[ ]"))
+ ((equal "[X]" cbox) "[ ]")
+ (t "[X]"))))))
+ ;; When an item is found within bounds, grab the full list at
+ ;; point structure, then: (1) set check-box of all its items
+ ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the
+ ;; whole list, (3) move point after the list.
+ (goto-char lim-up)
+ (while (and (< (point) lim-down)
+ (org-list-search-forward (org-item-beginning-re)
+ lim-down 'move))
+ (let* ((struct (org-list-struct))
+ (struct-copy (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (bottom (copy-marker (org-list-get-bottom-point struct)))
+ (items-to-toggle (org-remove-if
+ (lambda (e) (or (< e lim-up) (> e lim-down)))
+ (mapcar 'car struct))))
+ (mapc (lambda (e) (org-list-set-checkbox
+ e struct
+ ;; If there is no box at item, leave as-is
+ ;; unless function was called with C-u prefix.
+ (let ((cur-box (org-list-get-checkbox e struct)))
+ (if (or cur-box (equal toggle-presence '(4)))
+ ref-checkbox
+ cur-box))))
+ items-to-toggle)
+ (setq block-item (org-list-struct-fix-box
+ struct parents prevs orderedp))
+ ;; Report some problems due to ORDERED status of subtree.
+ ;; If only one box was being checked, throw an error, else,
+ ;; only signal problems.
+ (cond
+ ((and singlep block-item (> lim-up block-item))
+ (error
+ "Checkbox blocked because of unchecked box at line %d"
+ (org-current-line block-item)))
+ (block-item
+ (message
+ "Checkboxes were removed due to unchecked box at line %d"
+ (org-current-line block-item))))
+ (goto-char bottom)
+ (move-marker bottom nil)
+ (org-list-struct-apply-struct struct struct-copy)))
+ (move-marker lim-down nil)))
+ (org-update-checkbox-count-maybe))
+
+(defun org-reset-checkbox-state-subtree ()
+ "Reset all checkboxes in an entry subtree."
+ (interactive "*")
+ (if (org-before-first-heading-p)
+ (error "Not inside a tree")
+ (save-restriction
+ (save-excursion
+ (org-narrow-to-subtree)
+ (org-show-subtree)
+ (goto-char (point-min))
+ (let ((end (point-max)))
+ (while (< (point) end)
+ (when (org-at-item-checkbox-p)
+ (replace-match "[ ]" t t nil 1))
+ (beginning-of-line 2)))
+ (org-update-checkbox-count-maybe 'all)))))
+
+(defun org-update-checkbox-count (&optional all)
+ "Update the checkbox statistics in the current section.
+This will find all statistic cookies like [57%] and [6/12] and
+update them with the current numbers.
+
+With optional prefix argument ALL, do this for the whole buffer."
+ (interactive "P")
+ (save-excursion
+ (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
+ (recursivep
+ (or (not org-hierarchical-checkbox-statistics)
+ (string-match "\\<recursive\\>"
+ (or (org-entry-get nil "COOKIE_DATA") ""))))
+ (bounds (if all
+ (cons (point-min) (point-max))
+ (cons (or (ignore-errors (org-back-to-heading t) (point))
+ (point-min))
+ (save-excursion (outline-next-heading) (point)))))
+ (count-boxes
+ (function
+ ;; Return number of checked boxes and boxes of all types
+ ;; in all structures in STRUCTS. If RECURSIVEP is
+ ;; non-nil, also count boxes in sub-lists. If ITEM is
+ ;; nil, count across the whole structure, else count only
+ ;; across subtree whose ancestor is ITEM.
+ (lambda (item structs recursivep)
+ (let ((c-on 0) (c-all 0))
+ (mapc
+ (lambda (s)
+ (let* ((pre (org-list-prevs-alist s))
+ (par (org-list-parents-alist s))
+ (items
+ (cond
+ ((and recursivep item) (org-list-get-subtree item s))
+ (recursivep (mapcar 'car s))
+ (item (org-list-get-children item s par))
+ (t (org-list-get-all-items
+ (org-list-get-top-point s) s pre))))
+ (cookies (delq nil (mapcar
+ (lambda (e)
+ (org-list-get-checkbox e s))
+ items))))
+ (setq c-all (+ (length cookies) c-all)
+ c-on (+ (org-count "[X]" cookies) c-on))))
+ structs)
+ (cons c-on c-all)))))
+ (backup-end 1)
+ cookies-list structs-bak box-num)
+ (goto-char (car bounds))
+ ;; 1. Build an alist for each cookie found within BOUNDS. The
+ ;; key will be position at beginning of cookie and values
+ ;; ending position, format of cookie, and a cell whose car is
+ ;; number of checked boxes to report, and cdr total number of
+ ;; boxes.
+ (while (re-search-forward cookie-re (cdr bounds) t)
+ (catch 'skip
+ (save-excursion
+ (push
+ (list
+ (match-beginning 1) ; cookie start
+ (match-end 1) ; cookie end
+ (match-string 2) ; percent?
+ (cond ; boxes count
+ ;; Cookie is at an heading, but specifically for todo,
+ ;; not for checkboxes: skip it.
+ ((and (org-at-heading-p)
+ (string-match "\\<todo\\>"
+ (downcase
+ (or (org-entry-get nil "COOKIE_DATA") ""))))
+ (throw 'skip nil))
+ ;; Cookie is at an heading, but all lists before next
+ ;; heading already have been read. Use data collected
+ ;; in STRUCTS-BAK. This should only happen when
+ ;; heading has more than one cookie on it.
+ ((and (org-at-heading-p)
+ (<= (save-excursion (outline-next-heading) (point))
+ backup-end))
+ (funcall count-boxes nil structs-bak recursivep))
+ ;; Cookie is at a fresh heading. Grab structure of
+ ;; every list containing a checkbox between point and
+ ;; next headline, and save them in STRUCTS-BAK.
+ ((org-at-heading-p)
+ (setq backup-end (save-excursion
+ (outline-next-heading) (point))
+ structs-bak nil)
+ (while (org-list-search-forward box-re backup-end 'move)
+ (let* ((struct (org-list-struct))
+ (bottom (org-list-get-bottom-point struct)))
+ (push struct structs-bak)
+ (goto-char bottom)))
+ (funcall count-boxes nil structs-bak recursivep))
+ ;; Cookie is at an item, and we already have list
+ ;; structure stored in STRUCTS-BAK.
+ ((and (org-at-item-p)
+ (< (point-at-bol) backup-end)
+ ;; Only lists in no special context are stored.
+ (not (nth 2 (org-list-context))))
+ (funcall count-boxes (point-at-bol) structs-bak recursivep))
+ ;; Cookie is at an item, but we need to compute list
+ ;; structure.
+ ((org-at-item-p)
+ (let ((struct (org-list-struct)))
+ (setq backup-end (org-list-get-bottom-point struct)
+ structs-bak (list struct)))
+ (funcall count-boxes (point-at-bol) structs-bak recursivep))
+ ;; Else, cookie found is at a wrong place. Skip it.
+ (t (throw 'skip nil))))
+ cookies-list))))
+ ;; 2. Apply alist to buffer, in reverse order so positions stay
+ ;; unchanged after cookie modifications.
+ (mapc (lambda (cookie)
+ (let* ((beg (car cookie))
+ (end (nth 1 cookie))
+ (percentp (nth 2 cookie))
+ (checked (car (nth 3 cookie)))
+ (total (cdr (nth 3 cookie)))
+ (new (if percentp
+ (format "[%d%%]" (/ (* 100 checked)
+ (max 1 total)))
+ (format "[%d/%d]" checked total))))
+ (goto-char beg)
+ (insert new)
+ (delete-region (point) (+ (point) (- end beg)))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly))))
+ cookies-list))))
+
+(defun org-get-checkbox-statistics-face ()
+ "Select the face for checkbox statistics.
+The face will be `org-done' when all relevant boxes are checked.
+Otherwise it will be `org-todo'."
+ (if (match-end 1)
+ (if (equal (match-string 1) "100%")
+ 'org-checkbox-statistics-done
+ 'org-checkbox-statistics-todo)
+ (if (and (> (match-end 2) (match-beginning 2))
+ (equal (match-string 2) (match-string 3)))
+ 'org-checkbox-statistics-done
+ 'org-checkbox-statistics-todo)))
+
+(defun org-update-checkbox-count-maybe (&optional all)
+ "Update checkbox statistics unless turned off by user.
+With an optional argument ALL, update them in the whole buffer."
+ (when (cdr (assq 'checkbox org-list-automatic-rules))
+ (org-update-checkbox-count all))
+ (run-hooks 'org-checkbox-statistics-hook))
+
+(defvar org-last-indent-begin-marker (make-marker))
+(defvar org-last-indent-end-marker (make-marker))
+(defun org-list-indent-item-generic (arg no-subtree struct)
+ "Indent a local list item including its children.
+When number ARG is a negative, item will be outdented, otherwise
+it will be indented.
+
+If a region is active, all items inside will be moved.
+
+If NO-SUBTREE is non-nil, only indent the item itself, not its
+children.
+
+STRUCT is the list structure.
+
+Return t if successful."
+ (save-excursion
+ (let* ((regionp (org-region-active-p))
+ (rbeg (and regionp (region-beginning)))
+ (rend (and regionp (region-end)))
+ (top (org-list-get-top-point struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ ;; Are we going to move the whole list?
+ (specialp
+ (and (not regionp)
+ (= top (point-at-bol))
+ (cdr (assq 'indent org-list-automatic-rules))
+ (if no-subtree
+ (error
+ "First item of list cannot move without its subtree")
+ t))))
+ ;; Determine begin and end points of zone to indent. If moving
+ ;; more than one item, save them for subsequent moves.
+ (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
+ (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
+ (if regionp
+ (progn
+ (set-marker org-last-indent-begin-marker rbeg)
+ (set-marker org-last-indent-end-marker rend))
+ (set-marker org-last-indent-begin-marker (point-at-bol))
+ (set-marker org-last-indent-end-marker
+ (cond
+ (specialp (org-list-get-bottom-point struct))
+ (no-subtree (1+ (point-at-bol)))
+ (t (org-list-get-item-end (point-at-bol) struct))))))
+ (let* ((beg (marker-position org-last-indent-begin-marker))
+ (end (marker-position org-last-indent-end-marker)))
+ (cond
+ ;; Special case: moving top-item with indent rule.
+ (specialp
+ (let* ((level-skip (org-level-increment))
+ (offset (if (< arg 0) (- level-skip) level-skip))
+ (top-ind (org-list-get-ind beg struct))
+ (old-struct (copy-tree struct)))
+ (if (< (+ top-ind offset) 0)
+ (error "Cannot outdent beyond margin")
+ ;; Change bullet if necessary.
+ (when (and (= (+ top-ind offset) 0)
+ (string-match "*"
+ (org-list-get-bullet beg struct)))
+ (org-list-set-bullet beg struct
+ (org-list-bullet-string "-")))
+ ;; Shift every item by OFFSET and fix bullets. Then
+ ;; apply changes to buffer.
+ (mapc (lambda (e)
+ (let ((ind (org-list-get-ind (car e) struct)))
+ (org-list-set-ind (car e) struct (+ ind offset))))
+ struct)
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-apply-struct struct old-struct))))
+ ;; Forbidden move:
+ ((and (< arg 0)
+ ;; If only one item is moved, it mustn't have a child.
+ (or (and no-subtree
+ (not regionp)
+ (org-list-has-child-p beg struct))
+ ;; If a subtree or region is moved, the last item
+ ;; of the subtree mustn't have a child.
+ (let ((last-item (caar
+ (reverse
+ (org-remove-if
+ (lambda (e) (>= (car e) end))
+ struct)))))
+ (org-list-has-child-p last-item struct))))
+ (error "Cannot outdent an item without its children"))
+ ;; Normal shifting
+ (t
+ (let* ((new-parents
+ (if (< arg 0)
+ (org-list-struct-outdent beg end struct parents)
+ (org-list-struct-indent beg end struct parents prevs))))
+ (org-list-write-struct struct new-parents))
+ (org-update-checkbox-count-maybe))))))
+ t)
+
+(defun org-outdent-item ()
+ "Outdent a local list item, but not its children.
+If a region is active, all items inside will be moved."
+ (interactive)
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic -1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
+
+(defun org-indent-item ()
+ "Indent a local list item, but not its children.
+If a region is active, all items inside will be moved."
+ (interactive)
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic 1 t struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
+
+(defun org-outdent-item-tree ()
+ "Outdent a local list item including its children.
+If a region is active, all items inside will be moved."
+ (interactive)
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic -1 nil struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
+
+(defun org-indent-item-tree ()
+ "Indent a local list item including its children.
+If a region is active, all items inside will be moved."
+ (interactive)
+ (let ((regionp (org-region-active-p)))
+ (cond
+ ((or (org-at-item-p)
+ (and regionp
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p))))
+ (let ((struct (if (not regionp) (org-list-struct)
+ (save-excursion (goto-char (region-beginning))
+ (org-list-struct)))))
+ (org-list-indent-item-generic 1 nil struct)))
+ (regionp (error "Region not starting at an item"))
+ (t (error "Not at an item")))))
+
+(defvar org-tab-ind-state)
+(defun org-cycle-item-indentation ()
+ "Cycle levels of indentation of an empty item.
+The first run indents the item, if applicable. Subsequent runs
+outdent it at meaningful levels in the list. When done, item is
+put back at its original position with its original bullet.
+
+Return t at each successful move."
+ (when (org-at-item-p)
+ (let* ((org-adapt-indentation nil)
+ (struct (org-list-struct))
+ (ind (org-list-get-ind (point-at-bol) struct))
+ (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol)))))
+ ;; Accept empty items or if cycle has already started.
+ (when (or (eq last-command 'org-cycle-item-indentation)
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at org-list-full-item-re))
+ (>= (match-end 0) (save-excursion
+ (goto-char (org-list-get-item-end
+ (point-at-bol) struct))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (setq this-command 'org-cycle-item-indentation)
+ ;; When in the middle of the cycle, try to outdent first. If
+ ;; it fails, and point is still at initial position, indent.
+ ;; Else, re-create it at its original position.
+ (if (eq last-command 'org-cycle-item-indentation)
+ (cond
+ ((ignore-errors (org-list-indent-item-generic -1 t struct)))
+ ((and (= ind (car org-tab-ind-state))
+ (ignore-errors (org-list-indent-item-generic 1 t struct))))
+ (t (delete-region (point-at-bol) (point-at-eol))
+ (org-indent-to-column (car org-tab-ind-state))
+ (insert (cdr org-tab-ind-state) " ")
+ ;; Break cycle
+ (setq this-command 'identity)))
+ ;; If a cycle is starting, remember indentation and bullet,
+ ;; then try to indent. If it fails, try to outdent.
+ (setq org-tab-ind-state (cons ind bullet))
+ (cond
+ ((ignore-errors (org-list-indent-item-generic 1 t struct)))
+ ((ignore-errors (org-list-indent-item-generic -1 t struct)))
+ (t (error "Cannot move item"))))
+ t))))
+
+(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
+ "Sort list items.
+The cursor may be at any item of the list that should be sorted.
+Sublists are not sorted. Checkboxes, if any, are ignored.
+
+Sorting can be alphabetically, numerically, by date/time as given
+by a time stamp, by a property or by priority.
+
+Comparing entries ignores case by default. However, with an
+optional argument WITH-CASE, the sorting considers case as well.
+
+The command prompts for the sorting type unless it has been given
+to the function through the SORTING-TYPE argument, which needs to
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
+meaning of each character:
+
+n Numerically, by converting the beginning of the item to a number.
+a Alphabetically. Only the first line of item is checked.
+t By date/time, either the first active time stamp in the entry, if
+ any, or by the first inactive one. In a timer list, sort the timers.
+
+Capital letters will reverse the sort order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
+a function to be called with point at the beginning of the
+record. It must return either a string or a number that should
+serve as the sorting key for that record. It will then use
+COMPARE-FUNC to compare entries."
+ (interactive "P")
+ (let* ((case-func (if with-case 'identity 'downcase))
+ (struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (start (org-list-get-list-begin (point-at-bol) struct prevs))
+ (end (org-list-get-list-end (point-at-bol) struct prevs))
+ (sorting-type
+ (progn
+ (message
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
+ (read-char-exclusive)))
+ (getkey-func (and (= (downcase sorting-type) ?f)
+ (intern (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil)))))
+ (message "Sorting items...")
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (let* ((dcst (downcase sorting-type))
+ (case-fold-search nil)
+ (now (current-time))
+ (sort-func (cond
+ ((= dcst ?a) 'string<)
+ ((= dcst ?f) compare-func)
+ ((= dcst ?t) '<)))
+ (next-record (lambda ()
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)))
+ (end-record (lambda ()
+ (goto-char (org-list-get-item-end-before-blank
+ (point) struct))))
+ (value-to-sort
+ (lambda ()
+ (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
+ (cond
+ ((= dcst ?n)
+ (string-to-number (buffer-substring (match-end 0)
+ (point-at-eol))))
+ ((= dcst ?a)
+ (funcall case-func
+ (buffer-substring (match-end 0) (point-at-eol))))
+ ((= dcst ?t)
+ (cond
+ ;; If it is a timer list, convert timer to seconds
+ ((org-at-item-timer-p)
+ (org-timer-hms-to-secs (match-string 1)))
+ ((or (re-search-forward org-ts-regexp (point-at-eol) t)
+ (re-search-forward org-ts-regexp-both
+ (point-at-eol) t))
+ (org-time-string-to-seconds (match-string 0)))
+ (t (org-float-time now))))
+ ((= dcst ?f)
+ (if getkey-func
+ (let ((value (funcall getkey-func)))
+ (if (stringp value)
+ (funcall case-func value)
+ value))
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))))
+ (sort-subr (/= dcst sorting-type)
+ next-record
+ end-record
+ value-to-sort
+ nil
+ sort-func)
+ ;; Read and fix list again, as `sort-subr' probably destroyed
+ ;; its structure.
+ (org-list-repair)
+ (run-hooks 'org-after-sorting-entries-or-items-hook)
+ (message "Sorting items...done")))))
+
+
+
+;;; Send and receive lists
+
+(defun org-list-parse-list (&optional delete)
+ "Parse the list at point and maybe DELETE it.
+
+Return a list whose car is a symbol of list type, among
+`ordered', `unordered' and `descriptive'. Then, each item is
+a list whose car is counter, and cdr are strings and other
+sub-lists. Inside strings, check-boxes are replaced by
+\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\".
+
+For example, the following list:
+
+1. first item
+ + sub-item one
+ + [X] sub-item two
+ more text in first item
+2. [@3] last item
+
+will be parsed as:
+
+\(ordered
+ \(nil \"first item\"
+ \(unordered
+ \(nil \"sub-item one\"\)
+ \(nil \"[CBON] sub-item two\"\)\)
+ \"more text in first item\"\)
+ \(3 \"last item\"\)\)
+
+Point is left at list end."
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct))
+ (top (org-list-get-top-point struct))
+ (bottom (org-list-get-bottom-point struct))
+ out
+ parse-item ; for byte-compiler
+ (get-text
+ (function
+ ;; Return text between BEG and END, trimmed, with
+ ;; checkboxes replaced.
+ (lambda (beg end)
+ (let ((text (org-trim (buffer-substring beg end))))
+ (if (string-match "\\`\\[\\([-X ]\\)\\]" text)
+ (replace-match
+ (let ((box (match-string 1 text)))
+ (cond
+ ((equal box " ") "CBOFF")
+ ((equal box "-") "CBTRANS")
+ (t "CBON")))
+ t nil text 1)
+ text)))))
+ (parse-sublist
+ (function
+ ;; Return a list whose car is list type and cdr a list of
+ ;; items' body.
+ (lambda (e)
+ (cons (org-list-get-list-type (car e) struct prevs)
+ (mapcar parse-item e)))))
+ (parse-item
+ (function
+ ;; Return a list containing counter of item, if any, text
+ ;; and any sublist inside it.
+ (lambda (e)
+ (let ((start (save-excursion
+ (goto-char e)
+ (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
+ (match-end 0)))
+ ;; Get counter number. For alphabetic counter, get
+ ;; its position in the alphabet.
+ (counter (let ((c (org-list-get-counter e struct)))
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c))))))
+ (childp (org-list-has-child-p e struct))
+ (end (org-list-get-item-end e struct)))
+ ;; If item has a child, store text between bullet and
+ ;; next child, then recursively parse all sublists. At
+ ;; the end of each sublist, check for the presence of
+ ;; text belonging to the original item.
+ (if childp
+ (let* ((children (org-list-get-children e struct parents))
+ (body (list (funcall get-text start childp))))
+ (while children
+ (let* ((first (car children))
+ (sub (org-list-get-all-items first struct prevs))
+ (last-c (car (last sub)))
+ (last-end (org-list-get-item-end last-c struct)))
+ (push (funcall parse-sublist sub) body)
+ ;; Remove children from the list just parsed.
+ (setq children (cdr (member last-c children)))
+ ;; There is a chunk of text belonging to the
+ ;; item if last child doesn't end where next
+ ;; child starts or where item ends.
+ (unless (= (or (car children) end) last-end)
+ (push (funcall get-text
+ last-end (or (car children) end))
+ body))))
+ (cons counter (nreverse body)))
+ (list counter (funcall get-text start end))))))))
+ ;; Store output, take care of cursor position and deletion of
+ ;; list, then return output.
+ (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs)))
+ (goto-char top)
+ (when delete
+ (delete-region top bottom)
+ (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
+ (replace-match "")))
+ out))
+
+(defun org-list-make-subtree ()
+ "Convert the plain list at point into a subtree."
+ (interactive)
+ (if (not (ignore-errors (goto-char (org-in-item-p))))
+ (error "Not in a list")
+ (let ((list (save-excursion (org-list-parse-list t))))
+ (insert (org-list-to-subtree list)))))
+
+(defun org-list-insert-radio-list ()
+ "Insert a radio list template appropriate for this major mode."
+ (interactive)
+ (let* ((e (assq major-mode org-list-radio-list-templates))
+ (txt (nth 1 e))
+ name pos)
+ (unless e (error "No radio list setup defined for %s" major-mode))
+ (setq name (read-string "List name: "))
+ (while (string-match "%n" txt)
+ (setq txt (replace-match name t t txt)))
+ (or (bolp) (insert "\n"))
+ (setq pos (point))
+ (insert txt)
+ (goto-char pos)))
+
+(defun org-list-send-list (&optional maybe)
+ "Send a transformed version of this list to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined
+for this list."
+ (interactive)
+ (catch 'exit
+ (unless (org-at-item-p) (error "Not at a list item"))
+ (save-excursion
+ (re-search-backward "#\\+ORGLST" nil t)
+ (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
+ (if maybe
+ (throw 'exit nil)
+ (error "Don't know how to transform this list"))))
+ (let* ((name (match-string 1))
+ (transform (intern (match-string 2)))
+ (bottom-point
+ (save-excursion
+ (re-search-forward
+ "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
+ (match-beginning 0)))
+ (top-point
+ (progn
+ (re-search-backward "#\\+ORGLST" nil t)
+ (re-search-forward (org-item-beginning-re) bottom-point t)
+ (match-beginning 0)))
+ (list (save-restriction
+ (narrow-to-region top-point bottom-point)
+ (org-list-parse-list)))
+ beg txt)
+ (unless (fboundp transform)
+ (error "No such transformation function %s" transform))
+ (let ((txt (funcall transform list)))
+ ;; Find the insertion place
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "BEGIN RECEIVE ORGLST +"
+ name
+ "\\([ \t]\\|$\\)") nil t)
+ (error "Don't know where to insert translated list"))
+ (goto-char (match-beginning 0))
+ (beginning-of-line 2)
+ (setq beg (point))
+ (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
+ (error "Cannot find end of insertion region"))
+ (delete-region beg (point-at-bol))
+ (goto-char beg)
+ (insert txt "\n")))
+ (message "List converted and installed at receiver location"))))
+
+(defsubst org-list-item-trim-br (item)
+ "Trim line breaks in a list ITEM."
+ (setq item (replace-regexp-in-string "\n +" " " item)))
+
+(defun org-list-to-generic (list params)
+ "Convert a LIST parsed through `org-list-parse-list' to other formats.
+Valid parameters PARAMS are:
+
+:ustart String to start an unordered list
+:uend String to end an unordered list
+
+:ostart String to start an ordered list
+:oend String to end an ordered list
+
+:dstart String to start a descriptive list
+:dend String to end a descriptive list
+:dtstart String to start a descriptive term
+:dtend String to end a descriptive term
+:ddstart String to start a description
+:ddend String to end a description
+
+:splice When set to t, return only list body lines, don't wrap
+ them into :[u/o]start and :[u/o]end. Default is nil.
+
+:istart String to start a list item.
+:icount String to start an item with a counter.
+:iend String to end a list item
+:isep String to separate items
+:lsep String to separate sublists
+:csep String to separate text from a sub-list
+
+:cboff String to insert for an unchecked check-box
+:cbon String to insert for a checked check-box
+:cbtrans String to insert for a check-box in transitional state
+
+:nobr Non-nil means remove line breaks in lists items.
+
+Alternatively, each parameter can also be a form returning
+a string. These sexp can use keywords `counter' and `depth',
+representing respectively counter associated to the current
+item, and depth of the current sub-list, starting at 0.
+Obviously, `counter' is only available for parameters applying to
+items."
+ (interactive)
+ (let* ((p params)
+ (splicep (plist-get p :splice))
+ (ostart (plist-get p :ostart))
+ (oend (plist-get p :oend))
+ (ustart (plist-get p :ustart))
+ (uend (plist-get p :uend))
+ (dstart (plist-get p :dstart))
+ (dend (plist-get p :dend))
+ (dtstart (plist-get p :dtstart))
+ (dtend (plist-get p :dtend))
+ (ddstart (plist-get p :ddstart))
+ (ddend (plist-get p :ddend))
+ (istart (plist-get p :istart))
+ (icount (plist-get p :icount))
+ (iend (plist-get p :iend))
+ (isep (plist-get p :isep))
+ (lsep (plist-get p :lsep))
+ (csep (plist-get p :csep))
+ (cbon (plist-get p :cbon))
+ (cboff (plist-get p :cboff))
+ (cbtrans (plist-get p :cbtrans))
+ (nobr (plist-get p :nobr))
+ export-sublist ; for byte-compiler
+ (export-item
+ (function
+ ;; Export an item ITEM of type TYPE, at DEPTH. First
+ ;; string in item is treated in a special way as it can
+ ;; bring extra information that needs to be processed.
+ (lambda (item type depth)
+ (let* ((counter (pop item))
+ (fmt (concat
+ (cond
+ ((eq type 'descriptive)
+ ;; Stick DTSTART to ISTART by
+ ;; left-trimming the latter.
+ (concat (let ((s (eval istart)))
+ (or (and (string-match "[ \t\n\r]+\\'" s)
+ (replace-match "" t t s))
+ istart))
+ "%s" (eval ddend)))
+ ((and counter (eq type 'ordered))
+ (concat (eval icount) "%s"))
+ (t (concat (eval istart) "%s")))
+ (eval iend)))
+ (first (car item)))
+ ;; Replace checkbox if any is found.
+ (cond
+ ((string-match "\\[CBON\\]" first)
+ (setq first (replace-match cbon t t first)))
+ ((string-match "\\[CBOFF\\]" first)
+ (setq first (replace-match cboff t t first)))
+ ((string-match "\\[CBTRANS\\]" first)
+ (setq first (replace-match cbtrans t t first))))
+ ;; Replace line breaks if required
+ (when nobr (setq first (org-list-item-trim-br first)))
+ ;; Insert descriptive term if TYPE is `descriptive'.
+ (when (eq type 'descriptive)
+ (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first))
+ (term (if complete
+ (save-match-data
+ (org-trim (match-string 1 first)))
+ "???"))
+ (desc (if complete
+ (org-trim (substring first (match-end 0)))
+ first)))
+ (setq first (concat (eval dtstart) term (eval dtend)
+ (eval ddstart) desc))))
+ (setcar item first)
+ (format fmt
+ (mapconcat (lambda (e)
+ (if (stringp e) e
+ (funcall export-sublist e (1+ depth))))
+ item (or (eval csep) "")))))))
+ (export-sublist
+ (function
+ ;; Export sublist SUB at DEPTH.
+ (lambda (sub depth)
+ (let* ((type (car sub))
+ (items (cdr sub))
+ (fmt (concat (cond
+ (splicep "%s")
+ ((eq type 'ordered)
+ (concat (eval ostart) "%s" (eval oend)))
+ ((eq type 'descriptive)
+ (concat (eval dstart) "%s" (eval dend)))
+ (t (concat (eval ustart) "%s" (eval uend))))
+ (eval lsep))))
+ (format fmt (mapconcat (lambda (e)
+ (funcall export-item e type depth))
+ items (or (eval isep) ""))))))))
+ (concat (funcall export-sublist list 0) "\n")))
+
+(defun org-list-to-latex (list &optional params)
+ "Convert LIST into a LaTeX list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
+ :ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
+ :dstart "\\begin{description}\n" :dend "\\end{description}"
+ :dtstart "[" :dtend "] "
+ :istart "\\item " :iend "\n"
+ :icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
+ (if enum
+ ;; LaTeX increments counter just before
+ ;; using it, so set it to the desired
+ ;; value, minus one.
+ (format "\\setcounter{enum%s}{%s}\n\\item "
+ enum (1- counter))
+ "\\item "))
+ :csep "\n"
+ :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
+ :cbtrans "\\texttt{[-]}")
+ params)))
+
+(defun org-list-to-html (list &optional params)
+ "Convert LIST into a HTML list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
+ :ustart "<ul>\n" :uend "\n</ul>"
+ :dstart "<dl>\n" :dend "\n</dl>"
+ :dtstart "<dt>" :dtend "</dt>\n"
+ :ddstart "<dd>" :ddend "</dd>"
+ :istart "<li>" :iend "</li>"
+ :icount (format "<li value=\"%s\">" counter)
+ :isep "\n" :lsep "\n" :csep "\n"
+ :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
+ :cbtrans "<code>[-]</code>")
+ params)))
+
+(defun org-list-to-texinfo (list &optional params)
+ "Convert LIST into a Texinfo list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
+ :ustart "@enumerate\n" :uend "@end enumerate"
+ :dstart "@table @asis\n" :dend "@end table"
+ :dtstart " " :dtend "\n"
+ :istart "@item\n" :iend "\n"
+ :icount "@item\n"
+ :csep "\n"
+ :cbon "@code{[X]}" :cboff "@code{[ ]}"
+ :cbtrans "@code{[-]}")
+ params)))
+
+(defun org-list-to-subtree (list &optional params)
+ "Convert LIST into an Org subtree.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
+ (level (org-reduced-level (or (org-current-level) 0)))
+ (blankp (or (eq rule t)
+ (and (eq rule 'auto)
+ (save-excursion
+ (outline-previous-heading)
+ (org-previous-line-empty-p)))))
+ (get-stars
+ (function
+ ;; Return the string for the heading, depending on depth D
+ ;; of current sub-list.
+ (lambda (d)
+ (let ((oddeven-level (+ level d 1)))
+ (concat (make-string (if org-odd-levels-only
+ (1- (* 2 oddeven-level))
+ oddeven-level)
+ ?*)
+ " "))))))
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splice t
+ :dtstart " " :dtend " "
+ :istart (funcall get-stars depth)
+ :icount (funcall get-stars depth)
+ :isep (if blankp "\n\n" "\n")
+ :csep (if blankp "\n\n" "\n")
+ :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ params))))
+
+(provide 'org-list)
+
+;;; org-list.el ends here
diff --git a/lisp/org-lparse.el b/lisp/org-lparse.el
new file mode 100644
index 0000000..7024912
--- /dev/null
+++ b/lisp/org-lparse.el
@@ -0,0 +1,2301 @@
+;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `org-lparse' is the entry point for the generic line-oriented
+;; exporter. `org-do-lparse' is the genericized version of the
+;; original `org-export-as-html' routine.
+
+;; `org-lparse-native-backends' is a good starting point for
+;; exploring the generic exporter.
+
+;; Following new interactive commands are provided by this library.
+;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
+;; `org-replace-region-by', `org-lparse-region'.
+
+;; Note that the above routines correspond to the following routines
+;; in the html exporter `org-export-as-html',
+;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
+;; `org-replace-region-by-html' and `org-export-region-as-html'.
+
+;; The new interactive command `org-lparse-convert' can be used to
+;; convert documents between various formats. Use this to command,
+;; for example, to convert odt file to doc or pdf format.
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'org-exp)
+(require 'org-list)
+(require 'format-spec)
+
+;;;###autoload
+(defun org-lparse-and-open (target-backend native-backend arg
+ &optional file-or-buf)
+ "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists."
+ (let (f (file-or-buf (or file-or-buf
+ (org-lparse target-backend native-backend
+ arg 'hidden))))
+ (when file-or-buf
+ (setq f (cond
+ ((bufferp file-or-buf) buffer-file-name)
+ ((file-exists-p file-or-buf) file-or-buf)
+ (t (error "org-lparse-and-open: This shouldn't happen"))))
+ (message "Opening file %s" f)
+ (org-open-file f 'system)
+ (when org-export-kill-product-buffer-when-displayed
+ (kill-buffer (current-buffer))))))
+
+;;;###autoload
+(defun org-lparse-batch (target-backend &optional native-backend)
+ "Call the function `org-lparse'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-lparse-batch"
+ (setq native-backend (or native-backend target-backend))
+ (org-lparse target-backend native-backend
+ org-export-headline-levels 'hidden))
+
+;;;###autoload
+(defun org-lparse-to-buffer (backend arg)
+ "Call `org-lparse' with output to a temporary buffer.
+No file is created. The prefix ARG is passed through to
+`org-lparse'."
+ (let ((tempbuf (format "*Org %s Export*" (upcase backend))))
+ (org-lparse backend backend arg nil nil tempbuf)
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window tempbuf))))
+
+;;;###autoload
+(defun org-replace-region-by (backend beg end)
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you could write an
+itemized list in org-mode syntax in an HTML buffer and then use
+this command to convert it."
+ (let (reg backend-string buf pop-up-frames)
+ (save-window-excursion
+ (if (derived-mode-p 'org-mode)
+ (setq backend-string (org-lparse-region backend beg end t 'string))
+ (setq reg (buffer-substring beg end)
+ buf (get-buffer-create "*Org tmp*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert reg)
+ (org-mode)
+ (setq backend-string (org-lparse-region backend (point-min)
+ (point-max) t 'string)))
+ (kill-buffer buf)))
+ (delete-region beg end)
+ (insert backend-string)))
+
+;;;###autoload
+(defun org-lparse-region (backend beg end &optional body-only buffer)
+ "Convert region from BEG to END in org-mode buffer to HTML.
+If prefix arg BODY-ONLY is set, omit file header, footer, and table of
+contents, and only produce the region of converted text, useful for
+cut-and-paste operations.
+If BUFFER is a buffer or a string, use/create that buffer as a target
+of the converted HTML. If BUFFER is the symbol `string', return the
+produced HTML as a string and leave not buffer behind. For example,
+a Lisp program could call this function in the following way:
+
+ (setq html (org-lparse-region \"html\" beg end t 'string))
+
+When called interactively, the output buffer is selected, and shown
+in a window. A non-interactive call will only return the buffer."
+ (let ((transient-mark-mode t) (zmacs-regions t)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
+ (goto-char end)
+ (set-mark (point)) ;; to activate the region
+ (goto-char beg)
+ (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (if (and (org-called-interactively-p 'any) (bufferp rtn))
+ (switch-to-buffer-other-window rtn)
+ rtn)))
+
+(defvar org-lparse-par-open nil)
+
+(defun org-lparse-should-inline-p (filename descp)
+ "Return non-nil if link FILENAME should be inlined.
+The decision to inline the FILENAME link is based on the current
+settings. DESCP is the boolean of whether there was a link
+description. See variables `org-export-html-inline-images' and
+`org-export-html-inline-image-extensions'."
+ (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
+ (inline-image-extensions
+ (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (and (or (eq t inline-images) (and inline-images (not descp)))
+ (org-file-image-p filename inline-image-extensions))))
+
+(defun org-lparse-format-org-link (line opt-plist)
+ "Return LINE with markup of Org mode links.
+OPT-PLIST is the export options list."
+ (let ((start 0)
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (link-validate (plist-get opt-plist :link-validation-function))
+ type id-file fnc
+ rpl path attr desc descp desc1 desc2 link
+ org-lparse-link-description-is-image)
+ (while (string-match org-bracket-link-analytic-regexp++ line start)
+ (setq org-lparse-link-description-is-image nil)
+ (setq start (match-beginning 0))
+ (setq path (save-match-data (org-link-unescape
+ (match-string 3 line))))
+ (setq type (cond
+ ((match-end 2) (match-string 2 line))
+ ((save-match-data
+ (or (file-name-absolute-p path)
+ (string-match "^\\.\\.?/" path)))
+ "file")
+ (t "internal")))
+ (setq path (org-extract-attributes path))
+ (setq attr (get-text-property 0 'org-attributes path))
+ (setq desc1 (if (match-end 5) (match-string 5 line))
+ desc2 (if (match-end 2) (concat type ":" path) path)
+ descp (and desc1 (not (equal desc1 desc2)))
+ desc (or desc1 desc2))
+ ;; Make an image out of the description if that is so wanted
+ (when (and descp (org-file-image-p
+ desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
+ (setq org-lparse-link-description-is-image t)
+ (save-match-data
+ (if (string-match "^file:" desc)
+ (setq desc (substring desc (match-end 0)))))
+ (save-match-data
+ (setq desc (org-add-props
+ (org-lparse-format 'INLINE-IMAGE desc)
+ '(org-protected t)))))
+ (cond
+ ((equal type "internal")
+ (let
+ ((frag-0
+ (if (= (string-to-char path) ?#)
+ (substring path 1)
+ path)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist "" "" (org-solidify-link-text
+ (save-match-data
+ (org-link-unescape frag-0))
+ nil) desc attr descp))))
+ ((and (equal type "id")
+ (setq id-file (org-id-find-id-file path)))
+ ;; This is an id: link to another file (if it was the same file,
+ ;; it would have become an internal link...)
+ (save-match-data
+ (setq id-file (file-relative-name
+ id-file
+ (file-name-directory org-current-export-file)))
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type id-file
+ (concat (if (org-uuidgen-p path) "ID-") path)
+ desc attr descp))))
+ ((member type '("http" "https"))
+ ;; standard URL, can inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+ ((member type '("ftp" "mailto" "news"))
+ ;; standard URL, can't inline as image
+ (setq rpl
+ (org-lparse-format
+ 'ORG-LINK opt-plist type path nil desc attr descp)))
+
+ ((string= type "coderef")
+ (setq rpl (org-lparse-format
+ 'ORG-LINK opt-plist type "" path desc nil descp)))
+
+ ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
+ ;; The link protocol has a function for format the link
+ (setq rpl (save-match-data
+ (funcall fnc (org-link-unescape path)
+ desc1 (and (boundp 'org-lparse-backend)
+ (case org-lparse-backend
+ (xhtml 'html)
+ (t org-lparse-backend)))))))
+ ((string= type "file")
+ ;; FILE link
+ (save-match-data
+ (let*
+ ((components
+ (if
+ (string-match "::\\(.*\\)" path)
+ (list
+ (replace-match "" t nil path)
+ (match-string 1 path))
+ (list path nil)))
+
+ ;;The proper path, without a fragment
+ (path-1
+ (first components))
+
+ ;;The raw fragment
+ (fragment-0
+ (second components))
+
+ ;;Check the fragment. If it can't be used as
+ ;;target fragment we'll pass nil instead.
+ (fragment-1
+ (if
+ (and fragment-0
+ (not (string-match "^[0-9]*$" fragment-0))
+ (not (string-match "^\\*" fragment-0))
+ (not (string-match "^/.*/$" fragment-0)))
+ (org-solidify-link-text
+ (org-link-unescape fragment-0))
+ nil))
+ (desc-2
+ ;;Description minus "file:" and ".org"
+ (if (string-match "^file:" desc)
+ (let
+ ((desc-1 (replace-match "" t t desc)))
+ (if (string-match "\\.org$" desc-1)
+ (replace-match "" t t desc-1)
+ desc-1))
+ desc)))
+
+ (setq rpl
+ (if
+ (and
+ (functionp link-validate)
+ (not (funcall link-validate path-1 current-dir)))
+ desc
+ (org-lparse-format
+ 'ORG-LINK opt-plist "file" path-1 fragment-1
+ desc-2 attr descp))))))
+
+ (t
+ ;; just publish the path, as default
+ (setq rpl (concat "<i>&lt;" type ":"
+ (save-match-data (org-link-unescape path))
+ "&gt;</i>"))))
+ (setq line (replace-match rpl t t line)
+ start (+ start (length rpl))))
+ line))
+
+(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse'
+(defun org-lparse-stash-save-paragraph-state ()
+ (assert (zerop org-lparse-par-open-stashed))
+ (setq org-lparse-par-open-stashed org-lparse-par-open)
+ (setq org-lparse-par-open nil))
+
+(defun org-lparse-stash-pop-paragraph-state ()
+ (setq org-lparse-par-open org-lparse-par-open-stashed)
+ (setq org-lparse-par-open-stashed 0))
+
+(defmacro with-org-lparse-preserve-paragraph-state (&rest body)
+ `(let ((org-lparse-do-open-par org-lparse-par-open))
+ (org-lparse-end-paragraph)
+ ,@body
+ (when org-lparse-do-open-par
+ (org-lparse-begin-paragraph))))
+(def-edebug-spec with-org-lparse-preserve-paragraph-state (body))
+
+(defvar org-lparse-native-backends nil
+ "List of native backends registered with `org-lparse'.
+A backend can use `org-lparse-register-backend' to add itself to
+this list.
+
+All native backends must implement a get routine and a mandatory
+set of callback routines.
+
+The get routine must be named as org-<backend>-get where backend
+is the name of the backend. The exporter uses `org-lparse-get'
+and retrieves the backend-specific callback by querying for
+ENTITY-CONTROL and ENTITY-FORMAT variables.
+
+For the sake of illustration, the html backend implements
+`org-xhtml-get'. It returns
+`org-xhtml-entity-control-callbacks-alist' and
+`org-xhtml-entity-format-callbacks-alist' as the values of
+ENTITY-CONTROL and ENTITY-FORMAT settings.")
+
+(defun org-lparse-register-backend (backend)
+ "Make BACKEND known to `org-lparse' library.
+Add BACKEND to `org-lparse-native-backends'."
+ (when backend
+ (setq backend (cond
+ ((symbolp backend) (symbol-name backend))
+ ((stringp backend) backend)
+ (t (error "Error while registering backend: %S" backend))))
+ (add-to-list 'org-lparse-native-backends backend)))
+
+(defun org-lparse-unregister-backend (backend)
+ (setq org-lparse-native-backends
+ (remove (cond
+ ((symbolp backend) (symbol-name backend))
+ ((stringp backend) backend))
+ org-lparse-native-backends))
+ (message "Unregistered backend %S" backend))
+
+(defun org-lparse-do-reachable-formats (in-fmt)
+ "Return verbose info about formats to which IN-FMT can be converted.
+Return a list where each element is of the
+form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
+`org-export-odt-convert-processes' for CONVERTER-PROCESS and see
+`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
+ (let (reachable-formats)
+ (dolist (backend org-lparse-native-backends reachable-formats)
+ (let* ((converter (org-lparse-backend-get
+ backend 'CONVERT-METHOD))
+ (capabilities (org-lparse-backend-get
+ backend 'CONVERT-CAPABILITIES)))
+ (when converter
+ (dolist (c capabilities)
+ (when (member in-fmt (nth 1 c))
+ (push (cons converter (nth 2 c)) reachable-formats))))))))
+
+(defun org-lparse-reachable-formats (in-fmt)
+ "Return list of formats to which IN-FMT can be converted.
+The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
+ (let (l)
+ (mapc (lambda (e) (add-to-list 'l e))
+ (apply 'append (mapcar
+ (lambda (e) (mapcar 'car (cdr e)))
+ (org-lparse-do-reachable-formats in-fmt))))
+ l))
+
+(defun org-lparse-reachable-p (in-fmt out-fmt)
+ "Return non-nil if IN-FMT can be converted to OUT-FMT."
+ (catch 'done
+ (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt)))
+ (dolist (e reachable-formats)
+ (let ((out-fmt-spec (assoc out-fmt (cdr e))))
+ (when out-fmt-spec
+ (throw 'done (cons (car e) out-fmt-spec))))))))
+
+(defun org-lparse-backend-is-native-p (backend)
+ (member backend org-lparse-native-backends))
+
+(defun org-lparse (target-backend native-backend arg
+ &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline to various formats.
+If there is an active region, export only the region. The
+outline is first exported to NATIVE-BACKEND and optionally
+converted to TARGET-BACKEND. See `org-lparse-native-backends'
+for list of known native backends. Each native backend can
+specify a converter and list of target backends it exports to
+using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
+method. See `org-xhtml-get' for an illustrative example.
+
+ARG is a prefix argument that specifies how many levels of
+outline should become headlines. The default is 3. Lower levels
+will become bulleted lists.
+
+HIDDEN is obsolete and does nothing.
+
+EXT-PLIST is a property list that controls various aspects of
+export. The settings here override org-mode's default settings
+and but are inferior to file-local settings.
+
+TO-BUFFER dumps the exported lines to a buffer or a string
+instead of a file. If TO-BUFFER is the symbol `string' return the
+exported lines as a string. If TO-BUFFER is non-nil, create a
+buffer with that name and export to that buffer.
+
+BODY-ONLY controls the presence of header and footer lines in
+exported text. If BODY-ONLY is non-nil, don't produce the file
+header and footer, simply return the content of <body>...</body>,
+without even the body tags themselves.
+
+PUB-DIR specifies the publishing directory."
+ (let* ((org-lparse-backend (intern native-backend))
+ (org-lparse-other-backend (and target-backend
+ (intern target-backend))))
+ (add-hook 'org-export-preprocess-hook
+ 'org-lparse-strip-experimental-blocks-maybe)
+ (add-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote)
+ (unless (org-lparse-backend-is-native-p native-backend)
+ (error "Don't know how to export natively to backend %s" native-backend))
+
+ (unless (or (equal native-backend target-backend)
+ (org-lparse-reachable-p native-backend target-backend))
+ (error "Don't know how to export to backend %s %s" target-backend
+ (format "via %s" native-backend)))
+ (run-hooks 'org-export-first-hook)
+ (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)
+ (remove-hook 'org-export-preprocess-hook
+ 'org-lparse-strip-experimental-blocks-maybe)
+ (remove-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote)))
+
+(defcustom org-lparse-use-flashy-warning nil
+ "Control flashing of messages logged with `org-lparse-warn'.
+When non-nil, messages are fontified with warning face and the
+exporter lingers for a while to catch user's attention."
+ :type 'boolean
+ :group 'org-lparse)
+
+(defun org-lparse-convert-read-params ()
+ "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'.
+This is a helper routine for interactive use."
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (in-file (read-file-name "File to be converted: "
+ nil buffer-file-name t))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt-choices (org-lparse-reachable-formats in-fmt))
+ (out-fmt
+ (or (and out-fmt-choices
+ (funcall input "Output format: "
+ out-fmt-choices nil nil nil))
+ (error
+ "No known converter or no known output formats for %s files"
+ in-fmt))))
+ (list in-file out-fmt)))
+
+(eval-when-compile
+ (require 'browse-url))
+
+(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg)
+ "Workhorse routine for `org-export-odt-convert'."
+ (require 'browse-url)
+ (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
+ (dummy (or (file-readable-p in-file)
+ (error "Cannot read %s" in-file)))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt (or out-fmt (error "Output format unspecified")))
+ (how (or (org-lparse-reachable-p in-fmt out-fmt)
+ (error "Cannot convert from %s format to %s format?"
+ in-fmt out-fmt)))
+ (convert-process (car how))
+ (out-file (concat (file-name-sans-extension in-file) "."
+ (nth 1 (or (cdr how) out-fmt))))
+ (extra-options (or (nth 2 (cdr how)) ""))
+ (out-dir (file-name-directory in-file))
+ (cmd (format-spec convert-process
+ `((?i . ,(shell-quote-argument in-file))
+ (?I . ,(browse-url-file-url in-file))
+ (?f . ,out-fmt)
+ (?o . ,out-file)
+ (?O . ,(browse-url-file-url out-file))
+ (?d . , (shell-quote-argument out-dir))
+ (?D . ,(browse-url-file-url out-dir))
+ (?x . ,extra-options)))))
+ (when (file-exists-p out-file)
+ (delete-file out-file))
+
+ (message "Executing %s" cmd)
+ (let ((cmd-output (shell-command-to-string cmd)))
+ (message "%s" cmd-output))
+
+ (cond
+ ((file-exists-p out-file)
+ (message "Exported to %s" out-file)
+ (when prefix-arg
+ (message "Opening %s..." out-file)
+ (org-open-file out-file 'system))
+ out-file)
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defvar org-lparse-insert-tag-with-newlines 'both)
+
+;; Following variables are let-bound during `org-lparse'
+(defvar org-lparse-dyn-first-heading-pos)
+(defvar org-lparse-toc)
+(defvar org-lparse-entity-control-callbacks-alist)
+(defvar org-lparse-entity-format-callbacks-alist)
+(defvar org-lparse-backend nil
+ "The native backend to which the document is currently exported.
+This variable is let bound during `org-lparse'. Valid values are
+one of the symbols corresponding to `org-lparse-native-backends'.
+
+Compare this variable with `org-export-current-backend' which is
+bound only during `org-export-preprocess-string' stage of the
+export process.
+
+See also `org-lparse-other-backend'.")
+
+(defvar org-lparse-other-backend nil
+ "The target backend to which the document is currently exported.
+This variable is let bound during `org-lparse'. This variable is
+set to either `org-lparse-backend' or one of the symbols
+corresponding to OTHER-BACKENDS specification of the
+org-lparse-backend.
+
+For example, if a document is exported to \"odt\" then both
+org-lparse-backend and org-lparse-other-backend are bound to
+'odt. On the other hand, if a document is exported to \"odt\"
+and then converted to \"doc\" then org-lparse-backend is set to
+'odt and org-lparse-other-backend is set to 'doc.")
+
+(defvar org-lparse-body-only nil
+ "Bind this to BODY-ONLY arg of `org-lparse'.")
+
+(defvar org-lparse-to-buffer nil
+ "Bind this to TO-BUFFER arg of `org-lparse'.")
+
+(defun org-lparse-get-block-params (params)
+ (save-match-data
+ (when params
+ (setq params (org-trim params))
+ (unless (string-match "\\`(.*)\\'" params)
+ (setq params (format "(%s)" params)))
+ (ignore-errors (read params)))))
+
+(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defvar org-lparse-special-blocks '("list-table" "annotation"))
+(defun org-do-lparse (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline to various formats.
+See `org-lparse' for more information. This function is a
+html-agnostic version of the `org-export-as-html' function in 7.5
+version."
+ ;; Make sure we have a file name when we need it.
+ (when (and (not (or to-buffer body-only))
+ (not buffer-file-name))
+ (if (buffer-base-buffer)
+ (org-set-local 'buffer-file-name
+ (with-current-buffer (buffer-base-buffer)
+ buffer-file-name))
+ (error "Need a file name to be able to export")))
+
+ (org-lparse-warn
+ (format "Exporting to %s using org-lparse..."
+ (upcase (symbol-name
+ (or org-lparse-backend org-lparse-other-backend)))))
+
+ (setq-default org-todo-line-regexp org-todo-line-regexp)
+ (setq-default org-deadline-line-regexp org-deadline-line-regexp)
+ (setq-default org-done-keywords org-done-keywords)
+ (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
+ (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that
+ ; we are interested in
+ ; collecting styles
+ org-lparse-encode-pending
+ org-lparse-par-open
+ (org-lparse-par-open-stashed 0)
+
+ ;; list related vars
+ (org-lparse-list-stack '())
+
+ ;; list-table related vars
+ org-lparse-list-table-p
+ org-lparse-list-table:table-cell-open
+ org-lparse-list-table:table-row
+ org-lparse-list-table:lines
+
+ org-lparse-outline-text-open
+ (org-lparse-latex-fragment-fallback ; currently used only by
+ ; odt exporter
+ (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
+ (if (and (org-check-external-command "latex" "" t)
+ (org-check-external-command "dvipng" "" t))
+ 'dvipng
+ 'verbatim)))
+ (org-lparse-insert-tag-with-newlines 'both)
+ (org-lparse-to-buffer to-buffer)
+ (org-lparse-body-only body-only)
+ (org-lparse-entity-control-callbacks-alist
+ (org-lparse-get 'ENTITY-CONTROL))
+ (org-lparse-entity-format-callbacks-alist
+ (org-lparse-get 'ENTITY-FORMAT))
+ (opt-plist
+ (org-export-process-option-filters
+ (org-combine-plists (org-default-export-plist)
+ ext-plist
+ (org-infile-export-plist))))
+ (body-only (or body-only (plist-get opt-plist :body-only)))
+ valid org-lparse-dyn-first-heading-pos
+ (odd org-odd-levels-only)
+ (region-p (org-region-active-p))
+ (rbeg (and region-p (region-beginning)))
+ (rend (and region-p (region-end)))
+ (subtree-p
+ (if (plist-get opt-plist :ignore-subtree-p)
+ nil
+ (when region-p
+ (save-excursion
+ (goto-char rbeg)
+ (and (org-at-heading-p)
+ (>= (org-end-of-subtree t t) rend))))))
+ (level-offset (if subtree-p
+ (save-excursion
+ (goto-char rbeg)
+ (+ (funcall outline-level)
+ (if org-odd-levels-only 1 0)))
+ 0))
+ (opt-plist (setq org-export-opt-plist
+ (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist)))
+ ;; The following two are dynamically scoped into other
+ ;; routines below.
+ (org-current-export-dir
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
+ (org-current-export-file buffer-file-name)
+ (level 0) (line "") (origline "") txt todo
+ (umax nil)
+ (umax-toc nil)
+ (filename (if to-buffer nil
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (and subtree-p
+ (org-entry-get (region-beginning)
+ "EXPORT_FILE_NAME" t))
+ (file-name-nondirectory buffer-file-name)))
+ "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
+ (file-name-as-directory
+ (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
+ (current-dir (if buffer-file-name
+ (file-name-directory buffer-file-name)
+ default-directory))
+ (auto-insert nil) ; Avoid any auto-insert stuff for the new file
+ (buffer (if to-buffer
+ (cond
+ ((eq to-buffer 'string)
+ (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
+ (t (get-buffer-create to-buffer)))
+ (find-file-noselect
+ (or (let ((f (org-lparse-get 'INIT-METHOD)))
+ (and f (functionp f) (funcall f filename)))
+ filename))))
+ (org-levels-open (make-vector org-level-max nil))
+ (dummy (mapc
+ (lambda(p)
+ (let* ((val (plist-get opt-plist p))
+ (val (org-xml-encode-org-text-skip-links val)))
+ (setq opt-plist (plist-put opt-plist p val))))
+ '(:date :author :keywords :description)))
+ (date (plist-get opt-plist :date))
+ (date (cond
+ ((and date (string-match "%" date))
+ (format-time-string date))
+ (date date)
+ (t (format-time-string "%Y-%m-%d %T %Z"))))
+ (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
+ (title (org-xml-encode-org-text-skip-links
+ (or (and subtree-p (org-export-get-title-from-subtree))
+ (plist-get opt-plist :title)
+ (and (not body-only)
+ (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (and buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name)))
+ "UNTITLED")))
+ (dummy (setq opt-plist (plist-put opt-plist :title title)))
+ (html-table-tag (plist-get opt-plist :html-table-tag))
+ (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
+ (quote-re (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (org-lparse-dyn-current-environment nil)
+ ;; Get the language-dependent settings
+ (lang-words (or (assoc (plist-get opt-plist :language)
+ org-export-language-setup)
+ (assoc "en" org-export-language-setup)))
+ (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
+ (head-count 0) cnt
+ (start 0)
+ (coding-system-for-write
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (save-buffer-coding-system
+ (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
+ (and (boundp 'buffer-file-coding-system)
+ buffer-file-coding-system)))
+ (region
+ (buffer-substring
+ (if region-p (region-beginning) (point-min))
+ (if region-p (region-end) (point-max))))
+ (org-export-have-math nil)
+ (org-export-footnotes-seen nil)
+ (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
+ (org-footnote-insert-pos-for-preprocessor 'point-min)
+ (org-lparse-opt-plist opt-plist)
+ (lines
+ (org-split-string
+ (org-export-preprocess-string
+ region
+ :emph-multiline t
+ :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
+ 'html
+ org-lparse-backend)
+ :skip-before-1st-heading
+ (plist-get opt-plist :skip-before-1st-heading)
+ :drawers (plist-get opt-plist :drawers)
+ :todo-keywords (plist-get opt-plist :todo-keywords)
+ :tasks (plist-get opt-plist :tasks)
+ :tags (plist-get opt-plist :tags)
+ :priority (plist-get opt-plist :priority)
+ :footnotes (plist-get opt-plist :footnotes)
+ :timestamps (plist-get opt-plist :timestamps)
+ :archived-trees
+ (plist-get opt-plist :archived-trees)
+ :select-tags (plist-get opt-plist :select-tags)
+ :exclude-tags (plist-get opt-plist :exclude-tags)
+ :add-text
+ (plist-get opt-plist :text)
+ :LaTeX-fragments
+ (plist-get opt-plist :LaTeX-fragments))
+ "[\r\n]"))
+ table-open
+ table-buffer table-orig-buffer
+ ind
+ rpl path attr desc descp desc1 desc2 link
+ snumber fnc
+ footnotes footref-seen
+ org-lparse-output-buffer
+ org-lparse-footnote-definitions
+ org-lparse-footnote-number
+ ;; collection
+ org-lparse-collect-buffer
+ (org-lparse-collect-count 0) ; things will get haywire if
+ ; collections are chained. Use
+ ; this variable to assert this
+ ; pre-requisite
+ org-lparse-toc
+ href
+ )
+
+ (let ((inhibit-read-only t))
+ (org-unmodified
+ (remove-text-properties (point-min) (point-max)
+ '(:org-license-to-kill t))))
+
+ (message "Exporting...")
+ (org-init-section-numbers)
+
+ ;; Switch to the output buffer
+ (setq org-lparse-output-buffer buffer)
+ (set-buffer org-lparse-output-buffer)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (fundamental-mode)
+ (org-install-letbind)
+
+ (and (fboundp 'set-buffer-file-coding-system)
+ (set-buffer-file-coding-system coding-system-for-write))
+
+ (let ((case-fold-search nil)
+ (org-odd-levels-only odd))
+ ;; create local variables for all options, to make sure all called
+ ;; functions get the correct information
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars)
+ (setq umax (if arg (prefix-numeric-value arg)
+ org-export-headline-levels))
+ (setq umax-toc (if (integerp org-export-with-toc)
+ (min org-export-with-toc umax)
+ umax))
+ (setq org-lparse-opt-plist
+ (plist-put org-lparse-opt-plist :headline-levels umax))
+
+ (when (and org-export-with-toc (not body-only))
+ (setq lines (org-lparse-prepare-toc
+ lines level-offset opt-plist umax-toc)))
+
+ (unless body-only
+ (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
+ (org-lparse-begin 'DOCUMENT-BODY opt-plist))
+
+ (setq head-count 0)
+ (org-init-section-numbers)
+
+ (org-lparse-begin-paragraph)
+
+ (while (setq line (pop lines) origline line)
+ (catch 'nextline
+ (when (and (org-lparse-current-environment-p 'quote)
+ (string-match org-outline-regexp-bol line))
+ (org-lparse-end-environment 'quote))
+
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-insert 'LINE line)
+ (throw 'nextline nil))
+
+ ;; Fixed-width, verbatim lines (examples)
+ (when (and org-export-with-fixed-width
+ (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
+ (when (not (org-lparse-current-environment-p 'fixedwidth))
+ (org-lparse-begin-environment 'fixedwidth))
+ (org-lparse-insert 'LINE (match-string 3 line))
+ (when (or (not lines)
+ (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
+ (car lines))))
+ (org-lparse-end-environment 'fixedwidth))
+ (throw 'nextline nil))
+
+ ;; Native Text
+ (when (and (get-text-property 0 'org-native-text line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-native-text line) 10000)
+ (length line))))
+ (let ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-begin-environment 'native)
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-native-text (car lines))))
+ (org-lparse-insert 'LINE (pop lines)))
+ (org-lparse-end-environment 'native))
+ (throw 'nextline nil))
+
+ ;; Protected HTML
+ (when (and (get-text-property 0 'org-protected line)
+ ;; Make sure it is the entire line that is protected
+ (not (< (or (next-single-property-change
+ 0 'org-protected line) 10000)
+ (length line))))
+ (let ((ind (get-text-property 0 'original-indentation line)))
+ (org-lparse-insert 'LINE line)
+ (while (and lines
+ (or (= (length (car lines)) 0)
+ (not ind)
+ (equal ind (get-text-property
+ 0 'original-indentation (car lines))))
+ (or (= (length (car lines)) 0)
+ (get-text-property 0 'org-protected (car lines))))
+ (org-lparse-insert 'LINE (pop lines))))
+ (throw 'nextline nil))
+
+ ;; Blockquotes, verse, and center
+ (when (string-match
+ "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line)
+ (let* ((style (intern (downcase (match-string 1 line))))
+ (env-options-plist (org-lparse-get-block-params
+ (match-string 3 line)))
+ (f (cdr (assoc (match-string 2 line)
+ '(("START" . org-lparse-begin-environment)
+ ("END" . org-lparse-end-environment))))))
+ (when (memq style
+ (append
+ '(blockquote verse center)
+ (mapcar 'intern org-lparse-special-blocks)))
+ (funcall f style env-options-plist)
+ (throw 'nextline nil))))
+
+ (when (org-lparse-current-environment-p 'verse)
+ (let ((i (org-get-string-indentation line)))
+ (if (> i 0)
+ (setq line (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'SPACES (* 2 i)))
+ " " (org-trim line))))
+ (unless (string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (concat line "\\\\")))))
+
+ ;; make targets to anchors
+ (setq start 0)
+ (while (string-match
+ "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
+ (cond
+ ((get-text-property (match-beginning 1) 'org-protected line)
+ (setq start (match-end 1)))
+ ((match-end 2)
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR "" (org-solidify-link-text
+ (match-string 1 line))))
+ t t line)))
+ ((and org-export-with-toc (equal (string-to-char line) ?*))
+ ;; FIXME: NOT DEPENDENT on TOC?????????????????????
+ (setq line (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'FONTIFY (match-string 1 line) "target"))
+ ;; (concat "@<i>" (match-string 1 line) "@</i> ")
+ t t line)))
+ (t
+ (setq line (replace-match
+ (concat
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format
+ 'ANCHOR (match-string 1 line)
+ (org-solidify-link-text (match-string 1 line))
+ "target")) " ")
+ t t line)))))
+
+ (let ((org-lparse-encode-pending t))
+ (setq line (org-lparse-handle-time-stamps line)))
+
+ ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
+ ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
+ ;; Also handle sub_superscripts and checkboxes
+ (or (string-match org-table-hline-regexp line)
+ (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
+ (setq line (org-xml-encode-org-text-skip-links line)))
+
+ (setq line (org-lparse-format-org-link line opt-plist))
+
+ ;; TODO items
+ (if (and org-todo-line-regexp
+ (string-match org-todo-line-regexp line)
+ (match-beginning 2))
+ (setq line (concat
+ (substring line 0 (match-beginning 2))
+ (org-lparse-format 'TODO (match-string 2 line))
+ (substring line (match-end 2)))))
+
+ ;; Does this contain a reference to a footnote?
+ (when org-export-with-footnotes
+ (setq start 0)
+ (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
+ ;; Discard protected matches not clearly identified as
+ ;; footnote markers.
+ (if (or (get-text-property (match-beginning 2) 'org-protected line)
+ (not (get-text-property (match-beginning 2) 'org-footnote line)))
+ (setq start (match-end 2))
+ (let ((n (match-string 2 line)) refcnt a)
+ (if (setq a (assoc n footref-seen))
+ (progn
+ (setcdr a (1+ (cdr a)))
+ (setq refcnt (cdr a)))
+ (setq refcnt 1)
+ (push (cons n 1) footref-seen))
+ (setq line
+ (replace-match
+ (concat
+ (or (match-string 1 line) "")
+ (org-lparse-format
+ 'FOOTNOTE-REFERENCE
+ n (cdr (assoc n org-lparse-footnote-definitions))
+ refcnt)
+ ;; If another footnote is following the
+ ;; current one, add a separator.
+ (if (save-match-data
+ (string-match "\\`\\[[0-9]+\\]"
+ (substring line (match-end 0))))
+ (ignore-errors
+ (org-lparse-get 'FOOTNOTE-SEPARATOR))
+ ""))
+ t t line))))))
+
+ (cond
+ ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
+ ;; This is a headline
+ (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
+ level-offset))
+ txt (match-string 2 line))
+ (if (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (if (<= level (max umax umax-toc))
+ (setq head-count (+ head-count 1)))
+ (unless org-lparse-dyn-first-heading-pos
+ (setq org-lparse-dyn-first-heading-pos (point)))
+ (org-lparse-begin-level level txt umax head-count)
+
+ ;; QUOTES
+ (when (string-match quote-re line)
+ (org-lparse-begin-environment 'quote)))
+
+ ((and org-export-with-tables
+ (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
+ (when (not table-open)
+ ;; New table starts
+ (setq table-open t table-buffer nil table-orig-buffer nil))
+
+ ;; Accumulate lines
+ (setq table-buffer (cons line table-buffer)
+ table-orig-buffer (cons origline table-orig-buffer))
+ (when (or (not lines)
+ (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
+ (car lines))))
+ (setq table-open nil
+ table-buffer (nreverse table-buffer)
+ table-orig-buffer (nreverse table-orig-buffer))
+ (org-lparse-end-paragraph)
+ (when org-lparse-list-table-p
+ (error "Regular tables are not allowed in a list-table block"))
+ (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
+
+ ;; Normal lines
+ (t
+ ;; This line either is list item or end a list.
+ (when (get-text-property 0 'list-item line)
+ (setq line (org-lparse-export-list-line
+ line
+ (get-text-property 0 'list-item line)
+ (get-text-property 0 'list-struct line)
+ (get-text-property 0 'list-prevs line))))
+
+ ;; Horizontal line
+ (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
+ (with-org-lparse-preserve-paragraph-state
+ (org-lparse-insert 'HORIZONTAL-LINE))
+ (throw 'nextline nil))
+
+ ;; Empty lines start a new paragraph. If hand-formatted lists
+ ;; are not fully interpreted, lines starting with "-", "+", "*"
+ ;; also start a new paragraph.
+ (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
+ (when org-lparse-footnote-number
+ (org-lparse-end-footnote-definition org-lparse-footnote-number)
+ (setq org-lparse-footnote-number nil))
+ (org-lparse-begin-paragraph))
+
+ ;; Is this the start of a footnote?
+ (when org-export-with-footnotes
+ (when (and (boundp 'footnote-section-tag-regexp)
+ (string-match (concat "^" footnote-section-tag-regexp)
+ line))
+ ;; ignore this line
+ (throw 'nextline nil))
+ (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
+ (org-lparse-end-paragraph)
+ (setq org-lparse-footnote-number (match-string 1 line))
+ (setq line (replace-match "" t t line))
+ (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
+ ;; Check if the line break needs to be conserved
+ (cond
+ ((string-match "\\\\\\\\[ \t]*$" line)
+ (setq line (replace-match
+ (org-lparse-format 'LINE-BREAK)
+ t t line)))
+ (org-export-preserve-breaks
+ (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
+
+ ;; Check if a paragraph should be started
+ (let ((start 0))
+ (while (and org-lparse-par-open
+ (string-match "\\\\par\\>" line start))
+ (error "FIXME")
+ ;; Leave a space in the </p> so that the footnote matcher
+ ;; does not see this.
+ (if (not (get-text-property (match-beginning 0)
+ 'org-protected line))
+ (setq line (replace-match "</p ><p >" t t line)))
+ (setq start (match-end 0))))
+
+ (org-lparse-insert 'LINE line)))))
+
+ ;; Properly close all local lists and other lists
+ (when (org-lparse-current-environment-p 'quote)
+ (org-lparse-end-environment 'quote))
+
+ (org-lparse-end-level 1 umax)
+
+ ;; the </div> to close the last text-... div.
+ (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
+ (org-lparse-end-outline-text-or-outline))
+
+ (org-lparse-end 'DOCUMENT-BODY opt-plist)
+ (unless body-only
+ (org-lparse-end 'DOCUMENT-CONTENT))
+
+ (org-lparse-end 'EXPORT)
+
+ ;; kill collection buffer
+ (when org-lparse-collect-buffer
+ (kill-buffer org-lparse-collect-buffer))
+
+ (goto-char (point-min))
+ (or (org-export-push-to-kill-ring
+ (upcase (symbol-name org-lparse-backend)))
+ (message "Exporting... done"))
+
+ (cond
+ ((not to-buffer)
+ (let ((f (org-lparse-get 'SAVE-METHOD)))
+ (or (and f (functionp f) (funcall f filename opt-plist))
+ (save-buffer)))
+ (or (and (boundp 'org-lparse-other-backend)
+ org-lparse-other-backend
+ (not (equal org-lparse-backend org-lparse-other-backend))
+ (org-lparse-do-convert
+ buffer-file-name (symbol-name org-lparse-other-backend)))
+ (current-buffer)))
+ ((eq to-buffer 'string)
+ (prog1 (buffer-substring (point-min) (point-max))
+ (kill-buffer (current-buffer))))
+ (t (current-buffer))))))
+
+(defun org-lparse-format-table (lines olines)
+ "Returns backend-specific code for org-type and table-type tables."
+ (if (stringp lines)
+ (setq lines (org-split-string lines "\n")))
+ (if (string-match "^[ \t]*|" (car lines))
+ ;; A normal org table
+ (org-lparse-format-org-table lines nil)
+ ;; Table made by table.el
+ (or (org-lparse-format-table-table-using-table-generate-source
+ ;; FIXME: Need to take care of this during merge
+ (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend)
+ olines
+ (not org-export-prefer-native-exporter-for-tables))
+ ;; We are here only when table.el table has NO col or row
+ ;; spanning and the user prefers using org's own converter for
+ ;; exporting of such simple table.el tables.
+ (org-lparse-format-table-table lines))))
+
+(defun org-lparse-table-get-colalign-info (lines)
+ (let ((col-cookies (org-find-text-property-in-string
+ 'org-col-cookies (car lines))))
+ (when (and col-cookies org-table-clean-did-remove-column)
+ (setq col-cookies
+ (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
+ col-cookies))
+
+(defvar org-lparse-table-style)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-num-numeric-items-per-column)
+(defvar org-lparse-table-colalign-info)
+(defvar org-lparse-table-colalign-vector)
+
+;; Following variables are defined in org-table.el
+(defvar org-table-number-fraction)
+(defvar org-table-number-regexp)
+(defun org-lparse-org-table-to-list-table (lines &optional splice)
+ "Convert org-table to list-table.
+LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
+element is a `string' representing a single row of org-table.
+Thus each ROW has vertical separators \"|\" separating the table
+fields. A ROW could also be a row-group separator of the form
+\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
+...). ROW could either be symbol `:hrule' or a list of the
+form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
+ (let (line lines-1)
+ (cond
+ (splice
+ (while (setq line (pop lines))
+ (unless (string-match "^[ \t]*|-" line)
+ (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))
+ (t
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*|-" line)
+ (when lines
+ (push :hrule lines-1)))
+ (t
+ (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))))
+ (nreverse lines-1)))
+
+(defun org-lparse-insert-org-table (lines &optional splice)
+ "Format a org-type table into backend-specific code.
+LINES is a list of lines. Optional argument SPLICE means, do not
+insert header and surrounding <table> tags, just format the lines.
+Optional argument NO-CSS means use XHTML attributes instead of CSS
+for formatting. This is required for the DocBook exporter."
+ (require 'org-table)
+ ;; Get rid of hlines at beginning and end
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
+ (setq lines (nreverse lines))
+ (when org-export-table-remove-special-lines
+ ;; Check if the table has a marking column. If yes remove the
+ ;; column and the special lines
+ (setq lines (org-table-clean-before-export lines)))
+ (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
+ (short-caption (or (org-find-text-property-in-string
+ 'org-caption-shortn (car lines)) caption))
+ (caption (and caption (org-xml-encode-org-text caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
+ (label (org-find-text-property-in-string 'org-label (car lines)))
+ (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
+ (attributes (org-find-text-property-in-string 'org-attributes
+ (car lines)))
+ (head (and org-export-highlight-first-table-line
+ (delq nil (mapcar
+ (lambda (x) (string-match "^[ \t]*|-" x))
+ (cdr lines))))))
+ (setq lines (org-lparse-org-table-to-list-table lines splice))
+ (org-lparse-insert-list-table
+ lines splice caption label attributes head org-lparse-table-colalign-info
+ short-caption)))
+
+(defun org-lparse-insert-list-table (lines &optional splice
+ caption label attributes head
+ org-lparse-table-colalign-info
+ short-caption)
+ (or (featurep 'org-table) ; required for
+ (require 'org-table)) ; `org-table-number-regexp'
+ (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
+ tbopen fields line
+ org-lparse-table-cur-rowgrp-is-hdr
+ org-lparse-table-rowgrp-open
+ org-lparse-table-num-numeric-items-per-column
+ org-lparse-table-colalign-vector n
+ org-lparse-table-rowgrp-info
+ org-lparse-table-begin-marker
+ (org-lparse-table-style 'org-table)
+ org-lparse-table-is-styled)
+ (cond
+ (splice
+ (setq org-lparse-table-is-styled nil)
+ (while (setq line (pop lines))
+ (insert (org-lparse-format-table-row line) "\n")))
+ (t
+ (setq org-lparse-table-is-styled t)
+ (org-lparse-begin 'TABLE caption label attributes short-caption)
+ (setq org-lparse-table-begin-marker (point))
+ (org-lparse-begin-table-rowgroup head)
+ (while (setq line (pop lines))
+ (cond
+ ((equal line :hrule)
+ (org-lparse-begin-table-rowgroup))
+ (t
+ (insert (org-lparse-format-table-row line) "\n"))))
+ (org-lparse-end 'TABLE-ROWGROUP)
+ (org-lparse-end-table)))))
+
+(defun org-lparse-format-org-table (lines &optional splice)
+ (with-temp-buffer
+ (org-lparse-insert-org-table lines splice)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-format-list-table (lines &optional splice)
+ (with-temp-buffer
+ (org-lparse-insert-list-table lines splice)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defun org-lparse-insert-table-table (lines)
+ "Format a table generated by table.el into backend-specific code.
+This conversion does *not* use `table-generate-source' from table.el.
+This has the advantage that Org-mode's HTML conversions can be used.
+But it has the disadvantage, that no cell- or row-spanning is allowed."
+ (let (line field-buffer
+ (org-lparse-table-cur-rowgrp-is-hdr
+ org-export-highlight-first-table-line)
+ (caption nil)
+ (short-caption nil)
+ (attributes nil)
+ (label nil)
+ (org-lparse-table-style 'table-table)
+ (org-lparse-table-is-styled nil)
+ fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
+ (empty (org-lparse-format 'SPACES 1)))
+ (org-lparse-begin 'TABLE caption label attributes short-caption)
+ (while (setq line (pop lines))
+ (cond
+ ((string-match "^[ \t]*\\+-" line)
+ (when field-buffer
+ (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
+ ;; (org-export-html-table-use-header-tags-for-first-column nil)
+ )
+ (insert (org-lparse-format-table-row field-buffer empty)))
+ (setq org-lparse-table-cur-rowgrp-is-hdr nil)
+ (setq field-buffer nil)))
+ (t
+ ;; Break the line into fields and store the fields
+ (setq fields (org-split-string line "[ \t]*|[ \t]*"))
+ (if field-buffer
+ (setq field-buffer (mapcar
+ (lambda (x)
+ (concat x (org-lparse-format 'LINE-BREAK)
+ (pop fields)))
+ field-buffer))
+ (setq field-buffer fields)))))
+ (org-lparse-end-table)))
+
+(defun org-lparse-format-table-table (lines)
+ (with-temp-buffer
+ (org-lparse-insert-table-table lines)
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+(defvar table-source-languages) ; defined in table.el
+(defun org-lparse-format-table-table-using-table-generate-source (backend
+ lines
+ &optional
+ spanned-only)
+ "Format a table into BACKEND, using `table-generate-source' from table.el.
+Use SPANNED-ONLY to suppress exporting of simple table.el tables.
+
+When SPANNED-ONLY is nil, all table.el tables are exported. When
+SPANNED-ONLY is non-nil, only tables with either row or column
+spans are exported.
+
+This routine returns the generated source or nil as appropriate.
+
+Refer docstring of `org-export-prefer-native-exporter-for-tables'
+for further information."
+ (require 'table)
+ (with-current-buffer (get-buffer-create " org-tmp1 ")
+ (erase-buffer)
+ (insert (mapconcat 'identity lines "\n"))
+ (goto-char (point-min))
+ (if (not (re-search-forward "|[^+]" nil t))
+ (error "Error processing table"))
+ (table-recognize-table)
+ (when (or (not spanned-only)
+ (let* ((dim (table-query-dimension))
+ (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
+ (not (= (* c r) cells))))
+ (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
+ (cond
+ ((member backend table-source-languages)
+ (table-generate-source backend " org-tmp2 ")
+ (set-buffer " org-tmp2 ")
+ (buffer-substring (point-min) (point-max)))
+ (t
+ ;; table.el doesn't support the given backend. Currently this
+ ;; happens in case of odt export. Strip the table from the
+ ;; generated document. A better alternative would be to embed
+ ;; the table as ascii text in the output document.
+ (org-lparse-warn
+ (concat
+ "Found table.el-type table in the source org file. "
+ (format "table.el doesn't support %s backend. "
+ (upcase (symbol-name backend)))
+ "Skipping ahead ..."))
+ "")))))
+
+(defun org-lparse-handle-time-stamps (s)
+ "Format time stamps in string S, or remove them."
+ (catch 'exit
+ (let (r b)
+ (when org-maybe-keyword-time-regexp
+ (while (string-match org-maybe-keyword-time-regexp s)
+ (or b (setq b (substring s 0 (match-beginning 0))))
+ (setq r (concat
+ r (substring s 0 (match-beginning 0)) " "
+ (org-lparse-format
+ 'FONTIFY
+ (concat
+ (if (match-end 1)
+ (org-lparse-format
+ 'FONTIFY
+ (match-string 1 s) "timestamp-kwd"))
+ " "
+ (org-lparse-format
+ 'FONTIFY
+ (substring (org-translate-time (match-string 3 s)) 1 -1)
+ "timestamp"))
+ "timestamp-wrapper"))
+ s (substring s (match-end 0)))))
+
+ ;; Line break if line started and ended with time stamp stuff
+ (if (not r)
+ s
+ (setq r (concat r s))
+ (unless (string-match "\\S-" (concat b s))
+ (setq r (concat r (org-lparse-format 'LINE-BREAK))))
+ r))))
+
+(defun org-xml-encode-plain-text (s)
+ "Convert plain text characters to HTML equivalent.
+Possible conversions are set in `org-export-html-protect-char-alist'."
+ (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
+ (while (setq c (pop cl))
+ (let ((start 0))
+ (while (string-match (car c) s start)
+ (setq s (replace-match (cdr c) t t s)
+ start (1+ (match-beginning 0))))))
+ s))
+
+(defun org-xml-encode-org-text-skip-links (string)
+ "Prepare STRING for HTML export. Apply all active conversions.
+If there are links in the string, don't modify these. If STRING
+is nil, return nil."
+ (when string
+ (let* ((re (concat org-bracket-link-regexp "\\|"
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
+ m s l res)
+ (while (setq m (string-match re string))
+ (setq s (substring string 0 m)
+ l (match-string 0 string)
+ string (substring string (match-end 0)))
+ (push (org-xml-encode-org-text s) res)
+ (push l res))
+ (push (org-xml-encode-org-text string) res)
+ (apply 'concat (nreverse res)))))
+
+(defun org-xml-encode-org-text (s)
+ "Apply all active conversions to translate special ASCII to HTML."
+ (setq s (org-xml-encode-plain-text s))
+ (if org-export-html-expand
+ (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
+ (setq s (replace-match "<\\1>" t nil s))))
+ (if org-export-with-emphasize
+ (setq s (org-lparse-apply-char-styles s)))
+ (if org-export-with-special-strings
+ (setq s (org-lparse-convert-special-strings s)))
+ (if org-export-with-sub-superscripts
+ (setq s (org-lparse-apply-sub-superscript-styles s)))
+ (if org-export-with-TeX-macros
+ (let ((start 0) wd rep)
+ (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
+ s start))
+ (if (get-text-property (match-beginning 0) 'org-protected s)
+ (setq start (match-end 0))
+ (setq wd (match-string 1 s))
+ (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
+ (setq s (replace-match rep t t s))
+ (setq start (+ start (length wd))))))))
+ s)
+
+(defun org-lparse-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (if (get-text-property (match-beginning 0) 'org-protected string)
+ (setq start (match-end 0))
+ (setq string (replace-match rpl t nil string)))))
+ string))
+
+(defun org-lparse-apply-sub-superscript-styles (string)
+ "Apply subscript and superscript styles to STRING.
+Use `org-export-with-sub-superscripts' to control application of
+sub and superscript styles."
+ (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
+ (while (string-match org-match-substring-regexp string s)
+ (cond
+ ((and requireb (match-end 8)) (setq s (match-end 2)))
+ ((get-text-property (match-beginning 2) 'org-protected string)
+ (setq s (match-end 2)))
+ (t
+ (setq s (match-end 1)
+ key (if (string= (match-string 2 string) "_")
+ 'subscript 'superscript)
+ c (or (match-string 8 string)
+ (match-string 6 string)
+ (match-string 5 string))
+ string (replace-match
+ (concat (match-string 1 string)
+ (org-lparse-format 'FONTIFY c key))
+ t t string)))))
+ (while (string-match "\\\\\\([_^]\\)" string)
+ (setq string (replace-match (match-string 1 string) t t string)))
+ string))
+
+(defvar org-lparse-char-styles
+ `(("*" bold)
+ ("/" emphasis)
+ ("_" underline)
+ ("=" code)
+ ("~" verbatim)
+ ("+" strike))
+ "Map Org emphasis markers to char styles.
+This is an alist where each element is of the
+form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
+
+(defun org-lparse-apply-char-styles (string)
+ "Apply char styles to STRING.
+The variable `org-lparse-char-styles' controls how the Org
+emphasis markers are interpreted."
+ (let ((s 0) rpl)
+ (while (string-match org-emph-re string s)
+ (if (not (equal
+ (substring string (match-beginning 3) (1+ (match-beginning 3)))
+ (substring string (match-beginning 4) (1+ (match-beginning 4)))))
+ (setq s (match-beginning 0)
+ rpl
+ (concat
+ (match-string 1 string)
+ (org-lparse-format
+ 'FONTIFY (match-string 4 string)
+ (nth 1 (assoc (match-string 3 string)
+ org-lparse-char-styles)))
+ (match-string 5 string))
+ string (replace-match rpl t t string)
+ s (+ s (- (length rpl) 2)))
+ (setq s (1+ s))))
+ string))
+
+(defun org-lparse-export-list-line (line pos struct prevs)
+ "Insert list syntax in export buffer. Return LINE, maybe modified.
+
+POS is the item position or line position the line had before
+modifications to buffer. STRUCT is the list structure. PREVS is
+the alist of previous items."
+ (let* ((get-type
+ (function
+ ;; Translate type of list containing POS to "d", "o" or
+ ;; "u".
+ (lambda (pos struct prevs)
+ (let ((type (org-list-get-list-type pos struct prevs)))
+ (cond
+ ((eq 'ordered type) "o")
+ ((eq 'descriptive type) "d")
+ (t "u"))))))
+ (get-closings
+ (function
+ ;; Return list of all items and sublists ending at POS, in
+ ;; reverse order.
+ (lambda (pos)
+ (let (out)
+ (catch 'exit
+ (mapc (lambda (e)
+ (let ((end (nth 6 e))
+ (item (car e)))
+ (cond
+ ((= end pos) (push item out))
+ ((>= item pos) (throw 'exit nil)))))
+ struct))
+ out)))))
+ ;; First close any previous item, or list, ending at POS.
+ (mapc (lambda (e)
+ (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
+ (first-item (org-list-get-list-begin e struct prevs))
+ (type (funcall get-type first-item struct prevs)))
+ (org-lparse-end-paragraph)
+ ;; Ending for every item
+ (org-lparse-end-list-item-1 type)
+ ;; We're ending last item of the list: end list.
+ (when lastp
+ (org-lparse-end-list type)
+ (org-lparse-begin-paragraph))))
+ (funcall get-closings pos))
+ (cond
+ ;; At an item: insert appropriate tags in export buffer.
+ ((assq pos struct)
+ (string-match
+ (concat "[ \t]*\\(\\S-+[ \t]*\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
+ "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
+ "\\(.*\\)") line)
+ (let* ((checkbox (match-string 3 line))
+ (desc-tag (or (match-string 4 line) "???"))
+ (body (or (match-string 5 line) ""))
+ (list-beg (org-list-get-list-begin pos struct prevs))
+ (firstp (= list-beg pos))
+ ;; Always refer to first item to determine list type, in
+ ;; case list is ill-formed.
+ (type (funcall get-type list-beg struct prevs))
+ (counter (let ((count-tmp (org-list-get-counter pos struct)))
+ (cond
+ ((not count-tmp) nil)
+ ((string-match "[A-Za-z]" count-tmp)
+ (- (string-to-char (upcase count-tmp)) 64))
+ ((string-match "[0-9]+" count-tmp)
+ count-tmp)))))
+ (when firstp
+ (org-lparse-end-paragraph)
+ (org-lparse-begin-list type))
+
+ (let ((arg (cond ((equal type "d") desc-tag)
+ ((equal type "o") counter))))
+ (org-lparse-begin-list-item type arg))
+
+ ;; If line had a checkbox, some additional modification is required.
+ (when checkbox
+ (setq body
+ (concat
+ (org-lparse-format
+ 'FONTIFY (concat
+ "["
+ (cond
+ ((string-match "X" checkbox) "X")
+ ((string-match " " checkbox)
+ (org-lparse-format 'SPACES 1))
+ (t "-"))
+ "]")
+ 'code)
+ " "
+ body)))
+ ;; Return modified line
+ body))
+ ;; At a list ender: go to next line (side-effects only).
+ ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
+ ;; Not at an item: return line unchanged (side-effects only).
+ (t line))))
+
+(defun org-lparse-bind-local-variables (opt-plist)
+ (mapc (lambda (x)
+ (set (make-local-variable (nth 2 x))
+ (plist-get opt-plist (car x))))
+ org-export-plist-vars))
+
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-footnote-number)
+(defvar org-lparse-footnote-definitions)
+(defvar org-lparse-output-buffer nil
+ "Buffer to which `org-do-lparse' writes to.
+This buffer contains the contents of the to-be-created exported
+document.")
+
+(defcustom org-lparse-debug nil
+ "Enable or Disable logging of `org-lparse' callbacks.
+The parameters passed to the backend-registered ENTITY-CONTROL
+and ENTITY-FORMAT callbacks are logged as comment strings in the
+exported buffer. (org-lparse-format 'COMMENT fmt args) is used
+for logging. Customize this variable only if you are an expert
+user. Valid values of this variable are:
+nil : Disable logging
+control : Log all invocations of `org-lparse-begin' and
+ `org-lparse-end' callbacks.
+format : Log invocations of `org-lparse-format' callbacks.
+t : Log all invocations of `org-lparse-begin', `org-lparse-end'
+ and `org-lparse-format' callbacks,"
+ :group 'org-lparse
+ :type '(choice
+ (const :tag "Disable" nil)
+ (const :tag "Format callbacks" format)
+ (const :tag "Control callbacks" control)
+ (const :tag "Format and Control callbacks" t)))
+
+(defun org-lparse-begin (entity &rest args)
+ "Begin ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
+
+Use (org-lparse-begin 'LIST \"o\") to begin a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
+
+ (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-end (entity &rest args)
+ "Close ENTITY in current buffer. ARGS is entity specific.
+ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
+etc.
+
+Use (org-lparse-end 'LIST \"o\") to close a list in current
+buffer.
+
+See `org-xhtml-entity-control-callbacks-alist' for more
+information."
+ (when (and (member org-lparse-debug '(t control))
+ (not (eq entity 'DOCUMENT-CONTENT)))
+ (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
+
+ (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))
+
+(defun org-lparse-begin-paragraph (&optional style)
+ "Insert <p>, but first close previous paragraph if any."
+ (org-lparse-end-paragraph)
+ (org-lparse-begin 'PARAGRAPH style)
+ (setq org-lparse-par-open t))
+
+(defun org-lparse-end-paragraph ()
+ "Close paragraph if there is one open."
+ (when org-lparse-par-open
+ (org-lparse-end 'PARAGRAPH)
+ (setq org-lparse-par-open nil)))
+
+(defun org-lparse-end-list-item-1 (&optional type)
+ "Close <li> if necessary."
+ (org-lparse-end-paragraph)
+ (org-lparse-end-list-item (or type "u")))
+
+(define-obsolete-function-alias
+ 'org-lparse-preprocess-after-blockquote-hook
+ 'org-lparse-preprocess-after-blockquote
+ "24.3")
+
+(defun org-lparse-preprocess-after-blockquote ()
+ "Treat `org-lparse-special-blocks' specially."
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t)
+ (when (member (downcase (match-string 2)) org-lparse-special-blocks)
+ (replace-match
+ (if (equal (downcase (match-string 1)) "begin")
+ (format "ORG-%s-START %s" (upcase (match-string 2))
+ (match-string 3))
+ (format "ORG-%s-END %s" (upcase (match-string 2))
+ (match-string 3))) t t))))
+
+(define-obsolete-function-alias
+ 'org-lparse-strip-experimental-blocks-maybe-hook
+ 'org-lparse-strip-experimental-blocks-maybe
+ "24.3")
+
+(defun org-lparse-strip-experimental-blocks-maybe ()
+ "Strip \"list-table\" and \"annotation\" blocks.
+Stripping happens only when the exported backend is not one of
+\"odt\" or \"xhtml\"."
+ (when (not org-lparse-backend)
+ (message "Stripping following blocks - %S" org-lparse-special-blocks)
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (while
+ (re-search-forward
+ "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*"
+ nil t)
+ (when (member (match-string 1) org-lparse-special-blocks)
+ (replace-match "" t t))))))
+
+(defvar org-lparse-list-table-p nil
+ "Non-nil if `org-do-lparse' is within a list-table.")
+
+(defvar org-lparse-dyn-current-environment nil)
+(defun org-lparse-begin-environment (style &optional env-options-plist)
+ (case style
+ (list-table
+ (setq org-lparse-list-table-p t))
+ (t (setq org-lparse-dyn-current-environment style)
+ (org-lparse-begin 'ENVIRONMENT style env-options-plist))))
+
+(defun org-lparse-end-environment (style &optional env-options-plist)
+ (case style
+ (list-table
+ (setq org-lparse-list-table-p nil))
+ (t (org-lparse-end 'ENVIRONMENT style env-options-plist)
+ (setq org-lparse-dyn-current-environment nil))))
+
+(defun org-lparse-current-environment-p (style)
+ (eq org-lparse-dyn-current-environment style))
+
+(defun org-lparse-begin-footnote-definition (n)
+ (org-lparse-begin-collect)
+ (setq org-lparse-insert-tag-with-newlines nil)
+ (org-lparse-begin 'FOOTNOTE-DEFINITION n))
+
+(defun org-lparse-end-footnote-definition (n)
+ (org-lparse-end 'FOOTNOTE-DEFINITION n)
+ (setq org-lparse-insert-tag-with-newlines 'both)
+ (let ((footnote-def (org-lparse-end-collect)))
+ ;; Cleanup newlines in footnote definition. This ensures that a
+ ;; transcoded line is never (wrongly) broken in to multiple lines.
+ (let ((pos 0))
+ (while (string-match "[\r\n]+" footnote-def pos)
+ (setq pos (1+ (match-beginning 0)))
+ (setq footnote-def (replace-match " " t t footnote-def))))
+ (push (cons n footnote-def) org-lparse-footnote-definitions)))
+
+(defvar org-lparse-collect-buffer nil
+ "An auxiliary buffer named \"*Org Lparse Collect*\".
+`org-do-lparse' uses this as output buffer while collecting
+footnote definitions and table-cell contents of list-tables. See
+`org-lparse-begin-collect' and `org-lparse-end-collect'.")
+
+(defvar org-lparse-collect-count nil
+ "Count number of calls to `org-lparse-begin-collect'.
+Use this counter to catch chained collections if they ever
+happen.")
+
+(defun org-lparse-begin-collect ()
+ "Temporarily switch to `org-lparse-collect-buffer'.
+Also erase it's contents."
+ (unless (zerop org-lparse-collect-count)
+ (error "FIXME (org-lparse.el): Encountered chained collections"))
+ (incf org-lparse-collect-count)
+ (unless org-lparse-collect-buffer
+ (setq org-lparse-collect-buffer
+ (get-buffer-create "*Org Lparse Collect*")))
+ (set-buffer org-lparse-collect-buffer)
+ (erase-buffer))
+
+(defun org-lparse-end-collect ()
+ "Switch to `org-lparse-output-buffer'.
+Return contents of `org-lparse-collect-buffer' as a `string'."
+ (assert (> org-lparse-collect-count 0))
+ (decf org-lparse-collect-count)
+ (prog1 (buffer-string)
+ (erase-buffer)
+ (set-buffer org-lparse-output-buffer)))
+
+(defun org-lparse-format (entity &rest args)
+ "Format ENTITY in backend-specific way and return it.
+ARGS is specific to entity being formatted.
+
+Use (org-lparse-format 'HEADING \"text\" 1) to format text as
+level 1 heading.
+
+See `org-xhtml-entity-format-callbacks-alist' for more information."
+ (when (and (member org-lparse-debug '(t format))
+ (not (equal entity 'COMMENT)))
+ (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
+ (cond
+ ((consp entity)
+ (let ((text (pop args)))
+ (apply 'org-lparse-format 'TAGS entity text args)))
+ (t
+ (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
+ (unless f (error "Unknown entity: %s" entity))
+ (apply f args)))))
+
+(defun org-lparse-insert (entity &rest args)
+ (insert (apply 'org-lparse-format entity args)))
+
+(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
+ (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
+ (org-min-level (org-get-min-level lines level-offset))
+ (org-last-level org-min-level)
+ level)
+ (with-temp-buffer
+ (org-lparse-bind-local-variables opt-plist)
+ (erase-buffer)
+ (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc)
+ (setq
+ lines
+ (mapcar
+ #'(lambda (line)
+ (when (and (string-match org-todo-line-regexp line)
+ (not (get-text-property 0 'org-protected line))
+ (<= (setq level (org-tr-level
+ (- (match-end 1) (match-beginning 1)
+ level-offset)))
+ umax-toc))
+ (let ((txt (save-match-data
+ (org-xml-encode-org-text-skip-links
+ (org-export-cleanup-toc-line
+ (match-string 3 line)))))
+ (todo (and
+ org-export-mark-todo-in-toc
+ (or (and (match-beginning 2)
+ (not (member (match-string 2 line)
+ org-done-keywords)))
+ (and (= level umax-toc)
+ (org-search-todo-below
+ line lines level)))))
+ tags)
+ ;; Check for targets
+ (while (string-match org-any-target-regexp line)
+ (setq line
+ (replace-match
+ (let ((org-lparse-encode-pending t))
+ (org-lparse-format 'FONTIFY
+ (match-string 1 line) "target"))
+ t t line)))
+ (when (string-match
+ (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
+ (setq tags (match-string 1 txt)
+ txt (replace-match "" t nil txt)))
+ (when (string-match quote-re0 txt)
+ (setq txt (replace-match "" t t txt)))
+ (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
+ (setq txt (replace-match "" t t txt)))
+ (org-lparse-format
+ 'TOC-ITEM
+ (let* ((snumber (org-section-number level))
+ (href (replace-regexp-in-string
+ "\\." "-" (format "sec-%s" snumber)))
+ (href
+ (or
+ (cdr (assoc
+ href org-export-preferred-target-alist))
+ href))
+ (href (org-solidify-link-text href)))
+ (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
+ level org-last-level)
+ (setq org-last-level level)))
+ line)
+ lines))
+ (org-lparse-end 'TOC)
+ (setq org-lparse-toc (buffer-string))))
+ lines)
+
+(defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
+ (if org-lparse-table-ncols
+ ;; second and subsequent rows of the table
+ (when (and org-lparse-list-table-p
+ (> (length fields) org-lparse-table-ncols))
+ (error "Table row has %d columns but header row claims %d columns"
+ (length fields) org-lparse-table-ncols))
+ ;; first row of the table
+ (setq org-lparse-table-ncols (length fields))
+ (when org-lparse-table-is-styled
+ (setq org-lparse-table-num-numeric-items-per-column
+ (make-vector org-lparse-table-ncols 0))
+ (setq org-lparse-table-colalign-vector
+ (make-vector org-lparse-table-ncols nil))
+ (let ((c -1))
+ (while (< (incf c) org-lparse-table-ncols)
+ (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info)))
+ (align (nth 0 col-cookie)))
+ (setf (aref org-lparse-table-colalign-vector c)
+ (cond
+ ((string= align "l") "left")
+ ((string= align "r") "right")
+ ((string= align "c") "center"))))))))
+ (incf org-lparse-table-rownum)
+ (let ((i -1))
+ (org-lparse-format
+ 'TABLE-ROW
+ (mapconcat
+ (lambda (x)
+ (when (and (string= x "") text-for-empty-fields)
+ (setq x text-for-empty-fields))
+ (incf i)
+ (let (col-cookie horiz-span)
+ (when org-lparse-table-is-styled
+ (when (and (< i org-lparse-table-ncols)
+ (string-match org-table-number-regexp x))
+ (incf (aref org-lparse-table-num-numeric-items-per-column i)))
+ (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info))
+ horiz-span (nth 1 col-cookie)))
+ (org-lparse-format
+ 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0))))
+ fields "\n"))))
+
+(defun org-lparse-get (what &optional opt-plist)
+ "Query for value of WHAT for the current backend `org-lparse-backend'.
+See also `org-lparse-backend-get'."
+ (if (boundp 'org-lparse-backend)
+ (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
+ (error "org-lparse-backend is not bound yet")))
+
+(defun org-lparse-backend-get (backend what &optional opt-plist)
+ "Query BACKEND for value of WHAT.
+Dispatch the call to `org-<backend>-user-get'. If that throws an
+error, dispatch the call to `org-<backend>-get'. See
+`org-xhtml-get' for all known settings queried for by
+`org-lparse' during the course of export."
+ (assert (stringp backend) t)
+ (unless (org-lparse-backend-is-native-p backend)
+ (error "Unknown native backend %s" backend))
+ (let ((backend-get-method (intern (format "org-%s-get" backend)))
+ (backend-user-get-method (intern (format "org-%s-user-get" backend))))
+ (cond
+ ((functionp backend-get-method)
+ (condition-case nil
+ (funcall backend-user-get-method what opt-plist)
+ (error (funcall backend-get-method what opt-plist))))
+ (t
+ (error "Native backend %s doesn't define %s" backend backend-get-method)))))
+
+(defun org-lparse-insert-tag (tag &rest args)
+ (when (member org-lparse-insert-tag-with-newlines '(lead both))
+ (insert "\n"))
+ (insert (apply 'format tag args))
+ (when (member org-lparse-insert-tag-with-newlines '(trail both))
+ (insert "\n")))
+
+(defun org-lparse-get-targets-from-title (title)
+ (let* ((target (org-get-text-property-any 0 'target title))
+ (extra-targets (assoc target org-export-target-aliases))
+ (target (or (cdr (assoc target org-export-preferred-target-alist))
+ target)))
+ (cons target (remove target extra-targets))))
+
+(defun org-lparse-suffix-from-snumber (snumber)
+ (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
+ (href (cdr (assoc (concat "sec-" snu)
+ org-export-preferred-target-alist))))
+ (org-solidify-link-text (or href snu))))
+
+(defun org-lparse-begin-level (level title umax head-count)
+ "Insert a new LEVEL in HTML export.
+When TITLE is nil, just close all open levels."
+ (org-lparse-end-level level umax)
+ (unless title (error "Why is heading nil"))
+ (let* ((targets (org-lparse-get-targets-from-title title))
+ (target (car targets)) (extra-targets (cdr targets))
+ (target (and target (org-solidify-link-text target)))
+ (extra-class (org-get-text-property-any 0 'html-container-class title))
+ snumber tags level1 class)
+ (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
+ (setq tags (and org-export-with-tags (match-string 1 title)))
+ (setq title (replace-match "" t t title)))
+ (if (> level umax)
+ (progn
+ (if (aref org-levels-open (1- level))
+ (org-lparse-end-list-item-1)
+ (aset org-levels-open (1- level) t)
+ (org-lparse-end-paragraph)
+ (org-lparse-begin-list 'unordered))
+ (org-lparse-begin-list-item
+ 'unordered target (org-lparse-format
+ 'HEADLINE title extra-targets tags)))
+ (aset org-levels-open (1- level) t)
+ (setq snumber (org-section-number level))
+ (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
+ (unless (= head-count 1)
+ (org-lparse-end-outline-text-or-outline))
+ (org-lparse-begin-outline-and-outline-text
+ level1 snumber title tags target extra-targets extra-class)
+ (org-lparse-begin-paragraph))))
+
+(defun org-lparse-end-level (level umax)
+ (org-lparse-end-paragraph)
+ (loop for l from org-level-max downto level
+ do (when (aref org-levels-open (1- l))
+ ;; Terminate one level in HTML export
+ (if (<= l umax)
+ (org-lparse-end-outline-text-or-outline)
+ (org-lparse-end-list-item-1)
+ (org-lparse-end-list 'unordered))
+ (aset org-levels-open (1- l) nil))))
+
+(defvar org-lparse-outline-text-open)
+(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
+ target extra-targets
+ extra-class)
+ (org-lparse-begin
+ 'OUTLINE level1 snumber title tags target extra-targets extra-class)
+ (org-lparse-begin-outline-text level1 snumber extra-class))
+
+(defun org-lparse-end-outline-text-or-outline ()
+ (cond
+ (org-lparse-outline-text-open
+ (org-lparse-end 'OUTLINE-TEXT)
+ (setq org-lparse-outline-text-open nil))
+ (t (org-lparse-end 'OUTLINE))))
+
+(defun org-lparse-begin-outline-text (level1 snumber extra-class)
+ (assert (not org-lparse-outline-text-open) t)
+ (setq org-lparse-outline-text-open t)
+ (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
+
+(defun org-lparse-html-list-type-to-canonical-list-type (ltype)
+ (cdr (assoc ltype '(("o" . ordered)
+ ("u" . unordered)
+ ("d" . description)))))
+
+;; following vars are bound during `org-do-lparse'
+(defvar org-lparse-list-stack)
+(defvar org-lparse-list-table:table-row)
+(defvar org-lparse-list-table:lines)
+
+;; Notes on LIST-TABLES
+;; ====================
+;; Lists withing "list-table" blocks (as shown below)
+;;
+;; #+begin_list-table
+;; - Row 1
+;; - 1.1
+;; - 1.2
+;; - 1.3
+;; - Row 2
+;; - 2.1
+;; - 2.2
+;; - 2.3
+;; #+end_list-table
+;;
+;; will be exported as though it were a table as shown below.
+;;
+;; | Row 1 | 1.1 | 1.2 | 1.3 |
+;; | Row 2 | 2.1 | 2.2 | 2.3 |
+;;
+;; Note that org-tables are NOT multi-line and each line is mapped to
+;; a unique row in the exported document. So if an exported table
+;; needs to contain a single paragraph (with copious text) it needs to
+;; be typed up in a single line. Editing such long lines using the
+;; table editor will be a cumbersome task. Furthermore inclusion of
+;; multi-paragraph text in a table cell is well-nigh impossible.
+;;
+;; LIST-TABLEs are meant to circumvent the above problems with
+;; org-tables.
+;;
+;; Note that in the example above the list items could be paragraphs
+;; themselves and the list can be arbitrarily deep.
+;;
+;; Inspired by following thread:
+;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
+
+(defun org-lparse-begin-list (ltype)
+ (push ltype org-lparse-list-stack)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-begin 'LIST ltype))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; begin LIST-TABLE
+ (setq org-lparse-list-table:lines nil)
+ (setq org-lparse-list-table:table-row nil))
+ ((= 2 list-level)
+ (ignore))
+ (t
+ (org-lparse-begin 'LIST ltype)))))
+
+(defun org-lparse-end-list (ltype)
+ (pop org-lparse-list-stack)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-end 'LIST ltype))
+ ;; process LIST-TABLE
+ ((= 0 list-level)
+ ;; end LIST-TABLE
+ (insert (org-lparse-format-list-table
+ (nreverse org-lparse-list-table:lines))))
+ ((= 1 list-level)
+ (ignore))
+ (t
+ (org-lparse-end 'LIST ltype)))))
+
+(defun org-lparse-begin-list-item (ltype &optional arg headline)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-begin 'LIST-ITEM ltype arg headline))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; begin TABLE-ROW for LIST-TABLE
+ (setq org-lparse-list-table:table-row nil)
+ (org-lparse-begin-list-table:table-cell))
+ ((= 2 list-level)
+ ;; begin TABLE-CELL for LIST-TABLE
+ (org-lparse-begin-list-table:table-cell))
+ (t
+ (org-lparse-begin 'LIST-ITEM ltype arg headline)))))
+
+(defun org-lparse-end-list-item (ltype)
+ (let ((list-level (length org-lparse-list-stack)))
+ (cond
+ ((not org-lparse-list-table-p)
+ (org-lparse-end 'LIST-ITEM ltype))
+ ;; process LIST-TABLE
+ ((= 1 list-level)
+ ;; end TABLE-ROW for LIST-TABLE
+ (org-lparse-end-list-table:table-cell)
+ (push (nreverse org-lparse-list-table:table-row)
+ org-lparse-list-table:lines))
+ ((= 2 list-level)
+ ;; end TABLE-CELL for LIST-TABLE
+ (org-lparse-end-list-table:table-cell))
+ (t
+ (org-lparse-end 'LIST-ITEM ltype)))))
+
+(defvar org-lparse-list-table:table-cell-open)
+(defun org-lparse-begin-list-table:table-cell ()
+ (org-lparse-end-list-table:table-cell)
+ (setq org-lparse-list-table:table-cell-open t)
+ (org-lparse-begin-collect)
+ (org-lparse-begin-paragraph))
+
+(defun org-lparse-end-list-table:table-cell ()
+ (when org-lparse-list-table:table-cell-open
+ (setq org-lparse-list-table:table-cell-open nil)
+ (org-lparse-end-paragraph)
+ (push (org-lparse-end-collect)
+ org-lparse-list-table:table-row)))
+
+(defvar org-lparse-table-rowgrp-info)
+(defun org-lparse-begin-table-rowgroup (&optional is-header-row)
+ (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
+ (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
+
+(defun org-lparse-end-table ()
+ (when org-lparse-table-is-styled
+ ;; column groups
+ (unless (car org-table-colgroup-info)
+ (setq org-table-colgroup-info
+ (cons :start (cdr org-table-colgroup-info))))
+
+ ;; column alignment
+ (let ((c -1))
+ (mapc
+ (lambda (x)
+ (incf c)
+ (setf (aref org-lparse-table-colalign-vector c)
+ (or (aref org-lparse-table-colalign-vector c)
+ (if (> (/ (float x) (1+ org-lparse-table-rownum))
+ org-table-number-fraction)
+ "right" "left"))))
+ org-lparse-table-num-numeric-items-per-column)))
+ (org-lparse-end 'TABLE))
+
+(defvar org-lparse-encode-pending nil)
+
+(defun org-lparse-format-tags (tag text prefix suffix &rest args)
+ (cond
+ ((consp tag)
+ (concat prefix (apply 'format (car tag) args) text suffix
+ (format (cdr tag))))
+ ((stringp tag) ; singleton tag
+ (concat prefix (apply 'format tag args) text))))
+
+(defun org-xml-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword into a valid class name.
+Replaces invalid characters with \"_\"."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ kwd)
+
+(defun org-lparse-format-todo (todo)
+ (org-lparse-format 'FONTIFY
+ (concat
+ (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
+ (org-xml-fix-class-name todo))
+ (list (if (member todo org-done-keywords) "done" "todo")
+ todo)))
+
+(defun org-lparse-format-extra-targets (extra-targets)
+ (if (not extra-targets) ""
+ (mapconcat (lambda (x)
+ (setq x (org-solidify-link-text
+ (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-lparse-format 'ANCHOR "" x))
+ extra-targets "")))
+
+(defun org-lparse-format-org-tags (tags)
+ (if (not tags) ""
+ (org-lparse-format
+ 'FONTIFY (mapconcat
+ (lambda (x)
+ (org-lparse-format
+ 'FONTIFY x
+ (concat
+ (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
+ (org-xml-fix-class-name x))))
+ (org-split-string tags ":")
+ (org-lparse-format 'SPACES 1)) "tag")))
+
+(defun org-lparse-format-section-number (&optional snumber level)
+ (and org-export-with-section-numbers
+ (not org-lparse-body-only) snumber level
+ (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
+
+(defun org-lparse-warn (msg)
+ (if (not org-lparse-use-flashy-warning)
+ (message msg)
+ (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
+ (message msg)
+ (sleep-for 3)))
+
+(defun org-xml-format-href (s)
+ "Make sure the S is valid as a href reference in an XHTML document."
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "&" s start)
+ (setq start (+ (match-beginning 0) 3)
+ s (replace-match "&amp;" t t s)))))
+ s)
+
+(defun org-xml-format-desc (s)
+ "Make sure the S is valid as a description in a link."
+ (if (and s (not (get-text-property 1 'org-protected s)))
+ (save-match-data
+ (org-xml-encode-org-text s))
+ s))
+
+(provide 'org-lparse)
+
+;;; org-lparse.el ends here
diff --git a/lisp/org-mac-message.el b/lisp/org-mac-message.el
new file mode 100644
index 0000000..91866b4
--- /dev/null
+++ b/lisp/org-mac-message.el
@@ -0,0 +1,216 @@
+;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
+
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This file implements links to Apple Mail.app messages from within Org-mode.
+;; Org-mode does not load this module by default - if you would actually like
+;; this to happen then configure the variable `org-modules'.
+
+;; If you would like to create links to all flagged messages in an
+;; Apple Mail.app account, please customize the variable
+;; `org-mac-mail-account' and then call one of the following functions:
+
+;; (org-mac-message-insert-selected) copies a formatted list of links to
+;; the kill ring.
+
+;; (org-mac-message-insert-selected) inserts at point links to any
+;; messages selected in Mail.app.
+
+;; (org-mac-message-insert-flagged) searches within an org-mode buffer
+;; for a specific heading, creating it if it doesn't exist. Any
+;; message:// links within the first level of the heading are deleted
+;; and replaced with links to flagged messages.
+
+;;; Code:
+
+(require 'org)
+
+(defgroup org-mac-flagged-mail nil
+ "Options concerning linking to flagged Mail.app messages."
+ :tag "Org Mail.app"
+ :group 'org-link)
+
+(defcustom org-mac-mail-account "customize"
+ "The Mail.app account in which to search for flagged messages."
+ :group 'org-mac-flagged-mail
+ :type 'string)
+
+(org-add-link-type "message" 'org-mac-message-open)
+
+;; In mac.c, removed in Emacs 23.
+(declare-function do-applescript "org-mac-message" (script))
+(unless (fboundp 'do-applescript)
+ ;; Need to fake this using shell-command-to-string
+ (defun do-applescript (script)
+ (let (start cmd return)
+ (while (string-match "\n" script)
+ (setq script (replace-match "\r" t t script)))
+ (while (string-match "'" script start)
+ (setq start (+ 2 (match-beginning 0))
+ script (replace-match "\\'" t t script)))
+ (setq cmd (concat "osascript -e '" script "'"))
+ (setq return (shell-command-to-string cmd))
+ (concat "\"" (org-trim return) "\""))))
+
+(defun org-mac-message-open (message-id)
+ "Visit the message with the given MESSAGE-ID.
+This will use the command `open' with the message URL."
+ (start-process (concat "open message:" message-id) nil
+ "open" (concat "message://<" (substring message-id 2) ">")))
+
+(defun as-get-selected-mail ()
+ "AppleScript to create links to selected messages in Mail.app."
+ (do-applescript
+ (concat
+ "tell application \"Mail\"\n"
+ "set theLinkList to {}\n"
+ "set theSelection to selection\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
+
+(defun as-get-flagged-mail ()
+ "AppleScript to create links to flagged messages in Mail.app."
+ (do-applescript
+ (concat
+ ;; Is Growl installed?
+ "tell application \"System Events\"\n"
+ "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
+ "if (count of growlHelpers) > 0 then\n"
+ "set growlHelperApp to item 1 of growlHelpers\n"
+ "else\n"
+ "set growlHelperApp to \"\"\n"
+ "end if\n"
+ "end tell\n"
+
+ ;; Get links
+ "tell application \"Mail\"\n"
+ "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
+ "set theLinkList to {}\n"
+ "repeat with aMailbox in theMailboxes\n"
+ "set theSelection to (every message in aMailbox whose flagged status = true)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+
+ ;; Report progress through Growl
+ ;; This "double tell" idiom is described in detail at
+ ;; http://macscripter.net/viewtopic.php?id=24570 The
+ ;; script compiler needs static knowledge of the
+ ;; growlHelperApp. Hmm, since we're compiling
+ ;; on-the-fly here, this is likely to be way less
+ ;; portable than I'd hoped. It'll work when the name
+ ;; is still "GrowlHelperApp", though.
+ "if growlHelperApp is not \"\" then\n"
+ "tell application \"GrowlHelperApp\"\n"
+ "tell application growlHelperApp\n"
+ "set the allNotificationsList to {\"FlaggedMail\"}\n"
+ "set the enabledNotificationsList to allNotificationsList\n"
+ "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
+ "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
+ "end tell\n"
+ "end tell\n"
+ "end if\n"
+ "end repeat\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
+
+(defun org-mac-message-get-links (&optional select-or-flag)
+ "Create links to the messages currently selected or flagged in Mail.app.
+This will use AppleScript to get the message-id and the subject of the
+messages in Mail.app and make a link out of it.
+When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
+the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
+The Org-syntax text will be pushed to the kill ring, and also returned."
+ (interactive "sLink to (s)elected or (f)lagged messages: ")
+ (setq select-or-flag (or select-or-flag "s"))
+ (message "AppleScript: searching mailboxes...")
+ (let* ((as-link-list
+ (if (string= select-or-flag "s")
+ (as-get-selected-mail)
+ (if (string= select-or-flag "f")
+ (as-get-flagged-mail)
+ (error "Please select \"s\" or \"f\""))))
+ (link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+(defun org-mac-message-insert-selected ()
+ "Insert a link to the messages currently selected in Mail.app.
+This will use AppleScript to get the message-id and the subject of the
+active mail in Mail.app and make a link out of it."
+ (interactive)
+ (insert (org-mac-message-get-links "s")))
+
+;; The following line is for backward compatibility
+(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
+
+(defun org-mac-message-insert-flagged (org-buffer org-heading)
+ "Asks for an org buffer and a heading within it, and replace message links.
+If heading exists, delete all message:// links within heading's first
+level. If heading doesn't exist, create it at point-max. Insert
+list of message:// links to flagged mail after heading."
+ (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
+ (with-current-buffer org-buffer
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
+ (if (org-goto-local-search-headings org-heading nil t)
+ (if (not (eobp))
+ (progn
+ (save-excursion
+ (while (re-search-forward
+ message-re (save-excursion (outline-next-heading)) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (flush-lines "^$" (point) (outline-next-heading)))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (goto-char (point-max))
+ (insert "\n")
+ (org-insert-heading nil t)
+ (insert org-heading "\n" (org-mac-message-get-links "f"))))))
+
+(provide 'org-mac-message)
+
+;;; org-mac-message.el ends here
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
new file mode 100644
index 0000000..e999917
--- /dev/null
+++ b/lisp/org-macs.el
@@ -0,0 +1,422 @@
+;;; org-macs.el --- Top-level definitions for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains macro definitions, defsubst definitions, other
+;; stuff needed for compilation and top-level forms in Org-mode, as well
+;; lots of small functions that are not org-mode specific but simply
+;; generally useful stuff.
+
+;;; Code:
+
+(eval-and-compile
+ (unless (fboundp 'declare-function)
+ (defmacro declare-function (fn file &optional arglist fileonly)))
+ (if (>= emacs-major-version 23)
+ (defsubst org-char-to-string(c)
+ "Defsubst to decode UTF-8 character values in emacs 23 and beyond."
+ (char-to-string c))
+ (defsubst org-char-to-string (c)
+ "Defsubst to decode UTF-8 character values in emacs 22."
+ (string (decode-char 'ucs c)))))
+
+(declare-function org-add-props "org-compat" (string plist &rest props))
+(declare-function org-string-match-p "org-compat" (&rest args))
+
+(defmacro org-with-gensyms (symbols &rest body)
+ `(let ,(mapcar (lambda (s)
+ `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols)
+ ,@body))
+(def-edebug-spec org-with-gensyms (sexp body))
+(put 'org-with-gensyms 'lisp-indent-function 1)
+
+(defmacro org-called-interactively-p (&optional kind)
+ (if (featurep 'xemacs)
+ `(interactive-p)
+ (if (or (> emacs-major-version 23)
+ (and (>= emacs-major-version 23)
+ (>= emacs-minor-version 2)))
+ ;; defined with no argument in <=23.1
+ `(with-no-warnings (called-interactively-p ,kind))
+ `(interactive-p))))
+(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
+
+(when (and (not (fboundp 'with-silent-modifications))
+ (or (< emacs-major-version 23)
+ (and (= emacs-major-version 23)
+ (< emacs-minor-version 2))))
+ (defmacro with-silent-modifications (&rest body)
+ `(org-unmodified ,@body))
+ (def-edebug-spec with-silent-modifications (body)))
+
+(defmacro org-bound-and-true-p (var)
+ "Return the value of symbol VAR if it is bound, else nil."
+ `(and (boundp (quote ,var)) ,var))
+(def-edebug-spec org-bound-and-true-p (symbolp))
+
+(defun org-string-nw-p (s)
+ "Is S a string with a non-white character?"
+ (and (stringp s)
+ (org-string-match-p "\\S-" s)
+ s))
+
+(defun org-not-nil (v)
+ "If V not nil, and also not the string \"nil\", then return V.
+Otherwise return nil."
+ (and v (not (equal v "nil")) v))
+
+(defmacro org-unmodified (&rest body)
+ "Execute body without changing `buffer-modified-p'.
+Also, do not record undo information."
+ `(set-buffer-modified-p
+ (prog1 (buffer-modified-p)
+ (let ((buffer-undo-list t)
+ before-change-functions after-change-functions)
+ ,@body))))
+(def-edebug-spec org-unmodified (body))
+
+(defun org-substitute-posix-classes (re)
+ "Substitute posix classes in regular expression RE."
+ (let ((ss re))
+ (save-match-data
+ (while (string-match "\\[:alnum:\\]" ss)
+ (setq ss (replace-match "a-zA-Z0-9" t t ss)))
+ (while (string-match "\\[:word:\\]" ss)
+ (setq ss (replace-match "a-zA-Z0-9" t t ss)))
+ (while (string-match "\\[:alpha:\\]" ss)
+ (setq ss (replace-match "a-zA-Z" t t ss)))
+ (while (string-match "\\[:punct:\\]" ss)
+ (setq ss (replace-match "\001-@[-`{-~" t t ss)))
+ ss)))
+
+(defmacro org-re (s)
+ "Replace posix classes in regular expression."
+ (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
+(def-edebug-spec org-re (form))
+
+(defmacro org-preserve-lc (&rest body)
+ (org-with-gensyms (line col)
+ `(let ((,line (org-current-line))
+ (,col (current-column)))
+ (unwind-protect
+ (progn ,@body)
+ (org-goto-line ,line)
+ (org-move-to-column ,col)))))
+(def-edebug-spec org-preserve-lc (body))
+
+(defmacro org-without-partial-completion (&rest body)
+ `(if (and (boundp 'partial-completion-mode)
+ partial-completion-mode
+ (fboundp 'partial-completion-mode))
+ (unwind-protect
+ (progn
+ (partial-completion-mode -1)
+ ,@body)
+ (partial-completion-mode 1))
+ ,@body))
+(def-edebug-spec org-without-partial-completion (body))
+
+;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
+(defmacro org-maybe-intangible (props)
+ "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22.
+In Emacs 21, invisible text is not avoided by the command loop, so the
+intangible property is needed to make sure point skips this text.
+In Emacs 22, this is not necessary. The intangible text property has
+led to problems with flyspell. These problems are fixed in flyspell.el,
+but we still avoid setting the property in Emacs 22 and later.
+We use a macro so that the test can happen at compilation time."
+ (if (< emacs-major-version 22)
+ `(append '(intangible t) ,props)
+ props))
+
+(defmacro org-with-point-at (pom &rest body)
+ "Move to buffer and point of point-or-marker POM for the duration of BODY."
+ (org-with-gensyms (mpom)
+ `(let ((,mpom ,pom))
+ (save-excursion
+ (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
+ (save-excursion
+ (goto-char (or ,mpom (point)))
+ ,@body)))))
+(def-edebug-spec org-with-point-at (form body))
+(put 'org-with-point-at 'lisp-indent-function 1)
+
+(defmacro org-no-warnings (&rest body)
+ (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+(def-edebug-spec org-no-warnings (body))
+
+(defmacro org-if-unprotected (&rest body)
+ "Execute BODY if there is no `org-protected' text property at point."
+ `(unless (get-text-property (point) 'org-protected)
+ ,@body))
+(def-edebug-spec org-if-unprotected (body))
+
+(defmacro org-if-unprotected-1 (&rest body)
+ "Execute BODY if there is no `org-protected' text property at point-1."
+ `(unless (get-text-property (1- (point)) 'org-protected)
+ ,@body))
+(def-edebug-spec org-if-unprotected-1 (body))
+
+(defmacro org-if-unprotected-at (pos &rest body)
+ "Execute BODY if there is no `org-protected' text property at POS."
+ `(unless (get-text-property ,pos 'org-protected)
+ ,@body))
+(def-edebug-spec org-if-unprotected-at (form body))
+(put 'org-if-unprotected-at 'lisp-indent-function 1)
+
+(defun org-re-search-forward-unprotected (&rest args)
+ "Like re-search-forward, but stop only in unprotected places."
+ (catch 'exit
+ (while t
+ (unless (apply 're-search-forward args)
+ (throw 'exit nil))
+ (unless (get-text-property (match-beginning 0) 'org-protected)
+ (throw 'exit (point))))))
+
+;; FIXME: Normalize argument names
+(defmacro org-with-remote-undo (_buffer &rest _body)
+ "Execute BODY while recording undo information in two buffers."
+ (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
+ `(let ((,cline (org-current-line))
+ (,cmd this-command)
+ (,buf1 (current-buffer))
+ (,buf2 ,_buffer)
+ (,undo1 buffer-undo-list)
+ (,undo2 (with-current-buffer ,_buffer buffer-undo-list))
+ ,c1 ,c2)
+ ,@_body
+ (when org-agenda-allow-remote-undo
+ (setq ,c1 (org-verify-change-for-undo
+ ,undo1 (with-current-buffer ,buf1 buffer-undo-list))
+ ,c2 (org-verify-change-for-undo
+ ,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
+ (when (or ,c1 ,c2)
+ ;; make sure there are undo boundaries
+ (and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
+ (and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
+ ;; remember which buffer to undo
+ (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
+ org-agenda-undo-list))))))
+(def-edebug-spec org-with-remote-undo (form body))
+(put 'org-with-remote-undo 'lisp-indent-function 1)
+
+(defmacro org-no-read-only (&rest body)
+ "Inhibit read-only for BODY."
+ `(let ((inhibit-read-only t)) ,@body))
+(def-edebug-spec org-no-read-only (body))
+
+(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
+ rear-nonsticky t mouse-map t fontified t
+ org-emphasis t)
+ "Properties to remove when a string without properties is wanted.")
+
+(defsubst org-match-string-no-properties (num &optional string)
+ (if (featurep 'xemacs)
+ (let ((s (match-string num string)))
+ (and s (remove-text-properties 0 (length s) org-rm-props s))
+ s)
+ (match-string-no-properties num string)))
+
+(defsubst org-no-properties (s &optional restricted)
+ "Remove all text properties from string S.
+When RESTRICTED is non-nil, only remove the properties listed
+in `org-rm-props'."
+ (if (fboundp 'set-text-properties)
+ (set-text-properties 0 (length s) nil s)
+ (if restricted
+ (remove-text-properties 0 (length s) org-rm-props s)
+ (set-text-properties 0 (length s) nil s)))
+ s)
+
+(defsubst org-get-alist-option (option key)
+ (cond ((eq key t) t)
+ ((eq option t) t)
+ ((assoc key option) (cdr (assoc key option)))
+ (t (cdr (assq 'default option)))))
+
+(defsubst org-check-external-command (cmd &optional use no-error)
+ "Check if external program CMD for USE exists, error if not.
+When the program does exist, return its path.
+When it does not exist and NO-ERROR is set, return nil.
+Otherwise, throw an error. The optional argument USE can describe what this
+program is needed for, so that the error message can be more informative."
+ (or (executable-find cmd)
+ (if no-error
+ nil
+ (error "Can't find `%s'%s" cmd
+ (if use (format " (%s)" use) "")))))
+
+(defsubst org-inhibit-invisibility ()
+ "Modified `buffer-invisibility-spec' for Emacs 21.
+Some ops with invisible text do not work correctly on Emacs 21. For these
+we turn off invisibility temporarily. Use this in a `let' form."
+ (if (< emacs-major-version 22) nil buffer-invisibility-spec))
+
+(defsubst org-set-local (var value)
+ "Make VAR local in current buffer and set it to VALUE."
+ (set (make-local-variable var) value))
+
+(defsubst org-last (list)
+ "Return the last element of LIST."
+ (car (last list)))
+
+(defun org-let (list &rest body)
+ (eval (cons 'let (cons list body))))
+(put 'org-let 'lisp-indent-function 1)
+
+(defun org-let2 (list1 list2 &rest body)
+ (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
+(put 'org-let2 'lisp-indent-function 2)
+
+(defsubst org-call-with-arg (command arg)
+ "Call COMMAND interactively, but pretend prefix arg was ARG."
+ (let ((current-prefix-arg arg)) (call-interactively command)))
+
+(defsubst org-current-line (&optional pos)
+ (save-excursion
+ (and pos (goto-char pos))
+ ;; works also in narrowed buffer, because we start at 1, not point-min
+ (+ (if (bolp) 1 0) (count-lines 1 (point)))))
+
+(defsubst org-goto-line (N)
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- N))))
+
+(defsubst org-current-line-string (&optional to-here)
+ (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol))))
+
+(defsubst org-pos-in-match-range (pos n)
+ (and (match-beginning n)
+ (<= (match-beginning n) pos)
+ (>= (match-end n) pos)))
+
+(defun org-autoload (file functions)
+ "Establish autoload for all FUNCTIONS in FILE, if not bound already."
+ (let ((d (format "Documentation will be available after `%s.el' is loaded."
+ file))
+ f)
+ (while (setq f (pop functions))
+ (or (fboundp f) (autoload f file d t)))))
+
+(defun org-match-line (re)
+ "Looking-at at the beginning of the current line."
+ (save-excursion
+ (goto-char (point-at-bol))
+ (looking-at re)))
+
+(defun org-plist-delete (plist property)
+ "Delete PROPERTY from PLIST.
+This is in contrast to merely setting it to 0."
+ (let (p)
+ (while plist
+ (if (not (eq property (car plist)))
+ (setq p (plist-put p (car plist) (nth 1 plist))))
+ (setq plist (cddr plist)))
+ p))
+
+(defun org-replace-match-keep-properties (newtext &optional fixedcase
+ literal string)
+ "Like `replace-match', but add the text properties found original text."
+ (setq newtext (org-add-props newtext (text-properties-at
+ (match-beginning 0) string)))
+ (replace-match newtext fixedcase literal string))
+
+(defmacro org-save-outline-visibility (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions.
+This means that the buffer may change while running BODY,
+but it also means that the buffer should stay alive
+during the operation, because otherwise all these markers will
+point nowhere."
+ (declare (indent 1))
+ (org-with-gensyms (data rtn)
+ `(let ((,data (org-outline-overlay-data ,use-markers))
+ ,rtn)
+ (unwind-protect
+ (progn
+ (setq ,rtn (progn ,@body))
+ (org-set-outline-overlay-data ,data))
+ (when ,use-markers
+ (mapc (lambda (c)
+ (and (markerp (car c)) (move-marker (car c) nil))
+ (and (markerp (cdr c)) (move-marker (cdr c) nil)))
+ ,data)))
+ ,rtn)))
+(def-edebug-spec org-save-outline-visibility (form body))
+
+(defmacro org-with-wide-buffer (&rest body)
+ "Execute body while temporarily widening the buffer."
+ `(save-excursion
+ (save-restriction
+ (widen)
+ ,@body)))
+(def-edebug-spec org-with-wide-buffer (body))
+
+(defmacro org-with-limited-levels (&rest body)
+ "Execute BODY with limited number of outline levels."
+ `(let* ((org-called-with-limited-levels t)
+ (org-outline-regexp (org-get-limited-outline-regexp))
+ (outline-regexp org-outline-regexp)
+ (org-outline-regexp-bol (concat "^" org-outline-regexp)))
+ ,@body))
+(def-edebug-spec org-with-limited-levels (body))
+
+(defvar org-outline-regexp) ; defined in org.el
+(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el
+(defun org-get-limited-outline-regexp ()
+ "Return outline-regexp with limited number of levels.
+The number of levels is controlled by `org-inlinetask-min-level'"
+ (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask)))
+ org-outline-regexp
+ (let* ((limit-level (1- org-inlinetask-min-level))
+ (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
+ (format "\\*\\{1,%d\\} " nstars))))
+
+(defun org-format-seconds (string seconds)
+ "Compatibility function replacing format-seconds."
+ (if (fboundp 'format-seconds)
+ (format-seconds string seconds)
+ (format-time-string string (seconds-to-time seconds))))
+
+(defmacro org-eval-in-environment (environment form)
+ `(eval (list 'let ,environment ',form)))
+(def-edebug-spec org-eval-in-environment (form form))
+(put 'org-eval-in-environment 'lisp-indent-function 1)
+
+(defun org-make-parameter-alist (flat)
+ "Return alist based on FLAT.
+FLAT is a list with alternating symbol names and values. The
+returned alist is a list of lists with the symbol name in car and
+the value in cdr."
+ (when flat
+ (cons (list (car flat) (cadr flat))
+ (org-make-parameter-alist (cddr flat)))))
+
+(provide 'org-macs)
+
+;;; org-macs.el ends here
diff --git a/lisp/org-mew.el b/lisp/org-mew.el
new file mode 100644
index 0000000..74ace5a
--- /dev/null
+++ b/lisp/org-mew.el
@@ -0,0 +1,136 @@
+;;; org-mew.el --- Support for links to Mew messages from within Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to Mew messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+(defgroup org-mew nil
+ "Options concerning the Mew link."
+ :tag "Org Startup"
+ :group 'org-link)
+
+(defcustom org-mew-link-to-refile-destination t
+ "Create a link to the refile destination if the message is marked as refile."
+ :group 'org-mew
+ :type 'boolean)
+
+;; Declare external functions and variables
+(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
+(declare-function mew-case-folder "ext:mew-func" (case folder))
+(declare-function mew-header-get-value "ext:mew-header"
+ (field &optional as-list))
+(declare-function mew-init "ext:mew" ())
+(declare-function mew-refile-get "ext:mew-refile" (msg))
+(declare-function mew-sinfo-get-case "ext:mew-summary" ())
+(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
+(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
+(declare-function mew-summary-get-mark "ext:mew-mark" ())
+(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
+(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
+ (pattern folder src-msgs))
+(declare-function mew-summary-search-msg "ext:mew-const" (msg))
+(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
+(declare-function mew-summary-visit-folder "ext:mew-summary4"
+ (folder &optional goend no-ls))
+(declare-function mew-window-push "ext:mew" ())
+(defvar mew-init-p)
+(defvar mew-summary-goto-line-then-display)
+
+;; Install the link type
+(org-add-link-type "mew" 'org-mew-open)
+(add-hook 'org-store-link-functions 'org-mew-store-link)
+
+;; Implementation
+(defun org-mew-store-link ()
+ "Store a link to a Mew folder or message."
+ (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
+ (let* ((msgnum (mew-summary-message-number2))
+ (mark-info (mew-summary-get-mark))
+ (folder-name
+ (if (and org-mew-link-to-refile-destination
+ (eq mark-info ?o)) ; marked as refile
+ (mew-case-folder (mew-sinfo-get-case)
+ (nth 1 (mew-refile-get msgnum)))
+ (mew-summary-folder-name)))
+ message-id from to subject desc link date date-ts date-ts-ia)
+ (save-window-excursion
+ (if (fboundp 'mew-summary-set-message-buffer)
+ (mew-summary-set-message-buffer folder-name msgnum)
+ (set-buffer (mew-cache-hit folder-name msgnum t)))
+ (setq message-id (mew-header-get-value "Message-Id:"))
+ (setq from (mew-header-get-value "From:"))
+ (setq to (mew-header-get-value "To:"))
+ (setq date (mew-header-get-value "Date:"))
+ (setq date-ts (and date (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time date))))
+ (setq date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ (setq subject (mew-header-get-value "Subject:")))
+ (org-store-link-props :type "mew" :from from :to to
+ :subject subject :message-id message-id)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq message-id (org-remove-angle-brackets message-id))
+ (setq desc (org-email-link-description))
+ (setq link (concat "mew:" folder-name "#" message-id))
+ (org-add-link-props :link link :description desc)
+ link)))
+
+(defun org-mew-open (path)
+ "Follow the Mew message link specified by PATH."
+ (let (folder msgnum)
+ (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
+ (setq folder (match-string 1 path))
+ (setq msgnum (match-string 2 path)))
+ ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
+ (setq folder (match-string 1 path))
+ (setq msgnum (match-string 4 path)))
+ (t (error "Error in Mew link")))
+ (require 'mew)
+ (mew-window-push)
+ (unless mew-init-p (mew-init))
+ (mew-summary-visit-folder folder)
+ (when msgnum
+ (if (not (string-match "\\`[0-9]+\\'" msgnum))
+ (let* ((pattern (concat "message-id=" msgnum))
+ (msgs (mew-summary-pick-with-mewl pattern folder nil)))
+ (setq msgnum (car msgs))))
+ (if (mew-summary-search-msg msgnum)
+ (if mew-summary-goto-line-then-display
+ (mew-summary-display))
+ (error "Message not found")))))
+
+(provide 'org-mew)
+
+;;; org-mew.el ends here
diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el
new file mode 100644
index 0000000..7c8b0b2
--- /dev/null
+++ b/lisp/org-mhe.el
@@ -0,0 +1,227 @@
+;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to MH-E messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+;; Customization variables
+
+(defcustom org-mhe-search-all-folders nil
+ "Non-nil means the search for the mh-message may extend to all folders.
+When non-nil, the search for a message will extend to all other
+folders if it cannot be found in the folder given in the link.
+Searching all folders may be slow with the default pick based
+search but is very efficient with one of the other search engines
+supported by MH-E."
+ :group 'org-link-follow
+ :type 'boolean)
+
+;; Declare external functions and variables
+(declare-function mh-display-msg "mh-show" (msg-num folder-name))
+(declare-function mh-find-path "mh-utils" ())
+(declare-function mh-get-header-field "mh-utils" (field))
+(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
+(declare-function mh-header-display "mh-show" ())
+(declare-function mh-index-previous-folder "mh-search" ())
+(declare-function mh-normalize-folder-name "mh-utils"
+ (folder &optional empty-string-okay dont-remove-trailing-slash
+ return-nil-if-folder-empty))
+(declare-function mh-search "mh-search"
+ (folder search-regexp &optional redo-search-flag
+ window-config))
+(declare-function mh-search-choose "mh-search" (&optional searcher))
+(declare-function mh-show "mh-show" (&optional message redisplay-flag))
+(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
+(declare-function mh-show-header-display "mh-show" t t)
+(declare-function mh-show-msg "mh-show" (msg))
+(declare-function mh-show-show "mh-show" t t)
+(declare-function mh-visit-folder "mh-folder" (folder &optional
+ range index-data))
+(defvar mh-progs)
+(defvar mh-current-folder)
+(defvar mh-show-folder-buffer)
+(defvar mh-index-folder)
+(defvar mh-searcher)
+(defvar mh-search-regexp-builder)
+
+;; Install the link type
+(org-add-link-type "mhe" 'org-mhe-open)
+(add-hook 'org-store-link-functions 'org-mhe-store-link)
+
+;; Implementation
+(defun org-mhe-store-link ()
+ "Store a link to an MH-E folder or message."
+ (when (or (equal major-mode 'mh-folder-mode)
+ (equal major-mode 'mh-show-mode))
+ (save-window-excursion
+ (let* ((from (org-mhe-get-header "From:"))
+ (to (org-mhe-get-header "To:"))
+ (message-id (org-mhe-get-header "Message-Id:"))
+ (subject (org-mhe-get-header "Subject:"))
+ (date (org-mhe-get-header "Date:"))
+ (date-ts (and date (format-time-string
+ (org-time-stamp-format t) (date-to-time date))))
+ (date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ link desc)
+ (org-store-link-props :type "mh" :from from :to to
+ :subject subject :message-id message-id)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq desc (org-email-link-description))
+ (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
+ (org-remove-angle-brackets message-id)))
+ (org-add-link-props :link link :description desc)
+ link))))
+
+(defun org-mhe-open (path)
+ "Follow an MH-E message link specified by PATH."
+ (let (folder article)
+ (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in MH-E link"))
+ (setq folder (match-string 1 path)
+ article (match-string 3 path))
+ (org-mhe-follow-link folder article)))
+
+;;; mh-e integration based on planner-mode
+(defun org-mhe-get-message-real-folder ()
+ "Return the name of the real folder for the current message.
+So if you use sequences, it will now work."
+ (save-excursion
+ (let* ((folder
+ (if (equal major-mode 'mh-folder-mode)
+ mh-current-folder
+ ;; Refer to the show buffer
+ mh-show-folder-buffer))
+ (end-index
+ (if (boundp 'mh-index-folder)
+ (min (length mh-index-folder) (length folder))))
+ )
+ ;; a simple test on mh-index-data does not work, because
+ ;; mh-index-data is always nil in a show buffer.
+ (if (and (boundp 'mh-index-folder)
+ (string= mh-index-folder (substring folder 0 end-index)))
+ (if (equal major-mode 'mh-show-mode)
+ (save-window-excursion
+ (let (pop-up-frames)
+ (when (buffer-live-p (get-buffer folder))
+ (progn
+ (pop-to-buffer folder)
+ (org-mhe-get-message-folder-from-index)
+ )
+ )))
+ (org-mhe-get-message-folder-from-index)
+ )
+ folder
+ )
+ )))
+
+(defun org-mhe-get-message-folder-from-index ()
+ "Return the name of the message folder in an index folder buffer."
+ (save-excursion
+ (mh-index-previous-folder)
+ (if (re-search-forward "^\\(+.*\\)$" nil t)
+ (message "%s" (match-string 1)))))
+
+(defun org-mhe-get-message-folder ()
+ "Return the name of the current message folder.
+Be careful if you use sequences."
+ (save-excursion
+ (if (equal major-mode 'mh-folder-mode)
+ mh-current-folder
+ ;; Refer to the show buffer
+ mh-show-folder-buffer)))
+
+(defun org-mhe-get-message-num ()
+ "Return the number of the current message.
+Be careful if you use sequences."
+ (save-excursion
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-get-msg-num nil)
+ ;; Refer to the show buffer
+ (mh-show-buffer-message-number))))
+
+(defun org-mhe-get-header (header)
+ "Return the field for HEADER of the message in folder mode.
+This will create a show buffer for the corresponding message. If
+you have a better idea of how to do this then please let us know."
+ (let* ((folder (org-mhe-get-message-folder))
+ (num (org-mhe-get-message-num))
+ (buffer (get-buffer-create (concat "show-" folder)))
+ (header-field))
+ (with-current-buffer buffer
+ (mh-display-msg num folder)
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-header-display)
+ (mh-show-header-display))
+ (set-buffer buffer)
+ (setq header-field (mh-get-header-field header))
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-show)
+ (mh-show-show))
+ (org-trim header-field))))
+
+(defun org-mhe-follow-link (folder article)
+ "Follow an MH-E link to FOLDER and ARTICLE.
+If ARTICLE is nil FOLDER is shown. If the configuration variable
+`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
+ARTICLE is searched in all folders. Indexed searches (swish++,
+namazu, and others supported by MH-E) will always search in all
+folders."
+ (require 'mh-e)
+ (require 'mh-search)
+ (require 'mh-utils)
+ (mh-find-path)
+ (if (not article)
+ (mh-visit-folder (mh-normalize-folder-name folder))
+ (mh-search-choose)
+ (if (equal mh-searcher 'pick)
+ (progn
+ (setq article (org-add-angle-brackets article))
+ (mh-search folder (list "--message-id" article))
+ (when (and org-mhe-search-all-folders
+ (not (org-mhe-get-message-real-folder)))
+ (kill-this-buffer)
+ (mh-search "+" (list "--message-id" article))))
+ (if mh-search-regexp-builder
+ (mh-search "+" (funcall mh-search-regexp-builder
+ (list (cons 'message-id article))))
+ (mh-search "+" article)))
+ (if (org-mhe-get-message-real-folder)
+ (mh-show-msg 1)
+ (kill-this-buffer)
+ (error "Message not found"))))
+
+(provide 'org-mhe)
+
+;;; org-mhe.el ends here
diff --git a/lisp/org-mks.el b/lisp/org-mks.el
new file mode 100644
index 0000000..95223ef
--- /dev/null
+++ b/lisp/org-mks.el
@@ -0,0 +1,134 @@
+;;; org-mks.el --- Multi-key-selection for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(defun org-mks (table title &optional prompt specials)
+ "Select a member of an alist with multiple keys.
+TABLE is the alist which should contain entries where the car is a string.
+There should be two types of entries.
+
+1. prefix descriptions like (\"a\" \"Description\")
+ This indicates that `a' is a prefix key for multi-letter selection, and
+ that there are entries following with keys like \"ab\", \"ax\"...
+
+2. Selectable members must have more than two elements, with the first
+ being the string of keys that lead to selecting it, and the second a
+ short description string of the item.
+
+The command will then make a temporary buffer listing all entries
+that can be selected with a single key, and all the single key
+prefixes. When you press the key for a single-letter entry, it is selected.
+When you press a prefix key, the commands (and maybe further prefixes)
+under this key will be shown and offered for selection.
+
+TITLE will be placed over the selection in the temporary buffer,
+PROMPT will be used when prompting for a key. SPECIAL is an alist with
+also (\"key\" \"description\") entries. When one of these is selection,
+only the bare key is returned."
+ (setq prompt (or prompt "Select: "))
+ (let (tbl orig-table dkey ddesc des-keys allowed-keys
+ current prefix rtn re pressed buffer (inhibit-quit t))
+ (save-window-excursion
+ (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
+ (setq orig-table table)
+ (catch 'exit
+ (while t
+ (erase-buffer)
+ (insert title "\n\n")
+ (setq tbl table
+ des-keys nil
+ allowed-keys nil)
+ (setq prefix (if current (concat current " ") ""))
+ (while tbl
+ (cond
+ ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
+ ;; This is a description on this level
+ (setq dkey (caar tbl) ddesc (cadar tbl))
+ (pop tbl)
+ (push dkey des-keys)
+ (push dkey allowed-keys)
+ (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n")
+ ;; Skip keys which are below this prefix
+ (setq re (concat "\\`" (regexp-quote dkey)))
+ (while (and tbl (string-match re (caar tbl))) (pop tbl)))
+ ((= 2 (length (car tbl)))
+ ;; Not yet a usable description, skip it
+ )
+ (t
+ ;; usable entry on this level
+ (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n")
+ (push (caar tbl) allowed-keys)
+ (pop tbl))))
+ (when specials
+ (insert "-------------------------------------------------------------------------------\n")
+ (let ((sp specials))
+ (while sp
+ (insert (format "[%s] %s\n"
+ (caar sp) (nth 1 (car sp))))
+ (push (caar sp) allowed-keys)
+ (pop sp))))
+ (push "\C-g" allowed-keys)
+ (goto-char (point-min))
+ (if (not (pos-visible-in-window-p (point-max)))
+ (org-fit-window-to-buffer))
+ (message prompt)
+ (setq pressed (char-to-string (read-char-exclusive)))
+ (while (not (member pressed allowed-keys))
+ (message "Invalid key `%s'" pressed) (sit-for 1)
+ (message prompt)
+ (setq pressed (char-to-string (read-char-exclusive))))
+ (when (equal pressed "\C-g")
+ (kill-buffer buffer)
+ (error "Abort"))
+ (when (and (not (assoc pressed table))
+ (not (member pressed des-keys))
+ (assoc pressed specials))
+ (throw 'exit (setq rtn pressed)))
+ (unless (member pressed des-keys)
+ (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
+ orig-table))))
+ (setq current (concat current pressed))
+ (setq table (mapcar
+ (lambda (x)
+ (if (and (> (length (car x)) 1)
+ (equal (substring (car x) 0 1) pressed))
+ (cons (substring (car x) 1) (cdr x))
+ nil))
+ table))
+ (setq table (remove nil table)))))
+ (when buffer (kill-buffer buffer))
+ rtn))
+
+(provide 'org-mks)
+
+;;; org-mks.el ends here
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
new file mode 100644
index 0000000..d2c9c17
--- /dev/null
+++ b/lisp/org-mobile.el
@@ -0,0 +1,1132 @@
+;;; org-mobile.el --- Code for asymmetric sync with a mobile device
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; This file contains the code to interact with Richard Moreland's iPhone
+;; application MobileOrg, as well as with the Android version by Matthew Jones.
+;; This code is documented in Appendix B of the Org-mode manual. The code is
+;; not specific for the iPhone and Android - any external
+;; viewer/flagging/editing application that uses the same conventions could
+;; be used.
+
+(require 'org)
+(require 'org-agenda)
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+(defgroup org-mobile nil
+ "Options concerning support for a viewer/editor on a mobile device."
+ :tag "Org Mobile"
+ :group 'org)
+
+(defcustom org-mobile-files '(org-agenda-files)
+ "Files to be staged for MobileOrg.
+This is basically a list of files and directories. Files will be staged
+directly. Directories will be search for files with the extension `.org'.
+In addition to this, the list may also contain the following symbols:
+
+org-agenda-files
+ This means include the complete, unrestricted list of files given in
+ the variable `org-agenda-files'.
+org-agenda-text-search-extra-files
+ Include the files given in the variable
+ `org-agenda-text-search-extra-files'"
+ :group 'org-mobile
+ :type '(list :greedy t
+ (option (const :tag "org-agenda-files" org-agenda-files))
+ (option (const :tag "org-agenda-text-search-extra-files"
+ org-agenda-text-search-extra-files))
+ (repeat :inline t :tag "Additional files"
+ (file))))
+
+(defcustom org-mobile-files-exclude-regexp ""
+ "A regexp to exclude files from `org-mobile-files'."
+ :group 'org-mobile
+ :version "24.1"
+ :type 'regexp)
+
+(defcustom org-mobile-directory ""
+ "The WebDAV directory where the interaction with the mobile takes place."
+ :group 'org-mobile
+ :type 'directory)
+
+(defcustom org-mobile-use-encryption nil
+ "Non-nil means keep only encrypted files on the WebDAV server.
+Encryption uses AES-256, with a password given in
+`org-mobile-encryption-password'.
+When nil, plain files are kept on the server.
+Turning on encryption requires to set the same password in the MobileOrg
+application. Before turning this on, check of MobileOrg does already
+support it - at the time of this writing it did not yet."
+ :group 'org-mobile
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt"
+ "File that is being used as a temporary file for encryption.
+This must be local file on your local machine (not on the WebDAV server).
+You might want to put this file into a directory where only you have access."
+ :group 'org-mobile
+ :version "24.1"
+ :type 'directory)
+
+(defcustom org-mobile-encryption-password ""
+ "Password for encrypting files uploaded to the server.
+This is a single password which is used for AES-256 encryption. The same
+password must also be set in the MobileOrg application. All Org files,
+including mobileorg.org will be encrypted using this password.
+
+SECURITY CONSIDERATIONS:
+
+Note that, when Org runs the encryption commands, the password could
+be visible briefly on your system with the `ps' command. So this method is
+only intended to keep the files secure on the server, not on your own machine.
+
+Also, if you set this variable in an init file (.emacs or .emacs.d/init.el
+or custom.el...) and if that file is stored in a way so that other can read
+it, this also limits the security of this approach. You can also leave
+this variable empty - Org will then ask for the password once per Emacs
+session."
+ :group 'org-mobile
+ :version "24.1"
+ :type '(string :tag "Password"))
+
+(defvar org-mobile-encryption-password-session nil)
+
+(defun org-mobile-encryption-password ()
+ (or (org-string-nw-p org-mobile-encryption-password)
+ (org-string-nw-p org-mobile-encryption-password-session)
+ (setq org-mobile-encryption-password-session
+ (read-passwd "Password for MobileOrg: " t))))
+
+(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
+ "The file where captured notes and flags will be appended to.
+During the execution of `org-mobile-pull', the file
+`org-mobile-capture-file' will be emptied it's contents have
+been appended to the file given here. This file should be in
+`org-directory', and not in the staging area or on the web server."
+ :group 'org-mobile
+ :type 'file)
+
+(defconst org-mobile-capture-file "mobileorg.org"
+ "The capture file where the mobile stores captured notes and flags.
+This should not be changed, because MobileOrg assumes this name.")
+
+(defcustom org-mobile-index-file "index.org"
+ "The index file with links to all Org files that should be loaded by MobileOrg.
+Relative to `org-mobile-directory'. The Address field in the MobileOrg setup
+should point to this file."
+ :group 'org-mobile
+ :type 'file)
+
+(defcustom org-mobile-agendas 'all
+ "The agendas that should be pushed to MobileOrg.
+Allowed values:
+
+default the weekly agenda and the global TODO list
+custom all custom agendas defined by the user
+all the custom agendas and the default ones
+list a list of selection key(s) as string."
+ :group 'org-mobile
+ :version "24.1"
+ :type '(choice
+ (const :tag "Default Agendas" default)
+ (const :tag "Custom Agendas" custom)
+ (const :tag "Default and Custom Agendas" all)
+ (repeat :tag "Selected"
+ (string :tag "Selection Keys"))))
+
+(defcustom org-mobile-force-id-on-agenda-items t
+ "Non-nil means make all agenda items carry an ID."
+ :group 'org-mobile
+ :type 'boolean)
+
+(defcustom org-mobile-force-mobile-change nil
+ "Non-nil means force the change made on the mobile device.
+So even if there have been changes to the computer version of the entry,
+force the new value set on the mobile.
+When nil, mark the entry from the mobile with an error message.
+Instead of nil or t, this variable can also be a list of symbols, indicating
+the editing types for which the mobile version should always dominate."
+ :group 'org-mobile
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (set :greedy t :tag "Specify"
+ (const todo)
+ (const tags)
+ (const priority)
+ (const heading)
+ (const body))))
+
+(defcustom org-mobile-action-alist
+ '(("edit" . (org-mobile-edit data old new)))
+ "Alist with flags and actions for mobile sync.
+When flagging an entry, MobileOrg will create entries that look like
+
+ * F(action:data) [[id:entry-id][entry title]]
+
+This alist defines that the ACTION in the parentheses of F() should mean,
+i.e. what action should be taken. The :data part in the parenthesis is
+optional. If present, the string after the colon will be passed to the
+action form as the `data' variable.
+The car of each elements of the alist is an actions string. The cdr is
+an Emacs Lisp form that will be evaluated with the cursor on the headline
+of that entry.
+
+For now, it is not recommended to change this variable."
+ :group 'org-mobile
+ :type '(repeat
+ (cons (string :tag "Action flag")
+ (sexp :tag "Action form"))))
+
+(defcustom org-mobile-checksum-binary (or (executable-find "shasum")
+ (executable-find "sha1sum")
+ (executable-find "md5sum")
+ (executable-find "md5"))
+ "Executable used for computing checksums of agenda files."
+ :group 'org-mobile
+ :type 'string)
+
+(defvar org-mobile-pre-push-hook nil
+ "Hook run before running `org-mobile-push'.
+This could be used to clean up `org-mobile-directory', for example to
+remove files that used to be included in the agenda but no longer are.
+The presence of such files would not really be a problem, but after time
+they may accumulate.")
+
+(defvar org-mobile-post-push-hook nil
+ "Hook run after running `org-mobile-push'.
+If Emacs does not have direct write access to the WebDAV directory used
+by the mobile device, this hook should be used to copy all files from the
+local staging directory `org-mobile-directory' to the WebDAV directory,
+for example using `rsync' or `scp'.")
+
+(defvar org-mobile-pre-pull-hook nil
+ "Hook run before executing `org-mobile-pull'.
+If Emacs does not have direct write access to the WebDAV directory used
+by the mobile device, this hook should be used to copy the capture file
+`mobileorg.org' from the WebDAV location to the local staging
+directory `org-mobile-directory'.")
+
+(defvar org-mobile-post-pull-hook nil
+ "Hook run after running `org-mobile-pull', only if new items were found.
+If Emacs does not have direct write access to the WebDAV directory used
+by the mobile device, this hook should be used to copy the emptied
+capture file `mobileorg.org' back to the WebDAV directory, for example
+using `rsync' or `scp'.")
+
+(defvar org-mobile-last-flagged-files nil
+ "List of files containing entries flagged in the latest pull.")
+
+(defvar org-mobile-files-alist nil)
+(defvar org-mobile-checksum-files nil)
+
+(defun org-mobile-prepare-file-lists ()
+ (setq org-mobile-files-alist (org-mobile-files-alist))
+ (setq org-mobile-checksum-files nil))
+
+(defun org-mobile-files-alist ()
+ "Expand the list in `org-mobile-files' to a list of existing files.
+Also exclude files matching `org-mobile-files-exclude-regexp'."
+ (let* ((include-archives
+ (and (member 'org-agenda-text-search-extra-files org-mobile-files)
+ (member 'agenda-archives org-agenda-text-search-extra-files)
+ t))
+ (files
+ (apply 'append
+ (mapcar
+ (lambda (f)
+ (cond
+ ((eq f 'org-agenda-files)
+ (org-agenda-files t include-archives))
+ ((eq f 'org-agenda-text-search-extra-files)
+ (delq 'agenda-archives
+ (copy-sequence
+ org-agenda-text-search-extra-files)))
+ ((and (stringp f) (file-directory-p f))
+ (directory-files f 'full "\\.org\\'"))
+ ((and (stringp f) (file-exists-p f))
+ (list f))
+ (t nil)))
+ org-mobile-files)))
+ (files (delete
+ nil
+ (mapcar (lambda (f)
+ (unless (and (not (string= org-mobile-files-exclude-regexp ""))
+ (string-match org-mobile-files-exclude-regexp f))
+ (identity f)))
+ files)))
+ (orgdir-uname (file-name-as-directory (file-truename org-directory)))
+ (orgdir-re (concat "\\`" (regexp-quote orgdir-uname)))
+ uname seen rtn file link-name)
+ ;; Make the files unique, and determine the name under which they will
+ ;; be listed.
+ (while (setq file (pop files))
+ (if (not (file-name-absolute-p file))
+ (setq file (expand-file-name file org-directory)))
+ (setq uname (file-truename file))
+ (unless (member uname seen)
+ (push uname seen)
+ (if (string-match orgdir-re uname)
+ (setq link-name (substring uname (match-end 0)))
+ (setq link-name (file-name-nondirectory uname)))
+ (push (cons file link-name) rtn)))
+ (nreverse rtn)))
+
+(defvar org-agenda-filter)
+
+;;;###autoload
+(defun org-mobile-push ()
+ "Push the current state of Org affairs to the WebDAV directory.
+This will create the index file, copy all agenda files there, and also
+create all custom agenda views, for upload to the mobile phone."
+ (interactive)
+ (let ((a-buffer (get-buffer org-agenda-buffer-name)))
+ (let ((org-agenda-buffer-name "*SUMO*")
+ (org-agenda-tag-filter org-agenda-tag-filter)
+ (org-agenda-redo-command org-agenda-redo-command))
+ (save-excursion
+ (save-window-excursion
+ (run-hooks 'org-mobile-pre-push-hook)
+ (org-mobile-check-setup)
+ (org-mobile-prepare-file-lists)
+ (message "Creating agendas...")
+ (let ((inhibit-redisplay t)
+ (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+ (org-mobile-create-sumo-agenda))
+ (message "Creating agendas...done")
+ (org-save-all-org-buffers) ; to save any IDs created by this process
+ (message "Copying files...")
+ (org-mobile-copy-agenda-files)
+ (message "Writing index file...")
+ (org-mobile-create-index-file)
+ (message "Writing checksums...")
+ (org-mobile-write-checksums)
+ (run-hooks 'org-mobile-post-push-hook))))
+ (redraw-display)
+ (when (and a-buffer (buffer-live-p a-buffer))
+ (if (not (get-buffer-window a-buffer))
+ (kill-buffer a-buffer)
+ (let ((cw (selected-window)))
+ (select-window (get-buffer-window a-buffer))
+ (org-agenda-redo)
+ (select-window cw)))))
+ (message "Files for mobile viewer staged"))
+
+(defvar org-mobile-before-process-capture-hook nil
+ "Hook that is run after content was moved to `org-mobile-inbox-for-pull'.
+The inbox file is visited by the current buffer, and the buffer is
+narrowed to the newly captured data.")
+
+;;;###autoload
+(defun org-mobile-pull ()
+ "Pull the contents of `org-mobile-capture-file' and integrate them.
+Apply all flagged actions, flag entries to be flagged and then call an
+agenda view showing the flagged items."
+ (interactive)
+ (org-mobile-check-setup)
+ (run-hooks 'org-mobile-pre-pull-hook)
+ (let ((insertion-marker (org-mobile-move-capture)))
+ (if (not (markerp insertion-marker))
+ (message "No new items")
+ (org-with-point-at insertion-marker
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (run-hooks 'org-mobile-before-process-capture-hook)))
+ (org-with-point-at insertion-marker
+ (org-mobile-apply (point) (point-max)))
+ (move-marker insertion-marker nil)
+ (run-hooks 'org-mobile-post-pull-hook)
+ (when org-mobile-last-flagged-files
+ ;; Make an agenda view of flagged entries, but only in the files
+ ;; where stuff has been added.
+ (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files)
+ (let ((org-agenda-keep-restricted-file-list t))
+ (org-agenda nil "?"))))))
+
+(defun org-mobile-check-setup ()
+ "Check if org-mobile-directory has been set up."
+ (org-mobile-cleanup-encryption-tempfile)
+ (unless (and org-directory
+ (stringp org-directory)
+ (string-match "\\S-" org-directory)
+ (file-exists-p org-directory)
+ (file-directory-p org-directory))
+ (error
+ "Please set `org-directory' to the directory where your org files live"))
+ (unless (and org-mobile-directory
+ (stringp org-mobile-directory)
+ (string-match "\\S-" org-mobile-directory)
+ (file-exists-p org-mobile-directory)
+ (file-directory-p org-mobile-directory))
+ (error
+ "Variable `org-mobile-directory' must point to an existing directory"))
+ (unless (and org-mobile-inbox-for-pull
+ (stringp org-mobile-inbox-for-pull)
+ (string-match "\\S-" org-mobile-inbox-for-pull)
+ (file-exists-p
+ (file-name-directory org-mobile-inbox-for-pull)))
+ (error
+ "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory"))
+ (unless (and org-mobile-checksum-binary
+ (string-match "\\S-" org-mobile-checksum-binary))
+ (error "No executable found to compute checksums"))
+ (when org-mobile-use-encryption
+ (unless (string-match "\\S-" (org-mobile-encryption-password))
+ (error
+ "To use encryption, you must set `org-mobile-encryption-password'"))
+ (unless (file-writable-p org-mobile-encryption-tempfile)
+ (error "Cannot write to encryption tempfile %s"
+ org-mobile-encryption-tempfile))
+ (unless (executable-find "openssl")
+ (error "OpenSSL is needed to encrypt files"))))
+
+(defun org-mobile-create-index-file ()
+ "Write the index file in the WebDAV directory."
+ (let ((files-alist (sort (copy-sequence org-mobile-files-alist)
+ (lambda (a b) (string< (cdr a) (cdr b)))))
+ (def-todo (default-value 'org-todo-keywords))
+ (def-tags (default-value 'org-tag-alist))
+ (target-file (expand-file-name org-mobile-index-file
+ org-mobile-directory))
+ file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
+
+ (org-agenda-prepare-buffers (mapcar 'car files-alist))
+ (setq done-kwds (org-uniquify org-done-keywords-for-agenda))
+ (setq todo-kwds (org-delete-all
+ done-kwds
+ (org-uniquify org-todo-keywords-for-agenda)))
+ (setq drawers (org-uniquify org-drawers-for-agenda))
+ (setq tags (mapcar 'car (org-global-tags-completion-table
+ (mapcar 'car files-alist))))
+ (with-temp-file
+ (if org-mobile-use-encryption
+ org-mobile-encryption-tempfile
+ target-file)
+ (while (setq entry (pop def-todo))
+ (insert "#+READONLY\n")
+ (setq kwds (mapcar (lambda (x) (if (string-match "(" x)
+ (substring x 0 (match-beginning 0))
+ x))
+ (cdr entry)))
+ (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n")
+ (setq dwds (member "|" kwds)
+ twds (org-delete-all dwds kwds)
+ todo-kwds (org-delete-all twds todo-kwds)
+ done-kwds (org-delete-all dwds done-kwds)))
+ (when (or todo-kwds done-kwds)
+ (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | "
+ (mapconcat 'identity done-kwds " ") "\n"))
+ (setq def-tags (mapcar
+ (lambda (x)
+ (cond ((null x) nil)
+ ((stringp x) x)
+ ((eq (car x) :startgroup) "{")
+ ((eq (car x) :endgroup) "}")
+ ((eq (car x) :newline) nil)
+ ((listp x) (car x))))
+ def-tags))
+ (setq def-tags (delq nil def-tags))
+ (setq tags (org-delete-all def-tags tags))
+ (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b)))))
+ (setq tags (append def-tags tags nil))
+ (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
+ (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
+ (insert "#+ALLPRIORITIES: A B C" "\n")
+ (when (file-exists-p (expand-file-name
+ org-mobile-directory "agendas.org"))
+ (insert "* [[file:agendas.org][Agenda Views]]\n"))
+ (while (setq entry (pop files-alist))
+ (setq file (car entry)
+ link-name (cdr entry))
+ (insert (format "* [[file:%s][%s]]\n"
+ link-name link-name)))
+ (push (cons org-mobile-index-file (md5 (buffer-string)))
+ org-mobile-checksum-files))
+ (when org-mobile-use-encryption
+ (org-mobile-encrypt-and-move org-mobile-encryption-tempfile
+ target-file)
+ (org-mobile-cleanup-encryption-tempfile))))
+
+(defun org-mobile-copy-agenda-files ()
+ "Copy all agenda files to the stage or WebDAV directory."
+ (let ((files-alist org-mobile-files-alist)
+ file buf entry link-name target-path target-dir check)
+ (while (setq entry (pop files-alist))
+ (setq file (car entry) link-name (cdr entry))
+ (when (file-exists-p file)
+ (setq target-path (expand-file-name link-name org-mobile-directory)
+ target-dir (file-name-directory target-path))
+ (unless (file-directory-p target-dir)
+ (make-directory target-dir 'parents))
+ (if org-mobile-use-encryption
+ (org-mobile-encrypt-and-move file target-path)
+ (copy-file file target-path 'ok-if-exists))
+ (setq check (shell-command-to-string
+ (concat org-mobile-checksum-binary " "
+ (shell-quote-argument (expand-file-name file)))))
+ (when (string-match "[a-fA-F0-9]\\{30,40\\}" check)
+ (push (cons link-name (match-string 0 check))
+ org-mobile-checksum-files))))
+
+ (setq file (expand-file-name org-mobile-capture-file
+ org-mobile-directory))
+ (save-excursion
+ (setq buf (find-file file))
+ (when (and (= (point-min) (point-max)))
+ (insert "\n")
+ (save-buffer)
+ (when org-mobile-use-encryption
+ (write-file org-mobile-encryption-tempfile)
+ (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file)))
+ (push (cons org-mobile-capture-file (md5 (buffer-string)))
+ org-mobile-checksum-files))
+ (org-mobile-cleanup-encryption-tempfile)
+ (kill-buffer buf)))
+
+(defun org-mobile-write-checksums ()
+ "Create checksums for all files in `org-mobile-directory'.
+The table of checksums is written to the file mobile-checksums."
+ (let ((sumfile (expand-file-name "checksums.dat" org-mobile-directory))
+ (files org-mobile-checksum-files)
+ entry file sum)
+ (with-temp-file sumfile
+ (set-buffer-file-coding-system 'undecided-unix nil)
+ (while (setq entry (pop files))
+ (setq file (car entry) sum (cdr entry))
+ (insert (format "%s %s\n" sum file))))))
+
+(defun org-mobile-sumo-agenda-command ()
+ "Return an agenda custom command that comprises all custom commands."
+ (let ((custom-list
+ ;; normalize different versions
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (cond ((stringp (cdr x)) nil)
+ ((stringp (nth 1 x)) x)
+ ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
+ (t (cons (car x) (cons "" (cdr x))))))
+ org-agenda-custom-commands)))
+ (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo)))
+ thelist new e key desc type match settings cmds gkey gdesc gsettings cnt)
+ (cond
+ ((eq org-mobile-agendas 'custom)
+ (setq thelist custom-list))
+ ((eq org-mobile-agendas 'default)
+ (setq thelist default-list))
+ ((eq org-mobile-agendas 'all)
+ (setq thelist custom-list)
+ (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist))
+ (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist)))
+ ((listp org-mobile-agendas)
+ (setq thelist (append custom-list default-list))
+ (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist))
+ org-mobile-agendas)))))
+ (while (setq e (pop thelist))
+ (cond
+ ((stringp (cdr e))
+ ;; this is a description entry - skip it
+ )
+ ((eq (nth 2 e) 'search)
+ ;; Search view is interactive, skip
+ )
+ ((memq (nth 2 e) '(todo-tree tags-tree occur-tree))
+ ;; These are trees, not really agenda commands
+ )
+ ((and (memq (nth 2 e) '(todo tags tags-todo))
+ (or (null (nth 3 e))
+ (not (string-match "\\S-" (nth 3 e)))))
+ ;; These would be interactive because the match string is empty
+ )
+ ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo))
+ ;; a normal command
+ (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e)
+ settings (nth 4 e))
+ (setq settings
+ (cons (list 'org-agenda-title-append
+ (concat "<after>KEYS=" key " TITLE: "
+ (if (and (stringp desc) (> (length desc) 0))
+ desc (symbol-name type))
+ "</after>"))
+ settings))
+ (push (list type match settings) new))
+ ((or (functionp (nth 2 e)) (symbolp (nth 2 e)))
+ ;; A user-defined function, which can do anything, so simply
+ ;; ignore it.
+ )
+ (t
+ ;; a block agenda
+ (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e))
+ (setq cnt 0)
+ (while (setq e (pop cmds))
+ (setq type (car e) match (nth 1 e) settings (nth 2 e))
+ (setq settings (append gsettings settings))
+ (setq settings
+ (cons (list 'org-agenda-title-append
+ (concat "<after>KEYS=" gkey "#" (number-to-string
+ (setq cnt (1+ cnt)))
+ " TITLE: " gdesc " " match "</after>"))
+ settings))
+ (push (list type match settings) new)))))
+ (and new (list "X" "SUMO" (reverse new)
+ '((org-agenda-compact-blocks nil))))))
+
+(defvar org-mobile-creating-agendas nil)
+(defun org-mobile-write-agenda-for-mobile (file)
+ (let ((all (buffer-string)) in-date id pl prefix line app short m sexp)
+ (with-temp-file file
+ (org-mode)
+ (insert "#+READONLY\n")
+ (insert all)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (cond
+ ((looking-at "[ \t]*$")) ; keep empty lines
+ ((looking-at "=+$")
+ ;; remove underlining
+ (delete-region (point) (point-at-eol)))
+ ((get-text-property (point) 'org-agenda-structural-header)
+ (setq in-date nil)
+ (setq app (get-text-property (point)
+ 'org-agenda-title-append))
+ (setq short (get-text-property (point)
+ 'short-heading))
+ (when (and short (looking-at ".+"))
+ (replace-match short)
+ (beginning-of-line 1))
+ (when app
+ (end-of-line 1)
+ (insert app)
+ (beginning-of-line 1))
+ (insert "* "))
+ ((get-text-property (point) 'org-agenda-date-header)
+ (setq in-date t)
+ (insert "** "))
+ ((setq m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker)))
+ (setq sexp (member (get-text-property (point) 'type)
+ '("diary" "sexp")))
+ (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t))
+ (progn
+ (setq prefix (org-trim (buffer-substring
+ (point) pl))
+ line (org-trim (buffer-substring
+ pl
+ (point-at-eol))))
+ (delete-region (point-at-bol) (point-at-eol))
+ (insert line "<before>" prefix "</before>")
+ (beginning-of-line 1))
+ (and (looking-at "[ \t]+") (replace-match "")))
+ (insert (if in-date "*** " "** "))
+ (end-of-line 1)
+ (insert "\n")
+ (unless sexp
+ (insert (org-agenda-get-some-entry-text
+ m 10 " " 'planning)
+ "\n")
+ (when (setq id
+ (if (org-bound-and-true-p
+ org-mobile-force-id-on-agenda-items)
+ (org-id-get m 'create)
+ (or (org-entry-get m "ID")
+ (org-mobile-get-outline-path-link m))))
+ (insert " :PROPERTIES:\n :ORIGINAL_ID: " id
+ "\n :END:\n")))))
+ (beginning-of-line 2))
+ (push (cons "agendas.org" (md5 (buffer-string)))
+ org-mobile-checksum-files))
+ (message "Agenda written to Org file %s" file)))
+
+(defun org-mobile-get-outline-path-link (pom)
+ (org-with-point-at pom
+ (concat "olp:"
+ (org-mobile-escape-olp (file-name-nondirectory buffer-file-name))
+ "/"
+ (mapconcat 'org-mobile-escape-olp
+ (org-get-outline-path)
+ "/")
+ "/"
+ (org-mobile-escape-olp (nth 4 (org-heading-components))))))
+
+(defun org-mobile-escape-olp (s)
+ (let ((table '(?: ?/)))
+ (org-link-escape s table)))
+
+;;;###autoload
+(defun org-mobile-create-sumo-agenda ()
+ "Create a file that contains all custom agenda views."
+ (interactive)
+ (let* ((file (expand-file-name "agendas.org"
+ org-mobile-directory))
+ (file1 (if org-mobile-use-encryption
+ org-mobile-encryption-tempfile
+ file))
+ (sumo (org-mobile-sumo-agenda-command))
+ (org-agenda-custom-commands
+ (list (append sumo (list (list file1)))))
+ (org-mobile-creating-agendas t))
+ (unless (file-writable-p file1)
+ (error "Cannot write to file %s" file1))
+ (when sumo
+ (org-store-agenda-views))
+ (when org-mobile-use-encryption
+ (org-mobile-encrypt-and-move file1 file)
+ (delete-file file1)
+ (org-mobile-cleanup-encryption-tempfile))))
+
+(defun org-mobile-encrypt-and-move (infile outfile)
+ "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE.
+We do this in two steps so that remote paths will work, even if the
+encryption program does not understand them."
+ (let ((encfile (concat infile "_enc")))
+ (org-mobile-encrypt-file infile encfile)
+ (when outfile
+ (copy-file encfile outfile 'ok-if-exists)
+ (delete-file encfile))))
+
+(defun org-mobile-encrypt-file (infile outfile)
+ "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
+ (shell-command
+ (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
+ (shell-quote-argument (concat "pass:"
+ (org-mobile-encryption-password)))
+ (shell-quote-argument (expand-file-name infile))
+ (shell-quote-argument (expand-file-name outfile)))))
+
+(defun org-mobile-decrypt-file (infile outfile)
+ "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
+ (shell-command
+ (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
+ (shell-quote-argument (concat "pass:"
+ (org-mobile-encryption-password)))
+ (shell-quote-argument (expand-file-name infile))
+ (shell-quote-argument (expand-file-name outfile)))))
+
+(defun org-mobile-cleanup-encryption-tempfile ()
+ "Remove the encryption tempfile if it exists."
+ (and (stringp org-mobile-encryption-tempfile)
+ (file-exists-p org-mobile-encryption-tempfile)
+ (delete-file org-mobile-encryption-tempfile)))
+
+(defun org-mobile-move-capture ()
+ "Move the contents of the capture file to the inbox file.
+Return a marker to the location where the new content has been added.
+If nothing new has been added, return nil."
+ (interactive)
+ (let* ((encfile nil)
+ (capture-file (expand-file-name org-mobile-capture-file
+ org-mobile-directory))
+ (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
+ (capture-buffer
+ (if (not org-mobile-use-encryption)
+ (find-file-noselect capture-file)
+ (org-mobile-cleanup-encryption-tempfile)
+ (setq encfile (concat org-mobile-encryption-tempfile "_enc"))
+ (copy-file capture-file encfile)
+ (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)
+ (find-file-noselect org-mobile-encryption-tempfile)))
+ (insertion-point (make-marker))
+ not-empty content)
+ (with-current-buffer capture-buffer
+ (setq content (buffer-string))
+ (setq not-empty (string-match "\\S-" content))
+ (when not-empty
+ (set-buffer inbox-buffer)
+ (widen)
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (move-marker insertion-point
+ (prog1 (point) (insert content)))
+ (save-buffer)
+ (set-buffer capture-buffer)
+ (erase-buffer)
+ (save-buffer)
+ (org-mobile-update-checksum-for-capture-file (buffer-string))))
+ (kill-buffer capture-buffer)
+ (when org-mobile-use-encryption
+ (org-mobile-encrypt-and-move org-mobile-encryption-tempfile
+ capture-file)
+ (org-mobile-cleanup-encryption-tempfile))
+ (if not-empty insertion-point)))
+
+(defun org-mobile-update-checksum-for-capture-file (buffer-string)
+ "Find the checksum line and modify it to match BUFFER-STRING."
+ (let* ((file (expand-file-name "checksums.dat" org-mobile-directory))
+ (buffer (find-file-noselect file)))
+ (when buffer
+ (with-current-buffer buffer
+ (when (re-search-forward (concat "\\([0-9a-fA-F]\\{30,\\}\\).*?"
+ (regexp-quote org-mobile-capture-file)
+ "[ \t]*$") nil t)
+ (goto-char (match-beginning 1))
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (md5 buffer-string))
+ (save-buffer)))
+ (kill-buffer buffer))))
+
+(defun org-mobile-apply (&optional beg end)
+ "Apply all change requests in the current buffer.
+If BEG and END are given, only do this in that region."
+ (interactive)
+ (require 'org-archive)
+ (setq org-mobile-last-flagged-files nil)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+
+ ;; Remove all Note IDs
+ (goto-char beg)
+ (while (re-search-forward "^\\*\\* Note ID: [-0-9A-F]+[ \t]*\n" end t)
+ (replace-match ""))
+
+ ;; Find all the referenced entries, without making any changes yet
+ (let ((marker (make-marker))
+ (bos-marker (make-marker))
+ (end (move-marker (make-marker) end))
+ (cnt-new 0)
+ (cnt-edit 0)
+ (cnt-flag 0)
+ (cnt-error 0)
+ buf-list
+ id-pos org-mobile-error)
+
+ ;; Count the new captures
+ (goto-char beg)
+ (while (re-search-forward "^\\* \\(.*\\)" end t)
+ (and (>= (- (match-end 1) (match-beginning 1)) 2)
+ (not (equal (downcase (substring (match-string 1) 0 2)) "f("))
+ (incf cnt-new)))
+
+ ;; Find and apply the edits
+ (goto-char beg)
+ (while (re-search-forward
+ "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t)
+ (catch 'next
+ (let* ((action (match-string 1))
+ (data (and (match-end 3) (match-string 3)))
+ (id-pos (condition-case msg
+ (org-mobile-locate-entry (match-string 4))
+ (error (nth 1 msg))))
+ (bos (point-at-bol))
+ (eos (save-excursion (org-end-of-subtree t t)))
+ (cmd (if (equal action "")
+ '(progn
+ (incf cnt-flag)
+ (org-toggle-tag "FLAGGED" 'on)
+ (and note
+ (org-entry-put nil "THEFLAGGINGNOTE" note)))
+ (incf cnt-edit)
+ (cdr (assoc action org-mobile-action-alist))))
+ (note (and (equal action "")
+ (buffer-substring (1+ (point-at-eol)) eos)))
+ (org-inhibit-logging 'note) ;; Do not take notes interactively
+ old new)
+
+ (goto-char bos)
+ (when (and (markerp id-pos)
+ (not (member (marker-buffer id-pos) buf-list)))
+ (org-mobile-timestamp-buffer (marker-buffer id-pos))
+ (push (marker-buffer id-pos) buf-list))
+ (unless (markerp id-pos)
+ (goto-char (+ 2 (point-at-bol)))
+ (if (stringp id-pos)
+ (insert id-pos " ")
+ (insert "BAD REFERENCE "))
+ (incf cnt-error)
+ (throw 'next t))
+ (unless cmd
+ (insert "BAD FLAG ")
+ (incf cnt-error)
+ (throw 'next t))
+ (move-marker bos-marker (point))
+ (if (re-search-forward "^** Old value[ \t]*$" eos t)
+ (setq old (buffer-substring
+ (1+ (match-end 0))
+ (progn (outline-next-heading) (point)))))
+ (if (re-search-forward "^** New value[ \t]*$" eos t)
+ (setq new (buffer-substring
+ (1+ (match-end 0))
+ (progn (outline-next-heading)
+ (if (eobp) (org-back-over-empty-lines))
+ (point)))))
+ (setq old (and old (if (string-match "\\S-" old) old nil)))
+ (setq new (and new (if (string-match "\\S-" new) new nil)))
+ (if (and note (> (length note) 0))
+ ;; Make Note into a single line, to fit into a property
+ (setq note (mapconcat 'identity
+ (org-split-string (org-trim note) "\n")
+ "\\n")))
+ (unless (equal data "body")
+ (setq new (and new (org-trim new))
+ old (and old (org-trim old))))
+ (goto-char (+ 2 bos-marker))
+ ;; Remember this place so that we can return
+ (move-marker marker (point))
+ (setq org-mobile-error nil)
+ (save-excursion
+ (condition-case msg
+ (org-with-point-at id-pos
+ (progn
+ (eval cmd)
+ (unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
+ (if (member "FLAGGED" (org-get-tags))
+ (add-to-list 'org-mobile-last-flagged-files
+ (buffer-file-name (current-buffer)))))))
+ (error (setq org-mobile-error msg))))
+ (when org-mobile-error
+ (org-pop-to-buffer-same-window (marker-buffer marker))
+ (goto-char marker)
+ (incf cnt-error)
+ (insert (if (stringp (nth 1 org-mobile-error))
+ (nth 1 org-mobile-error)
+ "EXECUTION FAILED")
+ " ")
+ (throw 'next t))
+ ;; If we get here, the action has been applied successfully
+ ;; So remove the entry
+ (goto-char bos-marker)
+ (delete-region (point) (org-end-of-subtree t t)))))
+ (save-buffer)
+ (move-marker marker nil)
+ (move-marker end nil)
+ (message "%d new, %d edits, %d flags, %d errors" cnt-new
+ cnt-edit cnt-flag cnt-error)
+ (sit-for 1)))
+
+(defun org-mobile-timestamp-buffer (buf)
+ "Time stamp buffer BUF, just to make sure its checksum will change."
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ "^\\([ \t]*\\)#\\+LAST_MOBILE_CHANGE:.*\n?" nil t)
+ (progn
+ (goto-char (match-end 1))
+ (delete-region (point) (match-end 0)))
+ (if (looking-at ".*?-\\*-.*-\\*-")
+ (forward-line 1)))
+ (insert "#+LAST_MOBILE_CHANGE: "
+ (format-time-string "%Y-%m-%d %T") "\n")))))
+
+(defun org-mobile-smart-read ()
+ "Parse the entry at point for shortcuts and expand them.
+These shortcuts are meant for fast and easy typing on the limited
+keyboards of a mobile device. Below we show a list of the shortcuts
+currently implemented.
+
+The entry is expected to contain an inactive time stamp indicating when
+the entry was created. When setting dates and
+times (for example for deadlines), the time strings are interpreted
+relative to that creation date.
+Abbreviations are expected to take up entire lines, just because it is so
+easy to type RET on a mobile device. Abbreviations start with one or two
+letters, followed immediately by a dot and then additional information.
+Generally the entire shortcut line is removed after action have been taken.
+Time stamps will be constructed using `org-read-date'. So for example a
+line \"dd. 2tue\" will set a deadline on the second Tuesday after the
+creation date.
+
+Here are the shortcuts currently implemented:
+
+dd. string set deadline
+ss. string set scheduling
+tt. string set time tamp, here.
+ti. string set inactive time
+
+tg. tag1 tag2 tag3 set all these tags, change case where necessary
+td. kwd set this todo keyword, change case where necessary
+
+FIXME: Hmmm, not sure if we can make his work against the
+auto-correction feature. Needs a bit more thinking. So this function
+is currently a noop.")
+
+(defun org-mobile-locate-entry (link)
+ (if (string-match "\\`id:\\(.*\\)$" link)
+ (org-id-find (match-string 1 link) 'marker)
+ (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
+ ; not found with path, but maybe it is to be inserted
+ ; in top level of the file?
+ (if (not (string-match "\\`olp:\\(.*?\\)$" link))
+ nil
+ (let ((file (match-string 1 link)))
+ (setq file (org-link-unescape file))
+ (setq file (expand-file-name file org-directory))
+ (save-excursion
+ (find-file file)
+ (goto-char (point-max))
+ (newline)
+ (goto-char (point-max))
+ (move-marker (make-marker) (point)))))
+ (let ((file (match-string 1 link))
+ (path (match-string 2 link)))
+ (setq file (org-link-unescape file))
+ (setq file (expand-file-name file org-directory))
+ (setq path (mapcar 'org-link-unescape
+ (org-split-string path "/")))
+ (org-find-olp (cons file path))))))
+
+(defun org-mobile-edit (what old new)
+ "Edit item WHAT in the current entry by replacing OLD with NEW.
+WHAT can be \"heading\", \"todo\", \"tags\", \"priority\", or \"body\".
+The edit only takes place if the current value is equal (except for
+white space) the OLD. If this is so, OLD will be replace by NEW
+and the command will return t. If something goes wrong, a string will
+be returned that indicates what went wrong."
+ (let (current old1 new1 level)
+ (if (stringp what) (setq what (intern what)))
+
+ (cond
+
+ ((memq what '(todo todostate))
+ (setq current (org-get-todo-state))
+ (cond
+ ((equal new "DONEARCHIVE")
+ (org-todo 'done)
+ (org-archive-subtree-default))
+ ((equal new current) t) ; nothing needs to be done
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'todo org-mobile-force-mobile-change))
+ (org-todo (or new 'none)) t)
+ (t (error "State before change was expected as \"%s\", but is \"%s\""
+ old current))))
+
+ ((eq what 'tags)
+ (setq current (org-get-tags)
+ new1 (and new (org-split-string new ":+"))
+ old1 (and old (org-split-string old ":+")))
+ (cond
+ ((org-mobile-tags-same-p current new1) t) ; no change needed
+ ((or (org-mobile-tags-same-p current old1)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'tags org-mobile-force-mobile-change))
+ (org-set-tags-to new1) t)
+ (t (error "Tags before change were expected as \"%s\", but are \"%s\""
+ (or old "") (or current "")))))
+
+ ((eq what 'priority)
+ (when (looking-at org-complex-heading-regexp)
+ (setq current (and (match-end 3) (substring (match-string 3) 2 3)))
+ (cond
+ ((equal current new) t) ; no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'tags org-mobile-force-mobile-change))
+ (org-priority (and new (string-to-char new))))
+ (t (error "Priority was expected to be %s, but is %s"
+ old current)))))
+
+ ((eq what 'heading)
+ (when (looking-at org-complex-heading-regexp)
+ (setq current (match-string 4))
+ (cond
+ ((equal current new) t) ; no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'heading org-mobile-force-mobile-change))
+ (goto-char (match-beginning 4))
+ (insert new)
+ (delete-region (point) (+ (point) (length current)))
+ (org-set-tags nil 'align))
+ (t (error "Heading changed in MobileOrg and on the computer")))))
+
+ ((eq what 'addheading)
+ (if (org-on-heading-p) ; if false we are in top-level of file
+ (progn
+ (end-of-line 1)
+ (org-insert-heading-respect-content)
+ (org-demote))
+ (beginning-of-line)
+ (insert "* "))
+ (insert new))
+
+ ((eq what 'refile)
+ (org-copy-subtree)
+ (org-with-point-at (org-mobile-locate-entry new)
+ (if (org-on-heading-p) ; if false we are in top-level of file
+ (progn
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (org-end-of-subtree t t)
+ (org-paste-subtree level))
+ (org-paste-subtree 1)))
+ (org-cut-subtree))
+
+ ((eq what 'delete)
+ (org-cut-subtree))
+
+ ((eq what 'archive)
+ (org-archive-subtree))
+
+ ((eq what 'archive-sibling)
+ (org-archive-to-archive-sibling))
+
+ ((eq what 'body)
+ (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
+ (save-excursion (outline-next-heading)
+ (point))))
+ (if (not (string-match "\\S-" current)) (setq current nil))
+ (cond
+ ((org-mobile-bodies-same-p current new) t) ; no action necessary
+ ((or (org-mobile-bodies-same-p current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'body org-mobile-force-mobile-change))
+ (save-excursion
+ (end-of-line 1)
+ (insert "\n" new)
+ (or (bolp) (insert "\n"))
+ (delete-region (point) (progn (org-back-to-heading t)
+ (outline-next-heading)
+ (point))))
+ t)
+ (t (error "Body was changed in MobileOrg and on the computer")))))))
+
+(defun org-mobile-tags-same-p (list1 list2)
+ "Are the two tag lists the same?"
+ (not (or (org-delete-all list1 list2)
+ (org-delete-all list2 list1))))
+
+(defun org-mobile-bodies-same-p (a b)
+ "Compare if A and B are visually equal strings.
+We first remove leading and trailing white space from the entire strings.
+Then we split the strings into lines and remove leading/trailing whitespace
+from each line. Then we compare.
+A and B must be strings or nil."
+ (cond
+ ((and (not a) (not b)) t)
+ ((or (not a) (not b)) nil)
+ (t (setq a (org-trim a) b (org-trim b))
+ (setq a (mapconcat 'identity (org-split-string a "[ \t]*\n[ \t]*") "\n"))
+ (setq b (mapconcat 'identity (org-split-string b "[ \t]*\n[ \t]*") "\n"))
+ (equal a b))))
+
+(provide 'org-mobile)
+
+;;; org-mobile.el ends here
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
new file mode 100644
index 0000000..b5a6dad
--- /dev/null
+++ b/lisp/org-mouse.el
@@ -0,0 +1,1107 @@
+;;; org-mouse.el --- Better mouse support for org-mode
+
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
+;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Org-mouse provides mouse support for org-mode.
+;;
+;; http://orgmode.org
+;;
+;; Org-mouse implements the following features:
+;; * following links with the left mouse button (in Emacs 22)
+;; * subtree expansion/collapse (org-cycle) with the left mouse button
+;; * several context menus on the right mouse button:
+;; + general text
+;; + headlines
+;; + timestamps
+;; + priorities
+;; + links
+;; + tags
+;; * promoting/demoting/moving subtrees with mouse-3
+;; + if the drag starts and ends in the same line then promote/demote
+;; + otherwise move the subtree
+;;
+;; Use
+;; ---
+;;
+;; To use this package, put the following line in your .emacs:
+;;
+;; (require 'org-mouse)
+;;
+
+;; FIXME:
+;; + deal with folding / unfolding issues
+
+;; TODO (This list is only theoretical, if you'd like to have some
+;; feature implemented or a bug fix please send me an email, even if
+;; something similar appears in the list below. This will help me get
+;; the priorities right.):
+;;
+;; + org-store-link, insert link
+;; + org tables
+;; + occur with the current word/tag (same menu item)
+;; + ctrl-c ctrl-c, for example, renumber the current list
+;; + internal links
+
+;; Please email the maintainer with new feature suggestions / bugs
+
+;; History:
+;;
+;; Since version 5.10: Changes are listed in the general org-mode docs.
+;;
+;; Version 5.09;; + Version number synchronization with Org-mode.
+;;
+;; Version 0.25
+;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
+;;
+;; Version 0.24
+;; + minor changes to the table menu
+;;
+;; Version 0.23
+;; + preliminary support for tables and calculation marks
+;; + context menu support for org-agenda-undo & org-sort-entries
+;;
+;; Version 0.22
+;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
+;;
+;; Version 0.21
+;; + selected text activates its context menu
+;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link
+;;
+;; Version 0.20
+;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
+;; + the TODO menu can now list occurrences of a specific TODO keyword
+;; + #+STARTUP line is now recognized
+;;
+;; Version 0.19
+;; + added support for dragging URLs to the org-buffer
+;;
+;; Version 0.18
+;; + added support for agenda blocks
+;;
+;; Version 0.17
+;; + toggle checkboxes with a single click
+;;
+;; Version 0.16
+;; + added support for checkboxes
+;;
+;; Version 0.15
+;; + org-mode now works with the Agenda buffer as well
+;;
+;; Version 0.14
+;; + added a menu option that converts plain list items to outline items
+;;
+;; Version 0.13
+;; + "Insert Heading" now inserts a sibling heading if the point is
+;; on "***" and a child heading otherwise
+;;
+;; Version 0.12
+;; + compatible with Emacs 21
+;; + custom agenda commands added to the main menu
+;; + moving trees should now work between windows in the same frame
+;;
+;; Version 0.11
+;; + fixed org-mouse-at-link (thanks to Carsten)
+;; + removed [follow-link] bindings
+;;
+;; Version 0.10
+;; + added a menu option to remove highlights
+;; + compatible with org-mode 4.21 now
+;;
+;; Version 0.08:
+;; + trees can be moved/promoted/demoted by dragging with the right
+;; mouse button (mouse-3)
+;; + small changes in the above function
+;;
+;; Versions 0.01 -- 0.07: (I don't remember)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org)
+
+(defvar org-agenda-allow-remote-undo)
+(defvar org-agenda-undo-list)
+(defvar org-agenda-custom-commands)
+(declare-function org-agenda-change-all-lines "org-agenda"
+ (newhead hdmarker &optional fixface just-this))
+(declare-function org-verify-change-for-undo "org-agenda" (l1 l2))
+(declare-function org-apply-on-list "org-list" (function init-value &rest args))
+(declare-function org-agenda-earlier "org-agenda" (arg))
+(declare-function org-agenda-later "org-agenda" (arg))
+
+(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
+ "Regular expression that matches a plain list.")
+(defvar org-mouse-direct t
+ "Internal variable indicating whether the current action is direct.
+
+If t, then the current action has been invoked directly through the buffer
+it is intended to operate on. If nil, then the action has been invoked
+indirectly, for example, through the agenda buffer.")
+
+(defgroup org-mouse nil
+ "Mouse support for org-mode."
+ :tag "Org Mouse"
+ :group 'org)
+
+(defcustom org-mouse-punctuation ":"
+ "Punctuation used when inserting text by drag and drop."
+ :group 'org-mouse
+ :type 'string)
+
+(defcustom org-mouse-features
+ '(context-menu yank-link activate-stars activate-bullets activate-checkboxes)
+ "The features of org-mouse that should be activated.
+Changing this variable requires a restart of Emacs to get activated."
+ :group 'org-mouse
+ :type '(set :greedy t
+ (const :tag "Mouse-3 shows context menu" context-menu)
+ (const :tag "C-mouse-1 and mouse-3 move trees" move-tree)
+ (const :tag "S-mouse-2 and drag-mouse-3 yank link" yank-link)
+ (const :tag "Activate headline stars" activate-stars)
+ (const :tag "Activate item bullets" activate-bullets)
+ (const :tag "Activate checkboxes" activate-checkboxes)))
+
+(defun org-mouse-re-search-line (regexp)
+ "Search the current line for a given regular expression."
+ (beginning-of-line)
+ (re-search-forward regexp (point-at-eol) t))
+
+(defun org-mouse-end-headline ()
+ "Go to the end of current headline (ignoring tags)."
+ (interactive)
+ (end-of-line)
+ (skip-chars-backward "\t ")
+ (when (org-looking-back ":[A-Za-z]+:")
+ (skip-chars-backward ":A-Za-z")
+ (skip-chars-backward "\t ")))
+
+(defvar org-mouse-context-menu-function nil
+ "Function to create the context menu.
+The value of this variable is the function invoked by
+`org-mouse-context-menu' as the context menu.")
+(make-variable-buffer-local 'org-mouse-context-menu-function)
+
+(defun org-mouse-show-context-menu (event prefix)
+ "Invoke the context menu.
+
+If the value of `org-mouse-context-menu-function' is a function, then
+this function is called. Otherwise, the current major mode menu is used."
+ (interactive "@e \nP")
+ (if (and (= (event-click-count event) 1)
+ (or (not mark-active)
+ (sit-for (/ double-click-time 1000.0))))
+ (progn
+ (select-window (posn-window (event-start event)))
+ (when (not (org-mouse-mark-active))
+ (goto-char (posn-point (event-start event)))
+ (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
+ (let ((redisplay-dont-pause t))
+ (sit-for 0)))
+ (if (functionp org-mouse-context-menu-function)
+ (funcall org-mouse-context-menu-function event)
+ (if (fboundp 'mouse-menu-major-mode-map)
+ (popup-menu (mouse-menu-major-mode-map) event prefix)
+ (org-no-warnings ; don't warn about fallback, obsolete since 23.1
+ (mouse-major-mode-menu event prefix)))))
+ (setq this-command 'mouse-save-then-kill)
+ (mouse-save-then-kill event)))
+
+(defun org-mouse-line-position ()
+ "Return `:beginning' or `:middle' or `:end', depending on the point position.
+
+If the point is at the end of the line, return `:end'.
+If the point is separated from the beginning of the line only by white
+space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise,
+return `:middle'."
+ (cond
+ ((eolp) :end)
+ ((org-mouse-bolp) :beginning)
+ (t :middle)))
+
+(defun org-mouse-empty-line ()
+ "Return non-nil iff the line contains only white space."
+ (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
+
+(defun org-mouse-next-heading ()
+ "Go to the next heading.
+If there is none, ensure that the point is at the beginning of an empty line."
+ (unless (outline-next-heading)
+ (beginning-of-line)
+ (unless (org-mouse-empty-line)
+ (end-of-line)
+ (newline))))
+
+(defun org-mouse-insert-heading ()
+ "Insert a new heading, as `org-insert-heading'.
+
+If the point is at the :beginning (`org-mouse-line-position') of the line,
+insert the new heading before the current line. Otherwise, insert it
+after the current heading."
+ (interactive)
+ (case (org-mouse-line-position)
+ (:beginning (beginning-of-line)
+ (org-insert-heading))
+ (t (org-mouse-next-heading)
+ (org-insert-heading))))
+
+(defun org-mouse-timestamp-today (&optional shift units)
+ "Change the timestamp into SHIFT UNITS in the future.
+
+For the acceptable UNITS, see `org-timestamp-change'."
+ (interactive)
+ (org-time-stamp nil)
+ (when shift (org-timestamp-change shift units)))
+
+(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
+ "A helper function.
+
+Returns a menu fragment consisting of KEYWORDS. When a keyword
+is selected by the user, FUNCTION is called with the selected
+keyword as the only argument.
+
+If SELECTED is nil, then all items are normal menu items. If
+SELECTED is a function, then each item is a checkbox, which is
+enabled for a given keyword iff (funcall SELECTED keyword) return
+non-nil. If SELECTED is neither nil nor a function, then the
+items are radio buttons. A radio button is enabled for the
+keyword `equal' to SELECTED.
+
+ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
+is a function, it is invoked with the keyword as the only
+argument. If it is a string, it is interpreted as the format
+string to (format ITEMFORMAT keyword). If it is neither a string
+nor a function, elements of KEYWORDS are used directly."
+ (mapcar
+ `(lambda (keyword)
+ (vector (cond
+ ((functionp ,itemformat) (funcall ,itemformat keyword))
+ ((stringp ,itemformat) (format ,itemformat keyword))
+ (t keyword))
+ (list 'funcall ,function keyword)
+ :style (cond
+ ((null ,selected) t)
+ ((functionp ,selected) 'toggle)
+ (t 'radio))
+ :selected (if (functionp ,selected)
+ (and (funcall ,selected keyword) t)
+ (equal ,selected keyword))))
+ keywords))
+
+(defun org-mouse-remove-match-and-spaces ()
+ "Remove the match, make just one space around the point."
+ (interactive)
+ (replace-match "")
+ (just-one-space))
+
+(defvar org-mouse-rest)
+(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
+ literal string subexp)
+ "The same as `replace-match', but surrounds the replacement with spaces."
+ (apply 'replace-match org-mouse-rest)
+ (save-excursion
+ (goto-char (match-beginning (or subexp 0)))
+ (just-one-space)
+ (goto-char (match-end (or subexp 0)))
+ (just-one-space)))
+
+(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
+ nosurround)
+ "A helper function.
+
+Returns a menu fragment consisting of KEYWORDS. When a keyword
+is selected, group GROUP of the current match is replaced by the
+keyword. The method ensures that both ends of the replacement
+are separated from the rest of the text in the buffer by
+individual spaces (unless NOSURROUND is non-nil).
+
+The final entry of the menu is always \"None\", which removes the
+match.
+
+ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
+is a function, it is invoked with the keyword as the only
+argument. If it is a string, it is interpreted as the format
+string to (format ITEMFORMAT keyword). If it is neither a string
+nor a function, elements of KEYWORDS are used directly."
+ (setq group (or group 0))
+ (let ((replace (org-mouse-match-closure
+ (if nosurround 'replace-match
+ 'org-mouse-replace-match-and-surround))))
+ (append
+ (org-mouse-keyword-menu
+ keywords
+ `(lambda (keyword) (funcall ,replace keyword t t nil ,group))
+ (match-string group)
+ itemformat)
+ `(["None" org-mouse-remove-match-and-spaces
+ :style radio
+ :selected ,(not (member (match-string group) keywords))]))))
+
+(defun org-mouse-show-headlines ()
+ "Change the visibility of the current org buffer to only show headlines."
+ (interactive)
+ (let ((this-command 'org-cycle)
+ (last-command 'org-cycle)
+ (org-cycle-global-status nil))
+ (org-cycle '(4))
+ (org-cycle '(4))))
+
+(defun org-mouse-show-overview ()
+ "Change visibility of current org buffer to first-level headlines only."
+ (interactive)
+ (let ((org-cycle-global-status nil))
+ (org-cycle '(4))))
+
+(defun org-mouse-set-priority (priority)
+ "Set the priority of the current headline to PRIORITY."
+ (org-priority priority))
+
+(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
+ "Regular expression matching the priority indicator.
+Differs from `org-priority-regexp' in that it doesn't contain the
+leading '.*?'.")
+
+(defun org-mouse-get-priority (&optional default)
+ "Return the priority of the current headline.
+DEFAULT is returned if no priority is given in the headline."
+ (save-excursion
+ (if (org-mouse-re-search-line org-mouse-priority-regexp)
+ (match-string 1)
+ (when default (char-to-string org-default-priority)))))
+
+(defun org-mouse-delete-timestamp ()
+ "Deletes the current timestamp as well as the preceding keyword.
+SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
+ (when (or (org-at-date-range-p) (org-at-timestamp-p))
+ (replace-match "") ; delete the timestamp
+ (skip-chars-backward " :A-Z")
+ (when (looking-at " *[A-Z][A-Z]+:")
+ (replace-match ""))))
+
+(defun org-mouse-looking-at (regexp skipchars &optional movechars)
+ (save-excursion
+ (let ((point (point)))
+ (if (looking-at regexp) t
+ (skip-chars-backward skipchars)
+ (forward-char (or movechars 0))
+ (when (looking-at regexp)
+ (> (match-end 0) point))))))
+
+(defun org-mouse-priority-list ()
+ (loop for priority from ?A to org-lowest-priority
+ collect (char-to-string priority)))
+
+(defun org-mouse-todo-menu (state)
+ "Create the menu with TODO keywords."
+ (append
+ (let ((kwds org-todo-keywords-1))
+ (org-mouse-keyword-menu
+ kwds
+ `(lambda (kwd) (org-todo kwd))
+ (lambda (kwd) (equal state kwd))))))
+
+(defun org-mouse-tag-menu () ;todo
+ "Create the tags menu."
+ (append
+ (let ((tags (org-get-tags)))
+ (org-mouse-keyword-menu
+ (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
+ `(lambda (tag)
+ (org-mouse-set-tags
+ (sort (if (member tag (quote ,tags))
+ (delete tag (quote ,tags))
+ (cons tag (quote ,tags)))
+ 'string-lessp)))
+ `(lambda (tag) (member tag (quote ,tags)))
+ ))
+ '("--"
+ ["Align Tags Here" (org-set-tags nil t) t]
+ ["Align Tags in Buffer" (org-set-tags t t) t]
+ ["Set Tags ..." (org-set-tags) t])))
+
+(defun org-mouse-set-tags (tags)
+ (save-excursion
+ ;; remove existing tags first
+ (beginning-of-line)
+ (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
+ (replace-match ""))
+
+ ;; set new tags if any
+ (when tags
+ (end-of-line)
+ (insert " :" (mapconcat 'identity tags ":") ":")
+ (org-set-tags nil t))))
+
+(defun org-mouse-insert-checkbox ()
+ (interactive)
+ (and (org-at-item-p)
+ (goto-char (match-end 0))
+ (unless (org-at-item-checkbox-p)
+ (delete-horizontal-space)
+ (insert " [ ] "))))
+
+(defun org-mouse-agenda-type (type)
+ (case type
+ ('tags "Tags: ")
+ ('todo "TODO: ")
+ ('tags-tree "Tags tree: ")
+ ('todo-tree "TODO tree: ")
+ ('occur-tree "Occur tree: ")
+ (t "Agenda command ???")))
+
+(defun org-mouse-list-options-menu (alloptions &optional function)
+ (let ((options (save-match-data
+ (split-string (match-string-no-properties 1)))))
+ (print options)
+ (loop for name in alloptions
+ collect
+ (vector name
+ `(progn
+ (replace-match
+ (mapconcat 'identity
+ (sort (if (member ',name ',options)
+ (delete ',name ',options)
+ (cons ',name ',options))
+ 'string-lessp)
+ " ")
+ nil nil nil 1)
+ (when (functionp ',function) (funcall ',function)))
+ :style 'toggle
+ :selected (and (member name options) t)))))
+
+(defun org-mouse-clip-text (text maxlength)
+ (if (> (length text) maxlength)
+ (concat (substring text 0 (- maxlength 3)) "...")
+ text))
+
+(defun org-mouse-popup-global-menu ()
+ (popup-menu
+ `("Main Menu"
+ ["Show Overview" org-mouse-show-overview t]
+ ["Show Headlines" org-mouse-show-headlines t]
+ ["Show All" show-all t]
+ ["Remove Highlights" org-remove-occur-highlights
+ :visible org-occur-highlights]
+ "--"
+ ["Check Deadlines"
+ (if (functionp 'org-check-deadlines-and-todos)
+ (org-check-deadlines-and-todos org-deadline-warning-days)
+ (org-check-deadlines org-deadline-warning-days)) t]
+ ["Check TODOs" org-show-todo-tree t]
+ ("Check Tags"
+ ,@(org-mouse-keyword-menu
+ (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
+ #'(lambda (tag) (org-tags-sparse-tree nil tag)))
+ "--"
+ ["Custom Tag ..." org-tags-sparse-tree t])
+ ["Check Phrase ..." org-occur]
+ "--"
+ ["Display Agenda" org-agenda-list t]
+ ["Display Timeline" org-timeline t]
+ ["Display TODO List" org-todo-list t]
+ ("Display Tags"
+ ,@(org-mouse-keyword-menu
+ (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
+ #'(lambda (tag) (org-tags-view nil tag)))
+ "--"
+ ["Custom Tag ..." org-tags-view t])
+ ["Display Calendar" org-goto-calendar t]
+ "--"
+ ,@(org-mouse-keyword-menu
+ (mapcar 'car org-agenda-custom-commands)
+ #'(lambda (key)
+ (eval `(org-agenda nil (string-to-char ,key))))
+ nil
+ #'(lambda (key)
+ (let ((entry (assoc key org-agenda-custom-commands)))
+ (org-mouse-clip-text
+ (cond
+ ((stringp (nth 1 entry)) (nth 1 entry))
+ ((stringp (nth 2 entry))
+ (concat (org-mouse-agenda-type (nth 1 entry))
+ (nth 2 entry)))
+ (t "Agenda Command '%s'"))
+ 30))))
+ "--"
+ ["Delete Blank Lines" delete-blank-lines
+ :visible (org-mouse-empty-line)]
+ ["Insert Checkbox" org-mouse-insert-checkbox
+ :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
+ ["Insert Checkboxes"
+ (org-mouse-for-each-item 'org-mouse-insert-checkbox)
+ :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
+ ["Plain List to Outline" org-mouse-transform-to-outline
+ :visible (org-at-item-p)])))
+
+(defun org-mouse-get-context (contextlist context)
+ (let ((contextdata (assq context contextlist)))
+ (when contextdata
+ (save-excursion
+ (goto-char (second contextdata))
+ (re-search-forward ".*" (third contextdata))))))
+
+(defun org-mouse-for-each-item (funct)
+ ;; Functions called by `org-apply-on-list' need an argument
+ (let ((wrap-fun (lambda (c) (funcall funct))))
+ (when (ignore-errors (goto-char (org-in-item-p)))
+ (save-excursion (org-apply-on-list wrap-fun nil)))))
+
+(defun org-mouse-bolp ()
+ "Return true if there only spaces, tabs, and '*' before point.
+This means, between the beginning of line and the point."
+ (save-excursion
+ (skip-chars-backward " \t*") (bolp)))
+
+(defun org-mouse-insert-item (text)
+ (case (org-mouse-line-position)
+ (:beginning ; insert before
+ (beginning-of-line)
+ (looking-at "[ \t]*")
+ (open-line 1)
+ (org-indent-to-column (- (match-end 0) (match-beginning 0)))
+ (insert "+ "))
+ (:middle ; insert after
+ (end-of-line)
+ (newline t)
+ (indent-relative)
+ (insert "+ "))
+ (:end ; insert text here
+ (skip-chars-backward " \t")
+ (kill-region (point) (point-at-eol))
+ (unless (org-looking-back org-mouse-punctuation)
+ (insert (concat org-mouse-punctuation " ")))))
+ (insert text)
+ (beginning-of-line))
+
+(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
+ (if (derived-mode-p 'org-mode)
+ (org-mouse-insert-item text)
+ ad-do-it))
+
+(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
+ (if (derived-mode-p 'org-mode)
+ (org-mouse-insert-item uri)
+ ad-do-it))
+
+(defun org-mouse-match-closure (function)
+ (let ((match (match-data t)))
+ `(lambda (&rest rest)
+ (save-match-data
+ (set-match-data ',match)
+ (apply ',function rest)))))
+
+(defun org-mouse-yank-link (click)
+ (interactive "e")
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (mouse-set-point click)
+ (setq mouse-selection-click-count 0)
+ (delete-horizontal-space)
+ (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
+
+(defun org-mouse-context-menu (&optional event)
+ (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string))
+ (contextlist (org-context))
+ (get-context (lambda (context) (org-mouse-get-context contextlist context))))
+ (cond
+ ((org-mouse-mark-active)
+ (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (popup-menu
+ `(nil
+ ["Sparse Tree" (org-occur ',region-string)]
+ ["Find in Buffer" (occur ',region-string)]
+ ["Grep in Current Dir"
+ (grep (format "grep -rnH -e '%s' *" ',region-string))]
+ ["Grep in Parent Dir"
+ (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
+ "--"
+ ["Convert to Link"
+ (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
+ (save-excursion (goto-char (region-end)) (insert "]]")))]
+ ["Insert Link Here" (org-mouse-yank-link ',event)]))))
+ ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
+ 'org-mode-restart))))
+ ((or (eolp)
+ (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
+ (org-looking-back " \\|\t")))
+ (org-mouse-popup-global-menu))
+ ((funcall get-context :checkbox)
+ (popup-menu
+ '(nil
+ ["Toggle" org-toggle-checkbox t]
+ ["Remove" org-mouse-remove-match-and-spaces t]
+ ""
+ ["All Clear" (org-mouse-for-each-item
+ (lambda ()
+ (when (save-excursion (org-at-item-checkbox-p))
+ (replace-match "[ ]"))))]
+ ["All Set" (org-mouse-for-each-item
+ (lambda ()
+ (when (save-excursion (org-at-item-checkbox-p))
+ (replace-match "[X]"))))]
+ ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
+ ["All Remove" (org-mouse-for-each-item
+ (lambda ()
+ (when (save-excursion (org-at-item-checkbox-p))
+ (org-mouse-remove-match-and-spaces))))]
+ )))
+ ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
+ (member (match-string 0) org-todo-keywords-1))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-todo-menu (match-string 0))
+ "--"
+ ["Check TODOs" org-show-todo-tree t]
+ ["List all TODO keywords" org-todo-list t]
+ [,(format "List only %s" (match-string 0))
+ (org-todo-list (match-string 0)) t]
+ )))
+ ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
+ (member (match-string 0) stamp-prefixes))
+ (popup-menu
+ `(nil
+ ,@(org-mouse-keyword-replace-menu stamp-prefixes)
+ "--"
+ ["Check Deadlines" org-check-deadlines t]
+ )))
+ ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
+ (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+ (org-mouse-priority-list) 1 "Priority %s" t))))
+ ((funcall get-context :link)
+ (popup-menu
+ '(nil
+ ["Open" org-open-at-point t]
+ ["Open in Emacs" (org-open-at-point t) t]
+ "--"
+ ["Copy link" (org-kill-new (match-string 0))]
+ ["Cut link"
+ (progn
+ (kill-region (match-beginning 0) (match-end 0))
+ (just-one-space))]
+ "--"
+ ["Grep for TODOs"
+ (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
+ ; ["Paste file link" ((insert "file:") (yank))]
+ )))
+ ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
+ (popup-menu
+ `(nil
+ [,(format "Display '%s'" (match-string 1))
+ (org-tags-view nil ,(match-string 1))]
+ [,(format "Sparse Tree '%s'" (match-string 1))
+ (org-tags-sparse-tree nil ,(match-string 1))]
+ "--"
+ ,@(org-mouse-tag-menu))))
+ ((org-at-timestamp-p)
+ (popup-menu
+ '(nil
+ ["Show Day" org-open-at-point t]
+ ["Change Timestamp" org-time-stamp t]
+ ["Delete Timestamp" (org-mouse-delete-timestamp) t]
+ ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
+ "--"
+ ["Set for Today" org-mouse-timestamp-today]
+ ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
+ ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
+ ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
+ ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
+ "--"
+ ["+ 1 Day" (org-timestamp-change 1 'day)]
+ ["+ 1 Week" (org-timestamp-change 7 'day)]
+ ["+ 1 Month" (org-timestamp-change 1 'month)]
+ "--"
+ ["- 1 Day" (org-timestamp-change -1 'day)]
+ ["- 1 Week" (org-timestamp-change -7 'day)]
+ ["- 1 Month" (org-timestamp-change -1 'month)])))
+ ((funcall get-context :table-special)
+ (let ((mdata (match-data)))
+ (incf (car mdata) 2)
+ (store-match-data mdata))
+ (message "match: %S" (match-string 0))
+ (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+ '(" " "!" "^" "_" "$" "#" "*" "'") 0
+ (lambda (mark)
+ (case (string-to-char mark)
+ (? "( ) Nothing Special")
+ (?! "(!) Column Names")
+ (?^ "(^) Field Names Above")
+ (?_ "(^) Field Names Below")
+ (?$ "($) Formula Parameters")
+ (?# "(#) Recalculation: Auto")
+ (?* "(*) Recalculation: Manual")
+ (?' "(') Recalculation: None"))) t))))
+ ((assq :table contextlist)
+ (popup-menu
+ '(nil
+ ["Align Table" org-ctrl-c-ctrl-c]
+ ["Blank Field" org-table-blank-field]
+ ["Edit Field" org-table-edit-field]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft]
+ ["Move Column Right" org-metaright]
+ ["Delete Column" org-shiftmetaleft]
+ ["Insert Column" org-shiftmetaright]
+ "--"
+ ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
+ ("Row"
+ ["Move Row Up" org-metaup]
+ ["Move Row Down" org-metadown]
+ ["Delete Row" org-shiftmetaup]
+ ["Insert Row" org-shiftmetadown]
+ ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+ "--"
+ ["Insert Hline" org-table-insert-hline])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special]
+ ["Cut Rectangle" org-cut-special]
+ ["Paste Rectangle" org-paste-special]
+ ["Fill Rectangle" org-table-wrap-region])
+ "--"
+ ["Set Column Formula" org-table-eval-formula]
+ ["Set Field Formula" (org-table-eval-formula '(4))]
+ ["Edit Formulas" org-table-edit-formulas]
+ "--"
+ ["Recalculate Line" org-table-recalculate]
+ ["Recalculate All" (org-table-recalculate '(4))]
+ ["Iterate All" (org-table-recalculate '(16))]
+ "--"
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p))]
+ ["Field Info" org-table-field-info]
+ ["Debug Formulas"
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ :style toggle :selected org-table-formula-debug]
+ )))
+ ((and (assq :headline contextlist) (not (eolp)))
+ (let ((priority (org-mouse-get-priority t)))
+ (popup-menu
+ `("Headline Menu"
+ ("Tags and Priorities"
+ ,@(org-mouse-keyword-menu
+ (org-mouse-priority-list)
+ #'(lambda (keyword)
+ (org-mouse-set-priority (string-to-char keyword)))
+ priority "Priority %s")
+ "--"
+ ,@(org-mouse-tag-menu))
+ ("TODO Status"
+ ,@(org-mouse-todo-menu (org-get-todo-state)))
+ ["Show Tags"
+ (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
+ :visible (not org-mouse-direct)]
+ ["Show Priority"
+ (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
+ :visible (not org-mouse-direct)]
+ ,@(if org-mouse-direct '("--") nil)
+ ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
+ ["Set Deadline"
+ (progn (org-mouse-end-headline) (insert " ") (org-deadline))
+ :active (not (save-excursion
+ (org-mouse-re-search-line org-deadline-regexp)))]
+ ["Schedule Task"
+ (progn (org-mouse-end-headline) (insert " ") (org-schedule))
+ :active (not (save-excursion
+ (org-mouse-re-search-line org-scheduled-regexp)))]
+ ["Insert Timestamp"
+ (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
+ ; ["Timestamp (inactive)" org-time-stamp-inactive t]
+ "--"
+ ["Archive Subtree" org-archive-subtree]
+ ["Cut Subtree" org-cut-special]
+ ["Copy Subtree" org-copy-special]
+ ["Paste Subtree" org-paste-special :visible org-mouse-direct]
+ ("Sort Children"
+ ["Alphabetically" (org-sort-entries nil ?a)]
+ ["Numerically" (org-sort-entries nil ?n)]
+ ["By Time/Date" (org-sort-entries nil ?t)]
+ "--"
+ ["Reverse Alphabetically" (org-sort-entries nil ?A)]
+ ["Reverse Numerically" (org-sort-entries nil ?N)]
+ ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+ "--"
+ ["Move Trees" org-mouse-move-tree :active nil]
+ ))))
+ (t
+ (org-mouse-popup-global-menu)))))
+
+(defun org-mouse-mark-active ()
+ (and mark-active transient-mark-mode))
+
+(defun org-mouse-in-region-p (pos)
+ (and (org-mouse-mark-active)
+ (>= pos (region-beginning))
+ (< pos (region-end))))
+
+(defun org-mouse-down-mouse (event)
+ (interactive "e")
+ (setq this-command last-command)
+ (unless (and (= 1 (event-click-count event))
+ (org-mouse-in-region-p (posn-point (event-start event))))
+ (mouse-drag-region event)))
+
+(add-hook 'org-mode-hook
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-context-menu)
+
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [mouse-3] nil)
+ (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
+ (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
+ (when (memq 'context-menu org-mouse-features)
+ (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
+ (when (memq 'yank-link org-mouse-features)
+ (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
+ (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
+ (when (memq 'move-tree org-mouse-features)
+ (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
+ (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
+
+ (when (memq 'activate-stars org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `((,org-outline-regexp
+ 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
+ 'prepend))
+ t))
+
+ (when (memq 'activate-bullets org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
+ (1 `(face org-link keymap ,org-mouse-map mouse-face highlight)
+ 'prepend)))
+ t))
+
+ (when (memq 'activate-checkboxes org-mouse-features)
+ (font-lock-add-keywords
+ nil
+ `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
+ (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
+ t))
+
+ (defadvice org-open-at-point (around org-mouse-open-at-point activate)
+ (let ((context (org-context)))
+ (cond
+ ((assq :headline-stars context) (org-cycle))
+ ((assq :checkbox context) (org-toggle-checkbox))
+ ((assq :item-bullet context)
+ (let ((org-cycle-include-plain-lists t)) (org-cycle)))
+ ((org-footnote-at-reference-p) nil)
+ (t ad-do-it))))))
+
+(defun org-mouse-move-tree-start (event)
+ (interactive "e")
+ (message "Same line: promote/demote, (***):move before, (text): make a child"))
+
+
+(defun org-mouse-make-marker (position)
+ (with-current-buffer (window-buffer (posn-window position))
+ (copy-marker (posn-point position))))
+
+(defun org-mouse-move-tree (event)
+ ;; todo: handle movements between different buffers
+ (interactive "e")
+ (save-excursion
+ (let* ((start (org-mouse-make-marker (event-start event)))
+ (end (org-mouse-make-marker (event-end event)))
+ (sbuf (marker-buffer start))
+ (ebuf (marker-buffer end)))
+
+ (when (and sbuf ebuf)
+ (set-buffer sbuf)
+ (goto-char start)
+ (org-back-to-heading)
+ (if (and (eq sbuf ebuf)
+ (equal
+ (point)
+ (save-excursion (goto-char end) (org-back-to-heading) (point))))
+ ;; if the same line then promote/demote
+ (if (>= end start) (org-demote-subtree) (org-promote-subtree))
+ ;; if different lines then move
+ (org-cut-subtree)
+
+ (set-buffer ebuf)
+ (goto-char end)
+ (org-back-to-heading)
+ (when (and (eq sbuf ebuf)
+ (equal
+ (point)
+ (save-excursion (goto-char start)
+ (org-back-to-heading) (point))))
+ (outline-end-of-subtree)
+ (end-of-line)
+ (if (eobp) (newline) (forward-char)))
+
+ (when (looking-at org-outline-regexp)
+ (let ((level (- (match-end 0) (match-beginning 0))))
+ (when (> end (match-end 0))
+ (outline-end-of-subtree)
+ (end-of-line)
+ (if (eobp) (newline) (forward-char))
+ (setq level (1+ level)))
+ (org-paste-subtree level)
+ (save-excursion
+ (outline-end-of-subtree)
+ (when (bolp) (delete-char -1))))))))))
+
+
+(defun org-mouse-transform-to-outline ()
+ (interactive)
+ (org-back-to-heading)
+ (let ((minlevel 1000)
+ (replace-text (concat (match-string 0) "* ")))
+ (beginning-of-line 2)
+ (save-excursion
+ (while (not (or (eobp) (looking-at org-outline-regexp)))
+ (when (looking-at org-mouse-plain-list-regexp)
+ (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
+ (forward-line)))
+ (while (not (or (eobp) (looking-at org-outline-regexp)))
+ (when (and (looking-at org-mouse-plain-list-regexp)
+ (eq minlevel (- (match-end 1) (match-beginning 1))))
+ (replace-match replace-text))
+ (forward-line))))
+
+(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
+
+(defun org-mouse-do-remotely (command)
+ ; (org-agenda-check-no-diary)
+ (when (get-text-property (point) 'org-marker)
+ (let* ((anticol (- (point-at-eol) (point)))
+ (marker (get-text-property (point) 'org-marker))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker))
+ (hdmarker (get-text-property (point) 'org-hd-marker))
+ (buffer-read-only nil)
+ (newhead "--- removed ---")
+ (org-mouse-direct nil)
+ (org-mouse-main-buffer (current-buffer)))
+ (when (eq (with-current-buffer buffer major-mode) 'org-mode)
+ (let ((endmarker (with-current-buffer buffer
+ (outline-end-of-subtree)
+ (forward-char 1)
+ (copy-marker (point)))))
+ (org-with-remote-undo buffer
+ (with-current-buffer buffer
+ (widen)
+ (goto-char pos)
+ (org-show-hidden-entry)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))) ; show the next heading
+ (org-back-to-heading)
+ (setq marker (copy-marker (point)))
+ (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
+ (funcall command)
+ (message "_cmd: %S" org-mouse-cmd)
+ (message "this-command: %S" this-command)
+ (unless (eq (marker-position marker) (marker-position endmarker))
+ (setq newhead (org-get-heading))))
+
+ (beginning-of-line 1)
+ (save-excursion
+ (org-agenda-change-all-lines newhead hdmarker 'fixface))))
+ t))))
+
+(defun org-mouse-agenda-context-menu (&optional event)
+ (or (org-mouse-do-remotely 'org-mouse-context-menu)
+ (popup-menu
+ '("Agenda"
+ ("Agenda Files")
+ "--"
+ ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo))
+ :visible (if (eq last-command 'org-agenda-undo)
+ org-agenda-pending-undo-list
+ org-agenda-undo-list)]
+ ["Rebuild Buffer" org-agenda-redo t]
+ ["New Diary Entry"
+ org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
+ "--"
+ ["Goto Today" org-agenda-goto-today
+ (org-agenda-check-type nil 'agenda 'timeline) t]
+ ["Display Calendar" org-agenda-goto-calendar
+ (org-agenda-check-type nil 'agenda 'timeline) t]
+ ("Calendar Commands"
+ ["Phases of the Moon" org-agenda-phases-of-moon
+ (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Sunrise/Sunset" org-agenda-sunrise-sunset
+ (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Holidays" org-agenda-holidays
+ (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Convert" org-agenda-convert-date
+ (org-agenda-check-type nil 'agenda 'timeline)]
+ "--"
+ ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
+ "--"
+ ["Day View" org-agenda-day-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'day)]
+ ["Week View" org-agenda-week-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'week)]
+ "--"
+ ["Show Logbook entries" org-agenda-log-mode
+ :style toggle :selected org-agenda-show-log
+ :active (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Include Diary" org-agenda-toggle-diary
+ :style toggle :selected org-agenda-include-diary
+ :active (org-agenda-check-type nil 'agenda)]
+ ["Use Time Grid" org-agenda-toggle-time-grid
+ :style toggle :selected org-agenda-use-time-grid
+ :active (org-agenda-check-type nil 'agenda)]
+ ["Follow Mode" org-agenda-follow-mode
+ :style toggle :selected org-agenda-follow-mode]
+ "--"
+ ["Quit" org-agenda-quit t]
+ ["Exit and Release Buffers" org-agenda-exit t]
+ ))))
+
+(defun org-mouse-get-gesture (event)
+ (let ((startxy (posn-x-y (event-start event)))
+ (endxy (posn-x-y (event-end event))))
+ (if (< (car startxy) (car endxy)) :right :left)))
+
+
+ ; (setq org-agenda-mode-hook nil)
+(defvar org-agenda-mode-map)
+(add-hook 'org-agenda-mode-hook
+ #'(lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
+ (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
+ (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
+ (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
+ (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
+ (org-defkey org-agenda-mode-map [drag-mouse-3]
+ #'(lambda (event) (interactive "e")
+ (case (org-mouse-get-gesture event)
+ (:left (org-agenda-earlier 1))
+ (:right (org-agenda-later 1)))))))
+
+(provide 'org-mouse)
+
+;;; org-mouse.el ends here
diff --git a/lisp/org-odt.el b/lisp/org-odt.el
new file mode 100644
index 0000000..7de4b5d
--- /dev/null
+++ b/lisp/org-odt.el
@@ -0,0 +1,2850 @@
+;;; org-odt.el --- OpenDocument Text exporter for Org-mode
+
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'org-lparse)
+
+(defgroup org-export-odt nil
+ "Options specific for ODT export of Org-mode files."
+ :tag "Org Export ODT"
+ :group 'org-export
+ :version "24.1")
+
+(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse
+(defun org-odt-insert-toc ()
+ (goto-char (point-min))
+ (cond
+ ((re-search-forward
+ "\\(<text:p [^>]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(</text:p>\\)?"
+ nil t)
+ (replace-match ""))
+ (t
+ (goto-char org-lparse-dyn-first-heading-pos)))
+ (insert (org-odt-format-toc)))
+
+(defun org-odt-end-export ()
+ (org-odt-insert-toc)
+ (org-odt-fixup-label-references)
+
+ ;; remove empty paragraphs
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<text:p\\( text:style-name=\"Text_20_body\"\\)?>[ \r\n\t]*</text:p>"
+ nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+
+ ;; Convert whitespace place holders
+ (goto-char (point-min))
+ (let (beg end n)
+ (while (setq beg (next-single-property-change (point) 'org-whitespace))
+ (setq n (get-text-property beg 'org-whitespace)
+ end (next-single-property-change beg 'org-whitespace))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (format "<span style=\"visibility:hidden;\">%s</span>"
+ (make-string n ?x)))))
+
+ ;; Remove empty lines at the beginning of the file.
+ (goto-char (point-min))
+ (when (looking-at "\\s-+\n") (replace-match ""))
+
+ ;; Remove display properties
+ (remove-text-properties (point-min) (point-max) '(display t)))
+
+(defvar org-odt-suppress-xref nil)
+(defconst org-export-odt-special-string-regexps
+ '(("\\\\-" . "&#x00ad;\\1") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-odt-lib-dir (file-name-directory load-file-name)
+ "Location of ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defvar org-odt-data-dir nil
+ "Data directory for ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-export-odt-schema-dir'.")
+
+(defconst org-odt-schema-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./schema/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./schema/" org-odt-data-dir))))
+ "List of directories to search for OpenDocument schema files.
+Use this list to set the default value of
+`org-export-odt-schema-dir'. The entries in this list are
+populated heuristically based on the values of `org-odt-lib-dir'
+and `org-odt-data-dir'.")
+
+(defcustom org-export-odt-schema-dir
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (org-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (org-odt): Trying %s..." schema-dir)
+ (when (and (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (org-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-odt-schema-dir-list)
+ (message "Debug (org-odt): No OpenDocument schema files installed")
+ nil)))
+ schema-dir)
+ "Directory that contains OpenDocument schema files.
+
+This directory contains:
+1. rnc files for OpenDocument schema
+2. a \"schemas.xml\" file that specifies locating rules needed
+ for auto validation of OpenDocument XML files.
+
+Use the customize interface to set this variable. This ensures
+that `rng-schema-locating-files' is updated and auto-validation
+of OpenDocument XML takes place based on the value
+`rng-nxml-auto-validate-flag'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-schema-dir-list'. The OASIS schema files are available
+only in the org's private git repository. It is *not* bundled
+with GNU ELPA tar or standard Emacs distribution."
+ :type '(choice
+ (const :tag "Not set" nil)
+ (directory :tag "Schema directory"))
+ :group 'org-export-odt
+ :version "24.1"
+ :set
+ (lambda (var value)
+ "Set `org-export-odt-schema-dir'.
+Also add it to `rng-schema-locating-files'."
+ (let ((schema-dir value))
+ (set var
+ (if (and
+ (file-readable-p
+ (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ schema-dir
+ (when value
+ (message "Error (org-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
+ (when org-export-odt-schema-dir
+ (eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "schemas.xml"
+ org-export-odt-schema-dir))))))
+
+(defconst org-odt-styles-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./styles/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./styles/" org-odt-data-dir)))
+ (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
+ (expand-file-name "./org/" data-directory) ; system
+ )
+ "List of directories to search for OpenDocument styles files.
+See `org-odt-styles-dir'. The entries in this list are populated
+heuristically based on the values of `org-odt-lib-dir' and
+`org-odt-data-dir'.")
+
+(defconst org-odt-styles-dir
+ (let* ((styles-dir
+ (catch 'styles-dir
+ (message "Debug (org-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (org-odt): Trying %s..." styles-dir)
+ (when (and (file-readable-p
+ (expand-file-name
+ "OrgOdtContentTemplate.xml" styles-dir))
+ (file-readable-p
+ (expand-file-name
+ "OrgOdtStyles.xml" styles-dir)))
+ (message "Debug (org-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (org-odt): Cannot find factory styles files, aborting"))
+ styles-dir)
+ "Directory that holds auxiliary XML files used by the ODT exporter.
+
+This directory contains the following XML files -
+ \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
+ XML files are used as the default values of
+ `org-export-odt-styles-file' and
+ `org-export-odt-content-template-file'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using org
+from one of: org's own private git repository, GNU ELPA tar or
+standard Emacs.")
+
+(defvar org-odt-file-extensions
+ '(("odt" . "OpenDocument Text")
+ ("ott" . "OpenDocument Text Template")
+ ("odm" . "OpenDocument Master Document")
+ ("ods" . "OpenDocument Spreadsheet")
+ ("ots" . "OpenDocument Spreadsheet Template")
+ ("odg" . "OpenDocument Drawing (Graphics)")
+ ("otg" . "OpenDocument Drawing Template")
+ ("odp" . "OpenDocument Presentation")
+ ("otp" . "OpenDocument Presentation Template")
+ ("odi" . "OpenDocument Image")
+ ("odf" . "OpenDocument Formula")
+ ("odc" . "OpenDocument Chart")))
+
+(mapc
+ (lambda (desc)
+ ;; Let Emacs open all OpenDocument files in archive mode
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
+ org-odt-file-extensions)
+
+;; register the odt exporter with the pre-processor
+(add-to-list 'org-export-backends 'odt)
+
+;; register the odt exporter with org-lparse library
+(org-lparse-register-backend 'odt)
+
+(defun org-odt-unload-function ()
+ (org-lparse-unregister-backend 'odt)
+ (remove-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-export-odt-preprocess-latex-fragments)
+ nil)
+
+(defcustom org-export-odt-content-template-file nil
+ "Template file for \"content.xml\".
+The exporter embeds the exported content just before
+\"</office:text>\" element.
+
+If unspecified, the file named \"OrgOdtContentTemplate.xml\"
+under `org-odt-styles-dir' is used."
+ :type 'file
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-styles-file nil
+ "Default styles file for use with ODT export.
+Valid values are one of:
+1. nil
+2. path to a styles.xml file
+3. path to a *.odt or a *.ott file
+4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
+...))
+
+In case of option 1, an in-built styles.xml is used. See
+`org-odt-styles-dir' for more information.
+
+In case of option 3, the specified file is unzipped and the
+styles.xml embedded therein is used.
+
+In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
+and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
+generated odt file. Use relative path for specifying the
+FILE-MEMBERS. styles.xml must be specified as one of the
+FILE-MEMBERS.
+
+Use options 1, 2 or 3 only if styles.xml alone suffices for
+achieving the desired formatting. Use option 4, if the styles.xml
+references additional files like header and footer images for
+achieving the desired formatting.
+
+Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
+a per-file basis. For example,
+
+#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
+#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "Factory settings" nil)
+ (file :must-match t :tag "styles.xml")
+ (file :must-match t :tag "ODT or OTT file")
+ (list :tag "ODT or OTT file + Members"
+ (file :must-match t :tag "ODF Text or Text Template file")
+ (cons :tag "Members"
+ (file :tag " Member" "styles.xml")
+ (repeat (file :tag "Member"))))))
+
+(eval-after-load 'org-exp
+ '(add-to-list 'org-export-inbuffer-options-extra
+ '("ODT_STYLES_FILE" :odt-styles-file)))
+
+(defconst org-export-odt-tmpdir-prefix "%s-")
+(defconst org-export-odt-bookmark-prefix "OrgXref.")
+(defvar org-odt-zip-dir nil
+ "Temporary directory that holds XML files during export.")
+
+(defvar org-export-odt-embed-images t
+ "Should the images be copied in to the odt file or just linked?")
+
+(defvar org-export-odt-inline-images 'maybe)
+(defcustom org-export-odt-inline-image-extensions
+ '("png" "jpeg" "jpg" "gif")
+ "Extensions of image files that can be inlined into HTML."
+ :type '(repeat (string :tag "Extension"))
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
+ "Scaling factor for converting images pixels to inches.
+Use this for sizing of embedded images. See Info node `(org)
+Images in ODT export' for more information."
+ :type 'float
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-export-odt-create-custom-styles-for-srcblocks t
+ "Whether custom styles for colorized source blocks be automatically created.
+When this option is turned on, the exporter creates custom styles
+for source blocks based on the advice of `htmlfontify'. Creation
+of custom styles happen as part of `org-odt-hfy-face-to-css'.
+
+When this option is turned off exporter does not create such
+styles.
+
+Use the latter option if you do not want the custom styles to be
+based on your current display settings. It is necessary that the
+styles.xml already contains needed styles for colorizing to work.
+
+This variable is effective only if
+`org-export-odt-fontify-srcblocks' is turned on."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-export-odt-default-org-styles-alist
+ '((paragraph . ((default . "Text_20_body")
+ (fixedwidth . "OrgFixedWidthBlock")
+ (verse . "OrgVerse")
+ (quote . "Quotations")
+ (blockquote . "Quotations")
+ (center . "OrgCenter")
+ (left . "OrgLeft")
+ (right . "OrgRight")
+ (title . "OrgTitle")
+ (subtitle . "OrgSubtitle")
+ (footnote . "Footnote")
+ (src . "OrgSrcBlock")
+ (illustration . "Illustration")
+ (table . "Table")
+ (definition-term . "Text_20_body_20_bold")
+ (horizontal-line . "Horizontal_20_Line")))
+ (character . ((default . "Default")
+ (bold . "Bold")
+ (emphasis . "Emphasis")
+ (code . "OrgCode")
+ (verbatim . "OrgCode")
+ (strike . "Strikethrough")
+ (underline . "Underline")
+ (subscript . "OrgSubscript")
+ (superscript . "OrgSuperscript")))
+ (list . ((ordered . "OrgNumberedList")
+ (unordered . "OrgBulletedList")
+ (description . "OrgDescriptionList"))))
+ "Default styles for various entities.")
+
+(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist)
+(defun org-odt-get-style-name-for-entity (category &optional entity)
+ (let ((entity (or entity 'default)))
+ (or
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-org-styles-alist))))
+ (cdr (assoc entity (cdr (assoc category
+ org-export-odt-default-org-styles-alist))))
+ (error "Cannot determine style name for entity %s of type %s"
+ entity category))))
+
+(defcustom org-export-odt-preferred-output-format nil
+ "Automatically post-process to this format after exporting to \"odt\".
+Interactive commands `org-export-as-odt' and
+`org-export-as-odt-and-open' export first to \"odt\" format and
+then use `org-export-odt-convert-process' to convert the
+resulting document to this format. During customization of this
+variable, the list of valid values are populated based on
+`org-export-odt-convert-capabilities'.
+
+You can set this option on per-file basis using file local
+values. See Info node `(emacs) File Variables'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,c ,c))
+ (org-lparse-reachable-formats "odt")))))
+;;;###autoload
+(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
+
+(defmacro org-odt-cleanup-xml-buffers (&rest body)
+ `(let ((org-odt-zip-dir
+ (make-temp-file
+ (format org-export-odt-tmpdir-prefix "odf") t))
+ (--cleanup-xml-buffers
+ (function
+ (lambda nil
+ (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
+ "meta.xml" "styles.xml")))
+ ;; kill all xml buffers
+ (mapc (lambda (file)
+ (let ((buf (find-file-noselect
+ (expand-file-name file org-odt-zip-dir) t)))
+ (when (buffer-name buf)
+ (set-buffer-modified-p nil)
+ (kill-buffer buf))))
+ xml-files))
+ ;; delete temporary directory.
+ (delete-directory org-odt-zip-dir t)))))
+ (org-condition-case-unless-debug err
+ (prog1 (progn ,@body)
+ (funcall --cleanup-xml-buffers))
+ ((quit error)
+ (funcall --cleanup-xml-buffers)
+ (message "OpenDocument export failed: %s"
+ (error-message-string err))))))
+
+;;;###autoload
+(defun org-export-as-odt-and-open (arg)
+ "Export the outline as ODT and immediately open it with a browser.
+If there is an active region, export only the region.
+The prefix ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted lists."
+ (interactive "P")
+ (org-odt-cleanup-xml-buffers
+ (org-lparse-and-open
+ (or org-export-odt-preferred-output-format "odt") "odt" arg)))
+
+;;;###autoload
+(defun org-export-as-odt-batch ()
+ "Call the function `org-lparse-batch'.
+This function can be used in batch processing as:
+emacs --batch
+ --load=$HOME/lib/emacs/org.el
+ --eval \"(setq org-export-headline-levels 2)\"
+ --visit=MyFile --funcall org-export-as-odt-batch"
+ (org-lparse-batch "odt"))
+
+;;; org-export-as-odt
+;;;###autoload
+(defun org-export-as-odt (arg &optional hidden ext-plist
+ to-buffer body-only pub-dir)
+ "Export the outline as a OpenDocumentText file.
+If there is an active region, export only the region. The prefix
+ARG specifies how many levels of the outline should become
+headlines. The default is 3. Lower levels will become bulleted
+lists. HIDDEN is obsolete and does nothing.
+EXT-PLIST is a property list with external parameters overriding
+org-mode's default settings, but still inferior to file-local
+settings. When TO-BUFFER is non-nil, create a buffer with that
+name and export to that buffer. If TO-BUFFER is the symbol
+`string', don't leave any buffer behind but just return the
+resulting XML as a string. When BODY-ONLY is set, don't produce
+the file header and footer, simply return the content of
+<body>...</body>, without even the body tags themselves. When
+PUB-DIR is set, use this as the publishing directory."
+ (interactive "P")
+ (org-odt-cleanup-xml-buffers
+ (org-lparse (or org-export-odt-preferred-output-format "odt")
+ "odt" arg hidden ext-plist to-buffer body-only pub-dir)))
+
+(defvar org-odt-entity-control-callbacks-alist
+ `((EXPORT
+ . (org-odt-begin-export org-odt-end-export))
+ (DOCUMENT-CONTENT
+ . (org-odt-begin-document-content org-odt-end-document-content))
+ (DOCUMENT-BODY
+ . (org-odt-begin-document-body org-odt-end-document-body))
+ (TOC
+ . (org-odt-begin-toc org-odt-end-toc))
+ (ENVIRONMENT
+ . (org-odt-begin-environment org-odt-end-environment))
+ (FOOTNOTE-DEFINITION
+ . (org-odt-begin-footnote-definition org-odt-end-footnote-definition))
+ (TABLE
+ . (org-odt-begin-table org-odt-end-table))
+ (TABLE-ROWGROUP
+ . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup))
+ (LIST
+ . (org-odt-begin-list org-odt-end-list))
+ (LIST-ITEM
+ . (org-odt-begin-list-item org-odt-end-list-item))
+ (OUTLINE
+ . (org-odt-begin-outline org-odt-end-outline))
+ (OUTLINE-TEXT
+ . (org-odt-begin-outline-text org-odt-end-outline-text))
+ (PARAGRAPH
+ . (org-odt-begin-paragraph org-odt-end-paragraph)))
+ "")
+
+(defvar org-odt-entity-format-callbacks-alist
+ `((EXTRA-TARGETS . org-lparse-format-extra-targets)
+ (ORG-TAGS . org-lparse-format-org-tags)
+ (SECTION-NUMBER . org-lparse-format-section-number)
+ (HEADLINE . org-odt-format-headline)
+ (TOC-ENTRY . org-odt-format-toc-entry)
+ (TOC-ITEM . org-odt-format-toc-item)
+ (TAGS . org-odt-format-tags)
+ (SPACES . org-odt-format-spaces)
+ (TABS . org-odt-format-tabs)
+ (LINE-BREAK . org-odt-format-line-break)
+ (FONTIFY . org-odt-format-fontify)
+ (TODO . org-lparse-format-todo)
+ (LINK . org-odt-format-link)
+ (INLINE-IMAGE . org-odt-format-inline-image)
+ (ORG-LINK . org-odt-format-org-link)
+ (HEADING . org-odt-format-heading)
+ (ANCHOR . org-odt-format-anchor)
+ (TABLE . org-lparse-format-table)
+ (TABLE-ROW . org-odt-format-table-row)
+ (TABLE-CELL . org-odt-format-table-cell)
+ (FOOTNOTES-SECTION . ignore)
+ (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference)
+ (HORIZONTAL-LINE . org-odt-format-horizontal-line)
+ (COMMENT . org-odt-format-comment)
+ (LINE . org-odt-format-line)
+ (ORG-ENTITY . org-odt-format-org-entity))
+ "")
+
+;;;_. callbacks
+;;;_. control callbacks
+;;;_ , document body
+(defun org-odt-begin-office-body ()
+ ;; automatic styles
+ (insert-file-contents
+ (or org-export-odt-content-template-file
+ (expand-file-name "OrgOdtContentTemplate.xml"
+ org-odt-styles-dir)))
+ (goto-char (point-min))
+ (re-search-forward "</office:text>" nil nil)
+ (delete-region (match-beginning 0) (point-max)))
+
+;; Following variable is let bound when `org-do-lparse' is in
+;; progress. See org-html.el.
+(defvar org-lparse-toc)
+(defun org-odt-format-toc ()
+ (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
+
+(defun org-odt-format-preamble (opt-plist)
+ (let* ((title (plist-get opt-plist :title))
+ (author (plist-get opt-plist :author))
+ (date (plist-get opt-plist :date))
+ (iso-date (org-odt-format-date date))
+ (date (org-odt-format-date date "%d %b %Y"))
+ (email (plist-get opt-plist :email))
+ ;; switch on or off above vars based on user settings
+ (author (and (plist-get opt-plist :author-info) (or author email)))
+ (email (and (plist-get opt-plist :email-info) email))
+ (date (and (plist-get opt-plist :time-stamp-file) date)))
+ (concat
+ ;; title
+ (when title
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'title (org-odt-format-tags
+ '("<text:title>" . "</text:title>") title))
+ ;; separator
+ "<text:p text:style-name=\"OrgTitle\"/>"))
+ (cond
+ ((and author (not email))
+ ;; author only
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-tags
+ '("<text:initial-creator>" . "</text:initial-creator>")
+ author))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>"))
+ ((and author email)
+ ;; author and email
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-link
+ (org-odt-format-tags
+ '("<text:initial-creator>" . "</text:initial-creator>")
+ author) (concat "mailto:" email)))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))
+ ;; date
+ (when date
+ (concat
+ (org-odt-format-stylized-paragraph
+ 'subtitle
+ (org-odt-format-tags
+ '("<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">"
+ . "</text:date>") date "N75" iso-date))
+ ;; separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))))
+
+(defun org-odt-begin-document-body (opt-plist)
+ (org-odt-begin-office-body)
+ (insert (org-odt-format-preamble opt-plist))
+ (setq org-lparse-dyn-first-heading-pos (point)))
+
+(defvar org-lparse-body-only) ; let bound during org-do-lparse
+(defvar org-lparse-to-buffer) ; let bound during org-do-lparse
+(defun org-odt-end-document-body (opt-plist)
+ (unless org-lparse-body-only
+ (org-lparse-insert-tag "</office:text>")
+ (org-lparse-insert-tag "</office:body>")))
+
+(defun org-odt-begin-document-content (opt-plist)
+ (ignore))
+
+(defun org-odt-end-document-content ()
+ (org-lparse-insert-tag "</office:document-content>"))
+
+(defun org-odt-begin-outline (level1 snumber title tags
+ target extra-targets class)
+ (org-lparse-insert
+ 'HEADING (org-lparse-format
+ 'HEADLINE title extra-targets tags snumber level1)
+ level1 target))
+
+(defun org-odt-end-outline ()
+ (ignore))
+
+(defun org-odt-begin-outline-text (level1 snumber class)
+ (ignore))
+
+(defun org-odt-end-outline-text ()
+ (ignore))
+
+(defun org-odt-begin-section (style &optional name)
+ (let ((default-name (car (org-odt-add-automatic-style "Section"))))
+ (org-lparse-insert-tag
+ "<text:section text:style-name=\"%s\" text:name=\"%s\">"
+ style (or name default-name))))
+
+(defun org-odt-end-section ()
+ (org-lparse-insert-tag "</text:section>"))
+
+(defun org-odt-begin-paragraph (&optional style)
+ (org-lparse-insert-tag
+ "<text:p%s>" (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defun org-odt-end-paragraph ()
+ (org-lparse-insert-tag "</text:p>"))
+
+(defun org-odt-get-extra-attrs-for-paragraph-style (style)
+ (let (style-name)
+ (setq style-name
+ (cond
+ ((stringp style) style)
+ ((symbolp style) (org-odt-get-style-name-for-entity
+ 'paragraph style))))
+ (unless style-name
+ (error "Don't know how to handle paragraph style %s" style))
+ (format " text:style-name=\"%s\"" style-name)))
+
+(defun org-odt-format-stylized-paragraph (style text)
+ (org-odt-format-tags
+ '("<text:p%s>" . "</text:p>") text
+ (org-odt-get-extra-attrs-for-paragraph-style style)))
+
+(defvar org-lparse-opt-plist) ; bound during org-do-lparse
+(defun org-odt-format-author (&optional author)
+ (when (setq author (or author (plist-get org-lparse-opt-plist :author)))
+ (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)))
+
+(defun org-odt-format-date (&optional org-ts fmt)
+ (save-match-data
+ (let* ((time
+ (and (stringp org-ts)
+ (string-match org-ts-regexp0 org-ts)
+ (apply 'encode-time
+ (org-fix-decoded-time
+ (org-parse-time-string (match-string 0 org-ts) t)))))
+ date)
+ (cond
+ (fmt (format-time-string fmt time))
+ (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time))
+ (format "%s:%s" (substring date 0 -2) (substring date -2)))))))
+
+(defun org-odt-begin-annotation (&optional author date)
+ (org-lparse-insert-tag "<office:annotation>")
+ (when (setq author (org-odt-format-author author))
+ (insert author))
+ (insert (org-odt-format-tags
+ '("<dc:date>" . "</dc:date>")
+ (org-odt-format-date
+ (or date (plist-get org-lparse-opt-plist :date)))))
+ (org-lparse-begin-paragraph))
+
+(defun org-odt-end-annotation ()
+ (org-lparse-insert-tag "</office:annotation>"))
+
+(defun org-odt-begin-environment (style env-options-plist)
+ (case style
+ (annotation
+ (org-lparse-stash-save-paragraph-state)
+ (org-odt-begin-annotation (plist-get env-options-plist 'author)
+ (plist-get env-options-plist 'date)))
+ ((blockquote verse center quote)
+ (org-lparse-begin-paragraph style)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-end-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defun org-odt-end-environment (style env-options-plist)
+ (case style
+ (annotation
+ (org-lparse-end-paragraph)
+ (org-odt-end-annotation)
+ (org-lparse-stash-pop-paragraph-state))
+ ((blockquote verse center quote)
+ (org-lparse-end-paragraph)
+ (list))
+ ((fixedwidth native)
+ (org-lparse-begin-paragraph)
+ (list))
+ (t (error "Unknown environment %s" style))))
+
+(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse
+(defvar org-odt-list-stack-stashed)
+(defun org-odt-begin-list (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype))
+ (extra (concat (if (or org-lparse-list-table-p
+ (and (= 1 (length org-lparse-list-stack))
+ (null org-odt-list-stack-stashed)))
+ " text:continue-numbering=\"false\""
+ " text:continue-numbering=\"true\"")
+ (when style-name
+ (format " text:style-name=\"%s\"" style-name)))))
+ (case ltype
+ ((ordered unordered description)
+ (org-lparse-end-paragraph)
+ (org-lparse-insert-tag "<text:list%s>" extra))
+ (t (error "Unknown list type: %s" ltype)))))
+
+(defun org-odt-end-list (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (if ltype
+ (org-lparse-insert-tag "</text:list>")
+ (error "Unknown list type: %s" ltype)))
+
+(defun org-odt-begin-list-item (ltype &optional arg headline)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ (ordered
+ (assert (not headline) t)
+ (let* ((counter arg) (extra ""))
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ "<text:list-header>" "<text:list-item>"))
+ (org-lparse-begin-paragraph)))
+ (unordered
+ (let* ((id arg) (extra ""))
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ "<text:list-header>" "<text:list-item>"))
+ (org-lparse-begin-paragraph)
+ (insert (if headline (org-odt-format-target headline id)
+ (org-odt-format-bookmark "" id)))))
+ (description
+ (assert (not headline) t)
+ (let ((term (or arg "(no term)")))
+ (insert
+ (org-odt-format-tags
+ '("<text:list-item>" . "</text:list-item>")
+ (org-odt-format-stylized-paragraph 'definition-term term)))
+ (org-lparse-begin-list-item 'unordered)
+ (org-lparse-begin-list 'description)
+ (org-lparse-begin-list-item 'unordered)))
+ (t (error "Unknown list type"))))
+
+(defun org-odt-end-list-item (ltype)
+ (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
+ ltype))
+ (case ltype
+ ((ordered unordered)
+ (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
+ (length org-odt-list-stack-stashed))
+ (prog1 "</text:list-header>"
+ (setq org-odt-list-stack-stashed nil))
+ "</text:list-item>")))
+ (description
+ (org-lparse-end-list-item-1)
+ (org-lparse-end-list 'description)
+ (org-lparse-end-list-item-1))
+ (t (error "Unknown list type"))))
+
+(defun org-odt-discontinue-list ()
+ (let ((stashed-stack org-lparse-list-stack))
+ (loop for list-type in stashed-stack
+ do (org-lparse-end-list-item-1 list-type)
+ (org-lparse-end-list list-type))
+ (setq org-odt-list-stack-stashed stashed-stack)))
+
+(defun org-odt-continue-list ()
+ (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed))
+ (loop for list-type in org-odt-list-stack-stashed
+ do (org-lparse-begin-list list-type)
+ (org-lparse-begin-list-item list-type)))
+
+;; Following variables are let bound when table emission is in
+;; progress. See org-lparse.el.
+(defvar org-lparse-table-begin-marker)
+(defvar org-lparse-table-ncols)
+(defvar org-lparse-table-rowgrp-open)
+(defvar org-lparse-table-rownum)
+(defvar org-lparse-table-cur-rowgrp-is-hdr)
+(defvar org-lparse-table-is-styled)
+(defvar org-lparse-table-rowgrp-info)
+(defvar org-lparse-table-colalign-vector)
+
+(defvar org-odt-table-style nil
+ "Table style specified by \"#+ATTR_ODT: <style-name>\" line.
+This is set during `org-odt-begin-table'.")
+
+(defvar org-odt-table-style-spec nil
+ "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.")
+
+(defcustom org-export-odt-table-styles
+ '(("OrgEquation" "OrgEquation"
+ ((use-first-column-styles . t)
+ (use-last-column-styles . t))))
+ "Specify how Table Styles should be derived from a Table Template.
+This is a list where each element is of the
+form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
+
+TABLE-STYLE-NAME is the style associated with the table through
+`org-odt-table-style'.
+
+TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
+TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
+below) that is included in
+`org-export-odt-content-template-file'.
+
+TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableCell\"
+PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableParagraph\"
+TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
+ \"FirstRow\" | \"LastRow\" |
+ \"EvenRow\" | \"OddRow\" |
+ \"EvenColumn\" | \"OddColumn\" | \"\"
+where \"+\" above denotes string concatenation.
+
+TABLE-CELL-OPTIONS is an alist where each element is of the
+form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
+TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
+ `use-last-row-styles' |
+ `use-first-column-styles' |
+ `use-last-column-styles' |
+ `use-banding-rows-styles' |
+ `use-banding-columns-styles' |
+ `use-first-row-styles'
+ON-OR-OFF := `t' | `nil'
+
+For example, with the following configuration
+
+\(setq org-export-odt-table-styles
+ '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\"
+ \(\(use-first-row-styles . t\)
+ \(use-first-column-styles . t\)\)\)
+ \(\"TableWithHeaderColumns\" \"Custom\"
+ \(\(use-first-column-styles . t\)\)\)\)\)
+
+1. A table associated with \"TableWithHeaderRowsAndColumns\"
+ style will use the following table-cell styles -
+ \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
+ \"CustomTableCell\" and the following paragraph styles
+ \"CustomFirstRowTableParagraph\",
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate.
+
+2. A table associated with \"TableWithHeaderColumns\" style will
+ use the following table-cell styles -
+ \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
+ following paragraph styles
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate..
+
+Note that TABLE-TEMPLATE-NAME corresponds to the
+\"<table:table-template>\" elements contained within
+\"<office:styles>\". The entries (TABLE-STYLE-NAME
+TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
+\"table:template-name\" and \"table:use-first-row-styles\" etc
+attributes of \"<table:table>\" element. Refer ODF-1.2
+specification for more information. Also consult the
+implementation filed under `org-odt-get-table-cell-styles'.
+
+The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
+formatting of numbered display equations. Do not delete this
+style from the list."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (repeat :tag "Table Styles"
+ (list :tag "Table Style Specification"
+ (string :tag "Table Style Name")
+ (string :tag "Table Template Name")
+ (alist :options (use-first-row-styles
+ use-last-row-styles
+ use-first-column-styles
+ use-last-column-styles
+ use-banding-rows-styles
+ use-banding-columns-styles)
+ :key-type symbol
+ :value-type (const :tag "True" t))))))
+
+(defvar org-odt-table-style-format
+ "
+<style:style style:name=\"%s\" style:family=\"table\">
+ <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
+</style:style>
+"
+ "Template for auto-generated Table styles.")
+
+(defvar org-odt-automatic-styles '()
+ "Registry of automatic styles for various OBJECT-TYPEs.
+The variable has the following form:
+\(\(OBJECT-TYPE-A
+ \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\)
+ \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\)
+ \(OBJECT-TYPE-B
+ \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\)
+ \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\)
+ ...\).
+
+OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'.
+
+Use `org-odt-add-automatic-style' to add update this variable.'")
+
+(defvar org-odt-object-counters nil
+ "Running counters for various OBJECT-TYPEs.
+Use this to generate automatic names and style-names. See
+`org-odt-add-automatic-style'.")
+
+(defun org-odt-write-automatic-styles ()
+ "Write automatic styles to \"content.xml\"."
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "content.xml") t)
+ ;; position the cursor
+ (goto-char (point-min))
+ (re-search-forward " </office:automatic-styles>" nil t)
+ (goto-char (match-beginning 0))
+ ;; write automatic table styles
+ (loop for (style-name props) in
+ (plist-get org-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) 96))
+ (insert (format org-odt-table-style-format style-name props))))))
+
+(defun org-odt-add-automatic-style (object-type &optional object-props)
+ "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option of the object in question to
+`org-lparse-get-block-params'.
+
+Use `org-odt-object-counters' to generate an automatic
+OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
+new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
+. STYLE-NAME)."
+ (assert (stringp object-type))
+ (let* ((object (intern object-type))
+ (seqvar object)
+ (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
+ (object-name (format "%s%d" object-type seqno)) style-name)
+ (setq org-odt-object-counters
+ (plist-put org-odt-object-counters seqvar seqno))
+ (when object-props
+ (setq style-name (format "Org%s" object-name))
+ (setq org-odt-automatic-styles
+ (plist-put org-odt-automatic-styles object
+ (append (list (list style-name object-props))
+ (plist-get org-odt-automatic-styles object)))))
+ (cons object-name style-name)))
+
+(defvar org-odt-table-indentedp nil)
+(defun org-odt-begin-table (caption label attributes short-caption)
+ (setq org-odt-table-indentedp (not (null org-lparse-list-stack)))
+ (when org-odt-table-indentedp
+ ;; Within the Org file, the table is appearing within a list item.
+ ;; OpenDocument doesn't allow table to appear within list items.
+ ;; Temporarily terminate the list, emit the table and then
+ ;; re-continue the list.
+ (org-odt-discontinue-list)
+ ;; Put the Table in an indented section.
+ (let ((level (length org-odt-list-stack-stashed)))
+ (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
+ (setq attributes (org-lparse-get-block-params attributes))
+ (setq org-odt-table-style (plist-get attributes :style))
+ (setq org-odt-table-style-spec
+ (assoc org-odt-table-style org-export-odt-table-styles))
+ (when (or label caption)
+ (insert
+ (org-odt-format-stylized-paragraph
+ 'table (org-odt-format-entity-caption label caption "__Table__"))))
+ (let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
+ (org-lparse-insert-tag
+ "<table:table table:name=\"%s\" table:style-name=\"%s\">"
+ (or short-caption (car automatic-name))
+ (or (nth 1 org-odt-table-style-spec)
+ (cdr automatic-name) "OrgTable")))
+ (setq org-lparse-table-begin-marker (point)))
+
+(defvar org-lparse-table-colalign-info)
+(defun org-odt-end-table ()
+ (goto-char org-lparse-table-begin-marker)
+ (loop for level from 0 below org-lparse-table-ncols
+ do (let* ((col-cookie (and org-lparse-table-is-styled
+ (cdr (assoc (1+ level)
+ org-lparse-table-colalign-info))))
+ (extra-columns (or (nth 1 col-cookie) 0)))
+ (dotimes (i (1+ extra-columns))
+ (insert
+ (org-odt-format-tags
+ "<table:table-column table:style-name=\"%sColumn\"/>"
+ "" (or (nth 1 org-odt-table-style-spec) "OrgTable"))))
+ (insert "\n")))
+ ;; fill style attributes for table cells
+ (when org-lparse-table-is-styled
+ (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t)
+ (let* ((spec (match-string 1))
+ (r (string-to-number (match-string 2)))
+ (c (string-to-number (match-string 3)))
+ (cell-styles (org-odt-get-table-cell-styles
+ r c org-odt-table-style-spec))
+ (table-cell-style (car cell-styles))
+ (table-cell-paragraph-style (cdr cell-styles)))
+ (cond
+ ((equal spec "table-cell:p")
+ (replace-match table-cell-paragraph-style t t))
+ ((equal spec "table-cell:style-name")
+ (replace-match table-cell-style t t))))))
+ (goto-char (point-max))
+ (org-lparse-insert-tag "</table:table>")
+ (when org-odt-table-indentedp
+ (org-odt-end-section)
+ (org-odt-continue-list)))
+
+(defun org-odt-begin-table-rowgroup (&optional is-header-row)
+ (when org-lparse-table-rowgrp-open
+ (org-lparse-end 'TABLE-ROWGROUP))
+ (org-lparse-insert-tag (if is-header-row
+ "<table:table-header-rows>"
+ "<table:table-rows>"))
+ (setq org-lparse-table-rowgrp-open t)
+ (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row))
+
+(defun org-odt-end-table-rowgroup ()
+ (when org-lparse-table-rowgrp-open
+ (setq org-lparse-table-rowgrp-open nil)
+ (org-lparse-insert-tag
+ (if org-lparse-table-cur-rowgrp-is-hdr
+ "</table:table-header-rows>" "</table:table-rows>"))))
+
+(defun org-odt-format-table-row (row)
+ (org-odt-format-tags
+ '("<table:table-row>" . "</table:table-row>") row))
+
+(defun org-odt-get-table-cell-styles (r c &optional style-spec)
+ "Retrieve styles applicable to a table cell.
+R and C are (zero-based) row and column numbers of the table
+cell. STYLE-SPEC is an entry in `org-export-odt-table-styles'
+applicable to the current table. It is `nil' if the table is not
+associated with any style attributes.
+
+Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
+
+When STYLE-SPEC is nil, style the table cell the conventional way
+- choose cell borders based on row and column groupings and
+choose paragraph alignment based on `org-col-cookies' text
+property. See also
+`org-odt-get-paragraph-style-cookie-for-table-cell'.
+
+When STYLE-SPEC is non-nil, ignore the above cookie and return
+styles congruent with the ODF-1.2 specification."
+ (cond
+ (style-spec
+
+ ;; LibreOffice - particularly the Writer - honors neither table
+ ;; templates nor custom table-cell styles. Inorder to retain
+ ;; inter-operability with LibreOffice, only automatic styles are
+ ;; used for styling of table-cells. The current implementation is
+ ;; congruent with ODF-1.2 specification and hence is
+ ;; future-compatible.
+
+ ;; Additional Note: LibreOffice's AutoFormat facility for tables -
+ ;; which recognizes as many as 16 different cell types - is much
+ ;; richer. Unfortunately it is NOT amenable to easy configuration
+ ;; by hand.
+
+ (let* ((template-name (nth 1 style-spec))
+ (cell-style-selectors (nth 2 style-spec))
+ (cell-type
+ (cond
+ ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ (= c 0)) "FirstColumn")
+ ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ (= c (1- org-lparse-table-ncols))) "LastColumn")
+ ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ (= r 0)) "FirstRow")
+ ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ (= r org-lparse-table-rownum))
+ "LastRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 1)) "EvenRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 0)) "OddRow")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 1)) "EvenColumn")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 0)) "OddColumn")
+ (t ""))))
+ (cons
+ (concat template-name cell-type "TableCell")
+ (concat template-name cell-type "TableParagraph"))))
+ (t
+ (cons
+ (concat
+ "OrgTblCell"
+ (cond
+ ((= r 0) "T")
+ ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T")
+ (t ""))
+ (when (= r org-lparse-table-rownum) "B")
+ (cond
+ ((= c 0) "")
+ ((or (memq (nth c org-table-colgroup-info) '(:start :startend))
+ (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
+ (t "")))
+ (capitalize (aref org-lparse-table-colalign-vector c))))))
+
+(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c)
+ (concat
+ (and (not org-odt-table-style-spec)
+ (cond
+ (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
+ ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
+ "OrgTableHeading")
+ (t "OrgTableContents")))
+ (and org-lparse-table-is-styled
+ (format "@@table-cell:p@@%03d@@%03d@@" r c))))
+
+(defun org-odt-get-style-name-cookie-for-table-cell (r c)
+ (when org-lparse-table-is-styled
+ (format "@@table-cell:style-name@@%03d@@%03d@@" r c)))
+
+(defun org-odt-format-table-cell (data r c horiz-span)
+ (concat
+ (let* ((paragraph-style-cookie
+ (org-odt-get-paragraph-style-cookie-for-table-cell r c))
+ (style-name-cookie
+ (org-odt-get-style-name-cookie-for-table-cell r c))
+ (extra (and style-name-cookie
+ (format " table:style-name=\"%s\"" style-name-cookie)))
+ (extra (concat extra
+ (and (> horiz-span 0)
+ (format " table:number-columns-spanned=\"%d\""
+ (1+ horiz-span))))))
+ (org-odt-format-tags
+ '("<table:table-cell%s>" . "</table:table-cell>")
+ (if org-lparse-list-table-p data
+ (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra))
+ (let (s)
+ (dotimes (i horiz-span)
+ (setq s (concat s "\n<table:covered-table-cell/>"))) s)
+ "\n"))
+
+(defun org-odt-begin-footnote-definition (n)
+ (org-lparse-begin-paragraph 'footnote))
+
+(defun org-odt-end-footnote-definition (n)
+ (org-lparse-end-paragraph))
+
+(defun org-odt-begin-toc (lang-specific-heading max-level)
+ ;; Strings in `org-export-language-setup' can contain named html
+ ;; entities. Replace those with utf-8 equivalents.
+ (let ((i 0) entity rpl)
+ (while (string-match "&\\([^#].*?\\);" lang-specific-heading i)
+ (setq entity (match-string 1 lang-specific-heading))
+ (if (not (setq rpl (org-entity-get-representation entity 'utf8)))
+ (setq i (match-end 0))
+ (setq i (+ (match-beginning 0) (length rpl)))
+ (setq lang-specific-heading
+ (replace-match rpl t t lang-specific-heading)))))
+ (insert
+ (format "
+ <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\">
+ <text:table-of-content-source text:outline-level=\"%d\">
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+" max-level lang-specific-heading))
+ (loop for level from 1 upto 10
+ do (insert (format
+ "
+ <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
+ <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
+ <text:index-entry-chapter/>
+ <text:index-entry-text/>
+ <text:index-entry-link-end/>
+ </text:table-of-content-entry-template>
+" level level)))
+
+ (insert
+ (format "
+ </text:table-of-content-source>
+
+ <text:index-body>
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>
+" lang-specific-heading)))
+
+(defun org-odt-end-toc ()
+ (insert "
+ </text:index-body>
+ </text:table-of-content>
+"))
+
+(defun org-odt-format-toc-entry (snumber todo headline tags href)
+ (setq headline (concat
+ (and org-export-with-section-numbers
+ (concat snumber ". "))
+ headline
+ (and tags
+ (concat
+ (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'FONTIFY tags "tag")))))
+ (when todo
+ (setq headline (org-lparse-format 'FONTIFY headline "todo")))
+
+ (let ((org-odt-suppress-xref t))
+ (org-odt-format-link headline (concat "#" href))))
+
+(defun org-odt-format-toc-item (toc-entry level org-last-level)
+ (let ((style (format "Contents_20_%d"
+ (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
+ (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
+
+;; Following variable is let bound during 'ORG-LINK callback. See
+;; org-html.el
+(defvar org-lparse-link-description-is-image nil)
+(defun org-odt-format-link (desc href &optional attr)
+ (cond
+ ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref))
+ (setq href (substring href 1))
+ (let ((xref-format "text"))
+ (when (numberp desc)
+ (setq desc (format "%d" desc) xref-format "number"))
+ (when (listp desc)
+ (setq desc (mapconcat 'identity desc ".") xref-format "chapter"))
+ (setq href (concat org-export-odt-bookmark-prefix href))
+ (org-odt-format-tags
+ '("<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" .
+ "</text:bookmark-ref>")
+ desc xref-format href)))
+ (org-lparse-link-description-is-image
+ (org-odt-format-tags
+ '("<draw:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</draw:a>")
+ desc href (or attr "")))
+ (t
+ (org-odt-format-tags
+ '("<text:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</text:a>")
+ desc href (or attr "")))))
+
+(defun org-odt-format-spaces (n)
+ (cond
+ ((= n 1) " ")
+ ((> n 1) (concat
+ " " (org-odt-format-tags "<text:s text:c=\"%d\"/>" "" (1- n))))
+ (t "")))
+
+(defun org-odt-format-tabs (&optional n)
+ (let ((tab "<text:tab/>")
+ (n (or n 1)))
+ (insert tab)))
+
+(defun org-odt-format-line-break ()
+ (org-odt-format-tags "<text:line-break/>" ""))
+
+(defun org-odt-format-horizontal-line ()
+ (org-odt-format-stylized-paragraph 'horizontal-line ""))
+
+(defun org-odt-encode-plain-text (line &optional no-whitespace-filling)
+ (setq line (org-xml-encode-plain-text line))
+ (if no-whitespace-filling line
+ (org-odt-fill-tabs-and-spaces line)))
+
+(defun org-odt-format-line (line)
+ (case org-lparse-dyn-current-environment
+ (fixedwidth (concat
+ (org-odt-format-stylized-paragraph
+ 'fixedwidth (org-odt-encode-plain-text line)) "\n"))
+ (t (concat line "\n"))))
+
+(defun org-odt-format-comment (fmt &rest args)
+ (let ((comment (apply 'format fmt args)))
+ (format "\n<!-- %s -->\n" comment)))
+
+(defun org-odt-format-org-entity (wd)
+ (org-entity-get-representation wd 'utf8))
+
+(defun org-odt-fill-tabs-and-spaces (line)
+ (replace-regexp-in-string
+ "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s)
+ (cond
+ ((string= s "\t") (org-odt-format-tabs))
+ (t (org-odt-format-spaces (length s))))) line))
+
+(defcustom org-export-odt-fontify-srcblocks t
+ "Specify whether or not source blocks need to be fontified.
+Turn this option on if you want to colorize the source code
+blocks in the exported file. For colorization to work, you need
+to make available an enhanced version of `htmlfontify' library."
+ :type 'boolean
+ :group 'org-export-odt
+ :version "24.1")
+
+(defun org-odt-format-source-line-with-line-number-and-label
+ (line rpllbl num fontifier par-style)
+
+ (let ((keep-label (not (numberp rpllbl)))
+ (ref (org-find-text-property-in-string 'org-coderef line)))
+ (setq line (concat line (and keep-label ref (format "(%s)" ref))))
+ (setq line (funcall fontifier line))
+ (when ref
+ (setq line (org-odt-format-target line (concat "coderef-" ref))))
+ (setq line (org-odt-format-stylized-paragraph par-style line))
+ (if (not num) line
+ (org-odt-format-tags '("<text:list-item>" . "</text:list-item>") line))))
+
+(defun org-odt-format-source-code-or-example-plain
+ (lines lang caption textareap cols rows num cont rpllbl fmt)
+ "Format source or example blocks much like fixedwidth blocks.
+Use this when `org-export-odt-fontify-srcblocks' option is turned
+off."
+ (let* ((lines (org-split-string lines "[\r\n]"))
+ (line-count (length lines))
+ (i 0))
+ (mapconcat
+ (lambda (line)
+ (incf i)
+ (org-odt-format-source-line-with-line-number-and-label
+ line rpllbl num 'org-odt-encode-plain-text
+ (if (= i line-count) "OrgFixedWidthBlockLastLine"
+ "OrgFixedWidthBlock")))
+ lines "\n")))
+
+(defvar org-src-block-paragraph-format
+ "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
+ <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
+ <style:background-image/>
+ </style:paragraph-properties>
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>"
+ "Custom paragraph style for colorized source and example blocks.
+This style is much the same as that of \"OrgFixedWidthBlock\"
+except that the foreground and background colors are set
+according to the default face identified by the `htmlfontify'.")
+
+(defvar hfy-optimisations)
+(declare-function hfy-face-to-style "htmlfontify" (fn))
+(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
+
+(defun org-odt-hfy-face-to-css (fn)
+ "Create custom style for face FN.
+When FN is the default face, use it's foreground and background
+properties to create \"OrgSrcBlock\" paragraph style. Otherwise
+use it's color attribute to create a character style whose name
+is obtained from FN. Currently all attributes of FN other than
+color are ignored.
+
+The style name for a face FN is derived using the following
+operations on the face name in that order - de-dash, CamelCase
+and prefix with \"OrgSrc\". For example,
+`font-lock-function-name-face' is associated with
+\"OrgSrcFontLockFunctionNameFace\"."
+ (let* ((css-list (hfy-face-to-style fn))
+ (style-name ((lambda (fn)
+ (concat "OrgSrc"
+ (mapconcat
+ 'capitalize (split-string
+ (hfy-face-or-def-to-name fn) "-")
+ ""))) fn))
+ (color-val (cdr (assoc "color" css-list)))
+ (background-color-val (cdr (assoc "background" css-list)))
+ (style (and org-export-odt-create-custom-styles-for-srcblocks
+ (cond
+ ((eq fn 'default)
+ (format org-src-block-paragraph-format
+ background-color-val color-val))
+ (t
+ (format
+ "
+<style:style style:name=\"%s\" style:family=\"text\">
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>" style-name color-val))))))
+ (cons style-name style)))
+
+(defun org-odt-insert-custom-styles-for-srcblocks (styles)
+ "Save STYLES used for colorizing of source blocks.
+Update styles.xml with styles that were collected as part of
+`org-odt-hfy-face-to-css' callbacks."
+ (when styles
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "styles.xml") t)
+ (goto-char (point-min))
+ (when (re-search-forward "</office:styles>" nil t)
+ (goto-char (match-beginning 0))
+ (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n")))))
+
+(defun org-odt-format-source-code-or-example-colored
+ (lines lang caption textareap cols rows num cont rpllbl fmt)
+ "Format source or example blocks using `htmlfontify-string'.
+Use this routine when `org-export-odt-fontify-srcblocks' option
+is turned on."
+ (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
+ (mode (and lang-m (intern (concat (if (symbolp lang-m)
+ (symbol-name lang-m)
+ lang-m) "-mode"))))
+ (org-inhibit-startup t)
+ (org-startup-folded nil)
+ (lines (with-temp-buffer
+ (insert lines)
+ (if (functionp mode) (funcall mode) (fundamental-mode))
+ (font-lock-fontify-buffer)
+ (buffer-string)))
+ (hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (hfy-html-quote-map '(("\"" "&quot;")
+ ("<" "&lt;")
+ ("&" "&amp;")
+ (">" "&gt;")
+ (" " "<text:s/>")
+ (" " "<text:tab/>")))
+ (hfy-face-to-css 'org-odt-hfy-face-to-css)
+ (hfy-optimisations-1 (copy-sequence hfy-optimisations))
+ (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ 'body-text-only))
+ (hfy-begin-span-handler
+ (lambda (style text-block text-id text-begins-block-p)
+ (insert (format "<text:span text:style-name=\"%s\">" style))))
+ (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
+ (when (fboundp 'htmlfontify-string)
+ (let* ((lines (org-split-string lines "[\r\n]"))
+ (line-count (length lines))
+ (i 0))
+ (mapconcat
+ (lambda (line)
+ (incf i)
+ (org-odt-format-source-line-with-line-number-and-label
+ line rpllbl num 'htmlfontify-string
+ (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock")))
+ lines "\n")))))
+
+(defun org-odt-format-source-code-or-example (lines lang caption textareap
+ cols rows num cont
+ rpllbl fmt)
+ "Format source or example blocks for export.
+Use `org-odt-format-source-code-or-example-plain' or
+`org-odt-format-source-code-or-example-colored' depending on the
+value of `org-export-odt-fontify-srcblocks."
+ (setq lines (org-export-number-lines
+ lines 0 0 num cont rpllbl fmt 'preprocess)
+ lines (funcall
+ (or (and org-export-odt-fontify-srcblocks
+ (or (featurep 'htmlfontify)
+ ;; htmlfontify.el was introduced in Emacs 23.2
+ ;; So load it with some caution
+ (require 'htmlfontify nil t))
+ (fboundp 'htmlfontify-string)
+ 'org-odt-format-source-code-or-example-colored)
+ 'org-odt-format-source-code-or-example-plain)
+ lines lang caption textareap cols rows num cont rpllbl fmt))
+ (if (not num) lines
+ (let ((extra (format " text:continue-numbering=\"%s\""
+ (if cont "true" "false"))))
+ (org-odt-format-tags
+ '("<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>"
+ . "</text:list>") lines extra))))
+
+(defun org-odt-remap-stylenames (style-name)
+ (or
+ (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper")
+ ("timestamp" . "OrgTimestamp")
+ ("timestamp-kwd" . "OrgTimestampKeyword")
+ ("tag" . "OrgTag")
+ ("todo" . "OrgTodo")
+ ("done" . "OrgDone")
+ ("target" . "OrgTarget"))))
+ style-name))
+
+(defun org-odt-format-fontify (text style &optional id)
+ (let* ((style-name
+ (cond
+ ((stringp style)
+ (org-odt-remap-stylenames style))
+ ((symbolp style)
+ (org-odt-get-style-name-for-entity 'character style))
+ ((listp style)
+ (assert (< 1 (length style)))
+ (let ((parent-style (pop style)))
+ (mapconcat (lambda (s)
+ ;; (assert (stringp s) t)
+ (org-odt-remap-stylenames s)) style "")
+ (org-odt-remap-stylenames parent-style)))
+ (t (error "Don't how to handle style %s" style)))))
+ (org-odt-format-tags
+ '("<text:span text:style-name=\"%s\">" . "</text:span>")
+ text style-name)))
+
+(defun org-odt-relocate-relative-path (path dir)
+ (if (file-name-absolute-p path) path
+ (file-relative-name (expand-file-name path dir)
+ (expand-file-name "eyecandy" dir))))
+
+(defun org-odt-format-inline-image (thefile)
+ (let* ((thelink (if (file-name-absolute-p thefile) thefile
+ (org-xml-format-href
+ (org-odt-relocate-relative-path
+ thefile org-current-export-file))))
+ (href
+ (org-odt-format-tags
+ "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
+ (if org-export-odt-embed-images
+ (org-odt-copy-image-file thefile) thelink))))
+ (org-export-odt-format-image thefile href)))
+
+(defvar org-odt-entity-labels-alist nil
+ "Associate Labels with the Labeled entities.
+Each element of the alist is of the form (LABEL-NAME
+CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as
+that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the
+type of the entity that LABEL-NAME is attached to. CATEGORY-NAME
+can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is
+the unique number assigned to the referenced entity on a
+per-CATEGORY basis. It is generated sequentially and is 1-based.
+LABEL-STYLE-NAME is a key `org-odt-label-styles'.
+
+See `org-odt-add-label-definition' and
+`org-odt-fixup-label-references'.")
+
+(defun org-export-odt-format-formula (src href)
+ (save-match-data
+ (let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (short-caption
+ (or (org-find-text-property-in-string 'org-caption-shortn src)
+ caption))
+ (caption (and caption (org-xml-format-desc caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
+ (label (org-find-text-property-in-string 'org-label src))
+ (latex-frag (org-find-text-property-in-string 'org-latex-src src))
+ (embed-as (or (and latex-frag
+ (org-find-text-property-in-string
+ 'org-latex-src-embed-type src))
+ (if (or caption label) 'paragraph 'character)))
+ width height)
+ (when latex-frag
+ (setq href (org-propertize href :title "LaTeX Fragment"
+ :description latex-frag)))
+ (cond
+ ((eq embed-as 'character)
+ (org-odt-format-entity "InlineFormula" href width height))
+ (t
+ (org-lparse-end-paragraph)
+ (org-lparse-insert-list-table
+ `((,(org-odt-format-entity
+ (if (not (or caption label)) "DisplayFormula"
+ "CaptionedDisplayFormula")
+ href width height :caption caption :label label
+ :short-caption short-caption)
+ ,(if (not (or caption label)) ""
+ (let* ((label-props (car org-odt-entity-labels-alist)))
+ (setcar (last label-props) "math-label")
+ (apply 'org-odt-format-label-definition
+ caption label-props)))))
+ nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1)))
+ (throw 'nextline nil))))))
+
+(defvar org-odt-embedded-formulas-count 0)
+(defun org-odt-copy-formula-file (path)
+ "Returns the internal name of the file"
+ (let* ((src-file (expand-file-name
+ path (file-name-directory org-current-export-file)))
+ (target-dir (format "Formula-%04d/"
+ (incf org-odt-embedded-formulas-count)))
+ (target-file (concat target-dir "content.xml")))
+ (when (not org-lparse-to-buffer)
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+
+ (make-directory target-dir)
+ (org-odt-create-manifest-file-entry
+ "application/vnd.oasis.opendocument.formula" target-dir "1.2")
+
+ (case (org-odt-is-formula-link-p src-file)
+ (mathml
+ (copy-file src-file target-file 'overwrite))
+ (odf
+ (org-odt-zip-extract-one src-file "content.xml" target-dir))
+ (t
+ (error "%s is not a formula file" src-file)))
+
+ (org-odt-create-manifest-file-entry "text/xml" target-file))
+ target-file))
+
+(defun org-odt-format-inline-formula (thefile)
+ (let* ((thelink (if (file-name-absolute-p thefile) thefile
+ (org-xml-format-href
+ (org-odt-relocate-relative-path
+ thefile org-current-export-file))))
+ (href
+ (org-odt-format-tags
+ "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
+ (file-name-directory (org-odt-copy-formula-file thefile)))))
+ (org-export-odt-format-formula thefile href)))
+
+(defun org-odt-is-formula-link-p (file)
+ (let ((case-fold-search nil))
+ (cond
+ ((string-match "\\.\\(mathml\\|mml\\)\\'" file)
+ 'mathml)
+ ((string-match "\\.odf\\'" file)
+ 'odf))))
+
+(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr
+ descp)
+ "Make a OpenDocument link.
+OPT-PLIST is an options list.
+TYPE-1 is the device-type of the link (THIS://foo.html).
+PATH is the path of the link (http://THIS#location).
+FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
+DESC is the link description, if any.
+ATTR is a string of other attributes of the a element."
+ (declare (special org-lparse-par-open))
+ (save-match-data
+ (let* ((may-inline-p
+ (and (member type-1 '("http" "https" "file"))
+ (org-lparse-should-inline-p path descp)
+ (not fragment)))
+ (type (if (equal type-1 "id") "file" type-1))
+ (filename path)
+ (thefile path)
+ sec-frag sec-nos)
+ (cond
+ ;; check for inlined images
+ ((and (member type '("file"))
+ (not fragment)
+ (org-file-image-p
+ filename org-export-odt-inline-image-extensions)
+ (or (eq t org-export-odt-inline-images)
+ (and org-export-odt-inline-images (not descp))))
+ (org-odt-format-inline-image thefile))
+ ;; check for embedded formulas
+ ((and (member type '("file"))
+ (not fragment)
+ (org-odt-is-formula-link-p filename)
+ (or (not descp)))
+ (org-odt-format-inline-formula thefile))
+ ;; code references
+ ((string= type "coderef")
+ (let* ((ref fragment)
+ (lineno-or-ref (cdr (assoc ref org-export-code-refs)))
+ (desc (and descp desc))
+ (org-odt-suppress-xref nil)
+ (href (org-xml-format-href (concat "#coderef-" ref))))
+ (cond
+ ((and (numberp lineno-or-ref) (not desc))
+ (org-odt-format-link lineno-or-ref href))
+ ((and (numberp lineno-or-ref) desc
+ (string-match (regexp-quote (concat "(" ref ")")) desc))
+ (format (replace-match "%s" t t desc)
+ (org-odt-format-link lineno-or-ref href)))
+ (t
+ (setq desc (format
+ (if (and desc (string-match
+ (regexp-quote (concat "(" ref ")"))
+ desc))
+ (replace-match "%s" t t desc)
+ (or desc "%s"))
+ lineno-or-ref))
+ (org-odt-format-link (org-xml-format-desc desc) href)))))
+ ;; links to headlines
+ ((and (string= type "")
+ (or (not thefile) (string= thefile ""))
+ (plist-get org-lparse-opt-plist :section-numbers)
+ (setq sec-frag fragment)
+ (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)
+ (and (setq sec-frag
+ (loop for alias in org-export-target-aliases do
+ (when (member fragment (cdr alias))
+ (return (car alias)))))
+ (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)))
+ (setq sec-nos (org-split-string (match-string 1 sec-frag) "-"))
+ (<= (length sec-nos) (plist-get org-lparse-opt-plist
+ :headline-levels)))
+ (let ((org-odt-suppress-xref nil))
+ (org-odt-format-link sec-nos (concat "#" sec-frag) attr)))
+ (t
+ (when (string= type "file")
+ (setq thefile
+ (cond
+ ((file-name-absolute-p path)
+ (concat "file://" (expand-file-name path)))
+ (t (org-odt-relocate-relative-path
+ thefile org-current-export-file)))))
+
+ (when (and (member type '("" "http" "https" "file")) fragment)
+ (setq thefile (concat thefile "#" fragment)))
+
+ (setq thefile (org-xml-format-href thefile))
+
+ (when (not (member type '("" "file")))
+ (setq thefile (concat type ":" thefile)))
+
+ (let ((org-odt-suppress-xref nil))
+ (org-odt-format-link
+ (org-xml-format-desc desc) thefile attr)))))))
+
+(defun org-odt-format-heading (text level &optional id)
+ (let* ((text (if id (org-odt-format-target text id) text)))
+ (org-odt-format-tags
+ '("<text:h text:style-name=\"Heading_20_%s\" text:outline-level=\"%s\">" .
+ "</text:h>") text level level)))
+
+(defun org-odt-format-headline (title extra-targets tags
+ &optional snumber level)
+ (concat
+ (org-lparse-format 'EXTRA-TARGETS extra-targets)
+
+ ;; No need to generate section numbers. They are auto-generated by
+ ;; the application
+
+ ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
+ title
+ (and tags (concat (org-lparse-format 'SPACES 3)
+ (org-lparse-format 'ORG-TAGS tags)))))
+
+(defun org-odt-format-anchor (text name &optional class)
+ (org-odt-format-target text name))
+
+(defun org-odt-format-bookmark (text id)
+ (if id
+ (org-odt-format-tags "<text:bookmark text:name=\"%s\"/>" text id)
+ text))
+
+(defun org-odt-format-target (text id)
+ (let ((name (concat org-export-odt-bookmark-prefix id)))
+ (concat
+ (and id (org-odt-format-tags
+ "<text:bookmark-start text:name=\"%s\"/>" "" name))
+ (org-odt-format-bookmark text id)
+ (and id (org-odt-format-tags
+ "<text:bookmark-end text:name=\"%s\"/>" "" name)))))
+
+(defun org-odt-format-footnote (n def)
+ (let ((id (concat "fn" n))
+ (note-class "footnote")
+ (par-style "Footnote"))
+ (org-odt-format-tags
+ '("<text:note text:id=\"%s\" text:note-class=\"%s\">" .
+ "</text:note>")
+ (concat
+ (org-odt-format-tags
+ '("<text:note-citation>" . "</text:note-citation>")
+ n)
+ (org-odt-format-tags
+ '("<text:note-body>" . "</text:note-body>")
+ def))
+ id note-class)))
+
+(defun org-odt-format-footnote-reference (n def refcnt)
+ (if (= refcnt 1)
+ (org-odt-format-footnote n def)
+ (org-odt-format-footnote-ref n)))
+
+(defun org-odt-format-footnote-ref (n)
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (org-odt-format-tags
+ '("<text:span text:style-name=\"%s\">" . "</text:span>")
+ (org-odt-format-tags
+ '("<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">" . "</text:note-ref>")
+ n note-class ref-format ref-name)
+ "OrgSuperscript")))
+
+(defun org-odt-get-image-name (file-name)
+ (require 'sha1)
+ (file-relative-name
+ (expand-file-name
+ (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
+
+(defun org-export-odt-format-image (src href)
+ "Create image tag with source and attributes."
+ (save-match-data
+ (let* ((caption (org-find-text-property-in-string 'org-caption src))
+ (short-caption
+ (or (org-find-text-property-in-string 'org-caption-shortn src)
+ caption))
+ (caption (and caption (org-xml-format-desc caption)))
+ (short-caption (and short-caption
+ (org-xml-encode-plain-text short-caption)))
+ (attr (org-find-text-property-in-string 'org-attributes src))
+ (label (org-find-text-property-in-string 'org-label src))
+ (latex-frag (org-find-text-property-in-string
+ 'org-latex-src src))
+ (category (and latex-frag "__DvipngImage__"))
+ (attr-plist (org-lparse-get-block-params attr))
+ (user-frame-anchor
+ (car (assoc-string (plist-get attr-plist :anchor)
+ '(("as-char") ("paragraph") ("page")) t)))
+ (user-frame-style
+ (and user-frame-anchor (plist-get attr-plist :style)))
+ (user-frame-attrs
+ (and user-frame-anchor (plist-get attr-plist :attributes)))
+ (user-frame-params
+ (list user-frame-style user-frame-attrs user-frame-anchor))
+ (embed-as (cond
+ (latex-frag
+ (symbol-name
+ (case (org-find-text-property-in-string
+ 'org-latex-src-embed-type src)
+ (paragraph 'paragraph)
+ (t 'as-char))))
+ (user-frame-anchor)
+ (t "paragraph")))
+ (size (org-odt-image-size-from-file
+ src (plist-get attr-plist :width)
+ (plist-get attr-plist :height)
+ (plist-get attr-plist :scale) nil embed-as))
+ (width (car size)) (height (cdr size)))
+ (when latex-frag
+ (setq href (org-propertize href :title "LaTeX Fragment"
+ :description latex-frag)))
+ (let ((frame-style-handle (concat (and (or caption label) "Captioned")
+ embed-as "Image")))
+ (org-odt-format-entity
+ frame-style-handle href width height
+ :caption caption :label label :category category
+ :short-caption short-caption
+ :user-frame-params user-frame-params)))))
+
+(defun org-odt-format-object-description (title description)
+ (concat (and title (org-odt-format-tags
+ '("<svg:title>" . "</svg:title>")
+ (org-odt-encode-plain-text title t)))
+ (and description (org-odt-format-tags
+ '("<svg:desc>" . "</svg:desc>")
+ (org-odt-encode-plain-text description t)))))
+
+(defun org-odt-format-frame (text width height style &optional
+ extra anchor-type)
+ (let ((frame-attrs
+ (concat
+ (if width (format " svg:width=\"%0.2fcm\"" width) "")
+ (if height (format " svg:height=\"%0.2fcm\"" height) "")
+ extra
+ (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")))))
+ (org-odt-format-tags
+ '("<draw:frame draw:style-name=\"%s\"%s>" . "</draw:frame>")
+ (concat text (org-odt-format-object-description
+ (get-text-property 0 :title text)
+ (get-text-property 0 :description text)))
+ style frame-attrs)))
+
+(defun org-odt-format-textbox (text width height style &optional
+ extra anchor-type)
+ (org-odt-format-frame
+ (org-odt-format-tags
+ '("<draw:text-box %s>" . "</draw:text-box>")
+ text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
+ (unless width
+ (format " fo:min-width=\"%0.2fcm\"" (or width .2)))))
+ width nil style extra anchor-type))
+
+(defun org-odt-format-inlinetask (heading content
+ &optional todo priority tags)
+ (org-odt-format-stylized-paragraph
+ nil (org-odt-format-textbox
+ (concat (org-odt-format-stylized-paragraph
+ "OrgInlineTaskHeading"
+ (org-lparse-format
+ 'HEADLINE (concat (org-lparse-format-todo todo) " " heading)
+ nil tags))
+ content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
+
+(defvar org-odt-entity-frame-styles
+ '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
+ ("CaptionedAs-CharImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgInlineImage" nil "as-char"))
+ ("CaptionedParagraphImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage" "__Figure__"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgPageImageCaptionFrame" nil "page"))
+ ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
+ ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
+ ("CaptionedDisplayFormula" "__MathFormula__"
+ ("OrgCaptionedFormula" nil "paragraph")
+ ("OrgFormulaCaptionFrame" nil "as-char"))))
+
+(defun org-odt-merge-frame-params(default-frame-params user-frame-params)
+ (if (not user-frame-params) default-frame-params
+ (assert (= (length default-frame-params) 3))
+ (assert (= (length user-frame-params) 3))
+ (loop for user-frame-param in user-frame-params
+ for default-frame-param in default-frame-params
+ collect (or user-frame-param default-frame-param))))
+
+(defun* org-odt-format-entity (entity href width height
+ &key caption label category
+ user-frame-params short-caption)
+ (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
+ default-frame-params frame-params)
+ (cond
+ ((not (or caption label))
+ (setq default-frame-params (nth 2 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-odt-format-frame href width height frame-params))
+ (t
+ (setq default-frame-params (nth 3 entity-style))
+ (setq frame-params (org-odt-merge-frame-params
+ default-frame-params user-frame-params))
+ (apply 'org-odt-format-textbox
+ (org-odt-format-stylized-paragraph
+ 'illustration
+ (concat
+ (apply 'org-odt-format-frame href width height
+ (let ((entity-style-1 (copy-sequence
+ (nth 2 entity-style))))
+ (setcar (cdr entity-style-1)
+ (concat
+ (cadr entity-style-1)
+ (and short-caption
+ (format " draw:name=\"%s\" "
+ short-caption))))
+
+ entity-style-1))
+ (org-odt-format-entity-caption
+ label caption (or category (nth 1 entity-style)))))
+ width height frame-params)))))
+
+(defvar org-odt-embedded-images-count 0)
+(defun org-odt-copy-image-file (path)
+ "Returns the internal name of the file"
+ (let* ((image-type (file-name-extension path))
+ (media-type (format "image/%s" image-type))
+ (src-file (expand-file-name
+ path (file-name-directory org-current-export-file)))
+ (target-dir "Images/")
+ (target-file
+ (format "%s%04d.%s" target-dir
+ (incf org-odt-embedded-images-count) image-type)))
+ (when (not org-lparse-to-buffer)
+ (message "Embedding %s as %s ..."
+ (substring-no-properties path) target-file)
+
+ (when (= 1 org-odt-embedded-images-count)
+ (make-directory target-dir)
+ (org-odt-create-manifest-file-entry "" target-dir))
+
+ (copy-file src-file target-file 'overwrite)
+ (org-odt-create-manifest-file-entry media-type target-file))
+ target-file))
+
+(defvar org-export-odt-image-size-probe-method
+ (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
+ '(emacs fixed))
+ "Ordered list of methods for determining image sizes.")
+
+(defvar org-export-odt-default-image-sizes-alist
+ '(("as-char" . (5 . 0.4))
+ ("paragraph" . (5 . 5)))
+ "Hardcoded image dimensions one for each of the anchor
+ methods.")
+
+;; A4 page size is 21.0 by 29.7 cms
+;; The default page settings has 2cm margin on each of the sides. So
+;; the effective text area is 17.0 by 25.7 cm
+(defvar org-export-odt-max-image-size '(17.0 . 20.0)
+ "Limiting dimensions for an embedded image.")
+
+(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
+ (let* ((dpi (or dpi org-export-odt-pixels-per-inch))
+ (anchor-type (or anchor-type "paragraph"))
+ (--pixels-to-cms
+ (function
+ (lambda (pixels dpi)
+ (let* ((cms-per-inch 2.54)
+ (inches (/ pixels dpi)))
+ (* cms-per-inch inches)))))
+ (--size-in-cms
+ (function
+ (lambda (size-in-pixels dpi)
+ (and size-in-pixels
+ (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
+ (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))))
+ (case probe-method
+ (emacs
+ (let ((size-in-pixels
+ (ignore-errors ; Emacs could be in batch mode
+ (clear-image-cache)
+ (image-size (create-image file) 'pixels))))
+ (funcall --size-in-cms size-in-pixels dpi)))
+ (imagemagick
+ (let ((size-in-pixels
+ (let ((dim (shell-command-to-string
+ (format "identify -format \"%%w:%%h\" \"%s\"" file))))
+ (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
+ (cons (string-to-number (match-string 1 dim))
+ (string-to-number (match-string 2 dim)))))))
+ (funcall --size-in-cms size-in-pixels dpi)))
+ (t (cdr (assoc-string anchor-type
+ org-export-odt-default-image-sizes-alist))))))
+
+(defun org-odt-image-size-from-file (file &optional user-width
+ user-height scale dpi embed-as)
+ (unless (file-name-absolute-p file)
+ (setq file (expand-file-name
+ file (file-name-directory org-current-export-file))))
+ (let* (size width height)
+ (unless (and user-height user-width)
+ (loop for probe-method in org-export-odt-image-size-probe-method
+ until size
+ do (setq size (org-odt-do-image-size
+ probe-method file dpi embed-as)))
+ (or size (error "Cannot determine image size, aborting"))
+ (setq width (car size) height (cdr size)))
+ (cond
+ (scale
+ (setq width (* width scale) height (* height scale)))
+ ((and user-height user-width)
+ (setq width user-width height user-height))
+ (user-height
+ (setq width (* user-height (/ width height)) height user-height))
+ (user-width
+ (setq height (* user-width (/ height width)) width user-width))
+ (t (ignore)))
+ ;; ensure that an embedded image fits comfortably within a page
+ (let ((max-width (car org-export-odt-max-image-size))
+ (max-height (cdr org-export-odt-max-image-size)))
+ (when (or (> width max-width) (> height max-height))
+ (let* ((scale1 (/ max-width width))
+ (scale2 (/ max-height height))
+ (scale (min scale1 scale2)))
+ (setq width (* scale width) height (* scale height)))))
+ (cons width height)))
+
+(defvar org-odt-entity-counts-plist nil
+ "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs.
+See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.")
+
+(defvar org-odt-label-styles
+ '(("math-formula" "%c" "text" "(%n)")
+ ("math-label" "(%n)" "text" "(%n)")
+ ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
+ ("value" "%e %n: %c" "value" "%n"))
+ "Specify how labels are applied and referenced.
+This is an alist where each element is of the
+form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
+LABEL-REF-FMT).
+
+LABEL-ATTACH-FMT controls how labels and captions are attached to
+an entity. It may contain following specifiers - %e, %n and %c.
+%e is replaced with the CATEGORY-NAME. %n is replaced with
+\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
+with CAPTION. See `org-odt-format-label-definition'.
+
+LABEL-REF-MODE and LABEL-REF-FMT controls how label references
+are generated. The following XML is generated for a label
+reference - \"<text:sequence-ref
+text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
+</text:sequence-ref>\". LABEL-REF-FMT may contain following
+specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
+%n is replaced with SEQNO. See
+`org-odt-format-label-reference'.")
+
+(defcustom org-export-odt-category-strings
+ '(("en" "Table" "Figure" "Equation" "Equation"))
+ "Specify category strings for various captionable entities.
+Captionable entity can be one of a Table, an Embedded Image, a
+LaTeX fragment (generated with dvipng) or a Math Formula.
+
+For example, when `org-export-default-language' is \"en\", an
+embedded image will be captioned as \"Figure 1: Orgmode Logo\".
+If you want the images to be captioned instead as \"Illustration
+1: Orgmode Logo\", then modify the entry for \"en\" as shown
+below.
+
+ \(setq org-export-odt-category-strings
+ '\(\(\"en\" \"Table\" \"Illustration\"
+ \"Equation\" \"Equation\"\)\)\)"
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(repeat (list (string :tag "Language tag")
+ (choice :tag "Table"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Figure"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Math Formula"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string"))
+ (choice :tag "Dvipng Image"
+ (const :tag "Use Default" nil)
+ (string :tag "Category string")))))
+
+(defvar org-odt-category-map-alist
+ '(("__Table__" "Table" "value")
+ ("__Figure__" "Illustration" "value")
+ ("__MathFormula__" "Text" "math-formula")
+ ("__DvipngImage__" "Equation" "value")
+ ;; ("__Table__" "Table" "category-and-value")
+ ;; ("__Figure__" "Figure" "category-and-value")
+ ;; ("__DvipngImage__" "Equation" "category-and-value")
+ )
+ "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
+This is a list where each entry is of the form \\(CATEGORY-HANDLE
+OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the
+captionable entity in question. OD-VARIABLE is the OpenDocument
+sequence counter associated with the entity. These counters are
+declared within
+\"<text:sequence-decls>...</text:sequence-decls>\" block of
+`org-export-odt-content-template-file'. LABEL-STYLE is a key
+into `org-odt-label-styles' and specifies how a given entity
+should be captioned and referenced.
+
+The position of a CATEGORY-HANDLE in this list is used as an
+index in to per-language entry for
+`org-export-odt-category-strings' to retrieve a CATEGORY-NAME.
+This CATEGORY-NAME is then used for qualifying the user-specified
+captions on export.")
+
+(defun org-odt-add-label-definition (label default-category)
+ "Create an entry in `org-odt-entity-labels-alist' and return it."
+ (let* ((label-props (assoc default-category org-odt-category-map-alist))
+ ;; identify the sequence number
+ (counter (nth 1 label-props))
+ (sequence-var (intern counter))
+ (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var)
+ 0)))
+ ;; assign an internal label, if user has not provided one
+ (label (if label (substring-no-properties label)
+ (format "%s-%s" default-category seqno)))
+ ;; identify label style
+ (label-style (nth 2 label-props))
+ ;; grok language setting
+ (en-strings (assoc-default "en" org-export-odt-category-strings))
+ (lang (plist-get org-lparse-opt-plist :language))
+ (lang-strings (assoc-default lang org-export-odt-category-strings))
+ ;; retrieve localized category sting
+ (pos (- (length org-odt-category-map-alist)
+ (length (memq label-props org-odt-category-map-alist))))
+ (category (or (nth pos lang-strings) (nth pos en-strings)))
+ (label-props (list label category counter seqno label-style)))
+ ;; synchronize internal counters
+ (setq org-odt-entity-counts-plist
+ (plist-put org-odt-entity-counts-plist sequence-var seqno))
+ ;; stash label properties for later retrieval
+ (push label-props org-odt-entity-labels-alist)
+ label-props))
+
+(defun org-odt-format-label-definition (caption label category counter
+ seqno label-style)
+ (assert label)
+ (format-spec
+ (cadr (assoc-string label-style org-odt-label-styles t))
+ `((?e . ,category)
+ (?n . ,(org-odt-format-tags
+ '("<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">" . "</text:sequence>")
+ (format "%d" seqno) label counter counter))
+ (?c . ,(or caption "")))))
+
+(defun org-odt-format-label-reference (label category counter
+ seqno label-style)
+ (assert label)
+ (save-match-data
+ (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
+ (fmt1 (car fmt))
+ (fmt2 (cadr fmt)))
+ (org-odt-format-tags
+ '("<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">"
+ . "</text:sequence-ref>")
+ (format-spec fmt2 `((?e . ,category)
+ (?n . ,(format "%d" seqno)))) fmt1 label))))
+
+(defun org-odt-fixup-label-references ()
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<text:sequence-ref text:ref-name=\"\\([^\"]+\\)\">[ \t\n]*</text:sequence-ref>"
+ nil t)
+ (let* ((label (match-string 1))
+ (label-def (assoc label org-odt-entity-labels-alist))
+ (rpl (and label-def
+ (apply 'org-odt-format-label-reference label-def))))
+ (if rpl (replace-match rpl t t)
+ (org-lparse-warn
+ (format "Unable to resolve reference to label \"%s\"" label))))))
+
+(defun org-odt-format-entity-caption (label caption category)
+ (if (not (or label caption)) ""
+ (apply 'org-odt-format-label-definition caption
+ (org-odt-add-label-definition label category))))
+
+(defun org-odt-format-tags (tag text &rest args)
+ (let ((prefix (when org-lparse-encode-pending "@"))
+ (suffix (when org-lparse-encode-pending "@")))
+ (apply 'org-lparse-format-tags tag text prefix suffix args)))
+
+(defvar org-odt-manifest-file-entries nil)
+(defun org-odt-init-outfile (filename)
+ (unless (executable-find "zip")
+ ;; Not at all OSes ship with zip by default
+ (error "Executable \"zip\" needed for creating OpenDocument files"))
+
+ (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir)))
+ ;; init conten.xml
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect content-file t))
+
+ ;; reset variables
+ (setq org-odt-manifest-file-entries nil
+ org-odt-embedded-images-count 0
+ org-odt-embedded-formulas-count 0
+ org-odt-entity-labels-alist nil
+ org-odt-list-stack-stashed nil
+ org-odt-automatic-styles nil
+ org-odt-object-counters nil
+ org-odt-entity-counts-plist nil)
+ content-file))
+
+(defcustom org-export-odt-prettify-xml nil
+ "Specify whether or not the xml output should be prettified.
+When this option is turned on, `indent-region' is run on all
+component xml buffers before they are saved. Turn this off for
+regular use. Turn this on if you need to examine the xml
+visually."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse
+(defun org-odt-save-as-outfile (target opt-plist)
+ ;; write automatic styles
+ (org-odt-write-automatic-styles)
+
+ ;; write meta file
+ (org-odt-update-meta-file opt-plist)
+
+ ;; write styles file
+ (when (equal org-lparse-backend 'odt)
+ (org-odt-update-styles-file opt-plist))
+
+ ;; create mimetype file
+ (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend)))
+ (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
+
+ ;; create a manifest entry for content.xml
+ (org-odt-create-manifest-file-entry "text/xml" "content.xml")
+
+ ;; write out the manifest entries before zipping
+ (org-odt-write-manifest-file)
+
+ (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
+ "meta.xml")))
+ (when (equal org-lparse-backend 'odt)
+ (push "styles.xml" xml-files))
+
+ ;; save all xml files
+ (mapc (lambda (file)
+ (with-current-buffer
+ (find-file-noselect (expand-file-name file) t)
+ ;; prettify output if needed
+ (when org-export-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))
+ xml-files)
+
+ (let* ((target-name (file-name-nondirectory target))
+ (target-dir (file-name-directory target))
+ (cmds `(("zip" "-mX0" ,target-name "mimetype")
+ ("zip" "-rmTq" ,target-name "."))))
+ (when (file-exists-p target)
+ ;; FIXME: If the file is locked this throws a cryptic error
+ (delete-file target))
+
+ (let ((coding-system-for-write 'no-conversion) exitcode err-string)
+ (message "Creating odt file...")
+ (mapc
+ (lambda (cmd)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (ignore (message "%s" err-string))
+ (error "Unable to create odt file (%S)" exitcode)))
+ cmds))
+
+ ;; move the file from outdir to target-dir
+ (rename-file target-name target-dir)))
+
+ (message "Created %s" target)
+ (set-buffer (find-file-noselect target t)))
+
+(defconst org-odt-manifest-file-entry-tag
+ "
+<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
+
+(defun org-odt-create-manifest-file-entry (&rest args)
+ (push args org-odt-manifest-file-entries))
+
+(defun org-odt-write-manifest-file ()
+ (make-directory "META-INF")
+ (let ((manifest-file (expand-file-name "META-INF/manifest.xml")))
+ (with-current-buffer
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect manifest-file t))
+ (insert
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
+ (mapc
+ (lambda (file-entry)
+ (let* ((version (nth 2 file-entry))
+ (extra (if version
+ (format " manifest:version=\"%s\"" version)
+ "")))
+ (insert
+ (format org-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
+ org-odt-manifest-file-entries)
+ (insert "\n</manifest:manifest>"))))
+
+(defun org-odt-update-meta-file (opt-plist)
+ (let ((date (org-odt-format-date (plist-get opt-plist :date)))
+ (author (or (plist-get opt-plist :author) ""))
+ (email (plist-get opt-plist :email))
+ (keywords (plist-get opt-plist :keywords))
+ (description (plist-get opt-plist :description))
+ (title (plist-get opt-plist :title)))
+ (write-region
+ (concat
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <office:document-meta
+ xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
+ xmlns:xlink=\"http://www.w3.org/1999/xlink\"
+ xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
+ xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
+ xmlns:ooo=\"http://openoffice.org/2004/office\"
+ office:version=\"1.2\">
+ <office:meta>" "\n"
+ (org-odt-format-author)
+ (org-odt-format-tags
+ '("\n<meta:initial-creator>" . "</meta:initial-creator>") author)
+ (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date)
+ (org-odt-format-tags
+ '("\n<meta:creation-date>" . "</meta:creation-date>") date)
+ (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
+ (when org-export-creator-info
+ (format "Org-%s/Emacs-%s"
+ (org-version)
+ emacs-version)))
+ (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
+ (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)
+ (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title)
+ "\n"
+ " </office:meta>" "</office:document-meta>")
+ nil (expand-file-name "meta.xml")))
+
+ ;; create a manifest entry for meta.xml
+ (org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
+
+(defun org-odt-update-styles-file (opt-plist)
+ ;; write styles file
+ (let ((styles-file (plist-get opt-plist :odt-styles-file)))
+ (org-odt-copy-styles-file (and styles-file
+ (read (org-trim styles-file)))))
+
+ ;; Update styles.xml - take care of outline numbering
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "styles.xml") t)
+ ;; Don't make automatic backup of styles.xml file. This setting
+ ;; prevents the backed-up styles.xml file from being zipped in to
+ ;; odt file. This is more of a hackish fix. Better alternative
+ ;; would be to fix the zip command so that the output odt file
+ ;; includes only the needed files and excludes any auto-generated
+ ;; extra files like backups and auto-saves etc etc. Note that
+ ;; currently the zip command zips up the entire temp directory so
+ ;; that any auto-generated files created under the hood ends up in
+ ;; the resulting odt file.
+ (set (make-local-variable 'backup-inhibited) t)
+
+ ;; Import local setting of `org-export-with-section-numbers'
+ (org-lparse-bind-local-variables opt-plist)
+ (org-odt-configure-outline-numbering
+ (if org-export-with-section-numbers org-export-headline-levels 0)))
+
+ ;; Write custom styles for source blocks
+ (org-odt-insert-custom-styles-for-srcblocks
+ (mapconcat
+ (lambda (style)
+ (format " %s\n" (cddr style)))
+ hfy-user-sheet-assoc "")))
+
+(defun org-odt-write-mimetype-file (format)
+ ;; create mimetype file
+ (let ((mimetype
+ (case format
+ (odt "application/vnd.oasis.opendocument.text")
+ (odf "application/vnd.oasis.opendocument.formula")
+ (t (error "Unknown OpenDocument backend %S" org-lparse-backend)))))
+ (write-region mimetype nil (expand-file-name "mimetype"))
+ mimetype))
+
+(defun org-odt-finalize-outfile ()
+ (org-odt-delete-empty-paragraphs))
+
+(defun org-odt-delete-empty-paragraphs ()
+ (goto-char (point-min))
+ (let ((open "<text:p[^>]*>")
+ (close "</text:p>"))
+ (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
+ (replace-match ""))))
+
+(defcustom org-export-odt-convert-processes
+ '(("LibreOffice"
+ "soffice --headless --convert-to %f%x --outdir %d %i")
+ ("unoconv"
+ "unoconv -f %f -o %d %i"))
+ "Specify a list of document converters and their usage.
+The converters in this list are offered as choices while
+customizing `org-export-odt-convert-process'.
+
+This variable is a list where each element is of the
+form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
+of the converter. CONVERTER-CMD is the shell command for the
+converter and can contain format specifiers. These format
+specifiers are interpreted as below:
+
+%i input file name in full
+%I input file name as a URL
+%f format of the output file
+%o output file name in full
+%O output file name as a URL
+%d output dir in full
+%D output dir as a URL.
+%x extra options as set in `org-export-odt-convert-capabilities'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Converters"
+ :key-type (string :tag "Converter Name")
+ :value-type (group (string :tag "Command line")))))
+
+(defcustom org-export-odt-convert-process "LibreOffice"
+ "Use this converter to convert from \"odt\" format to other formats.
+During customization, the list of converter names are populated
+from `org-export-odt-convert-processes'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,(car c) ,(car c)))
+ org-export-odt-convert-processes))))
+
+(defcustom org-export-odt-convert-capabilities
+ '(("Text"
+ ("odt" "ott" "doc" "rtf" "docx")
+ (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
+ ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
+ ("Web"
+ ("html")
+ (("pdf" "pdf") ("odt" "odt") ("html" "html")))
+ ("Spreadsheet"
+ ("ods" "ots" "xls" "csv" "xlsx")
+ (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
+ ("xls" "xls") ("xlsx" "xlsx")))
+ ("Presentation"
+ ("odp" "otp" "ppt" "pptx")
+ (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
+ ("pptx" "pptx") ("odg" "odg"))))
+ "Specify input and output formats of `org-export-odt-convert-process'.
+More correctly, specify the set of input and output formats that
+the user is actually interested in.
+
+This variable is an alist where each element is of the
+form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
+INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
+alist where each element is of the form (OUTPUT-FMT
+OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
+
+The variable is interpreted as follows:
+`org-export-odt-convert-process' can take any document that is in
+INPUT-FMT-LIST and produce any document that is in the
+OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
+OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
+serves dual purposes:
+- It is used for populating completion candidates during
+ `org-export-odt-convert' commands.
+- It is used as the value of \"%f\" specifier in
+ `org-export-odt-convert-process'.
+
+EXTRA-OPTIONS is used as the value of \"%x\" specifier in
+`org-export-odt-convert-process'.
+
+DOCUMENT-CLASS is used to group a set of file formats in
+INPUT-FMT-LIST in to a single class.
+
+Note that this variable inherently captures how LibreOffice based
+converters work. LibreOffice maps documents of various formats
+to classes like Text, Web, Spreadsheet, Presentation etc and
+allow document of a given class (irrespective of it's source
+format) to be converted to any of the export formats associated
+with that class.
+
+See default setting of this variable for an typical
+configuration."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Capabilities"
+ :key-type (string :tag "Document Class")
+ :value-type
+ (group (repeat :tag "Input formats" (string :tag "Input format"))
+ (alist :tag "Output formats"
+ :key-type (string :tag "Output format")
+ :value-type
+ (group (string :tag "Output file extension")
+ (choice
+ (const :tag "None" nil)
+ (string :tag "Extra options"))))))))
+
+(declare-function org-create-math-formula "org"
+ (latex-frag &optional mathml-file))
+
+;;;###autoload
+(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg)
+ "Convert IN-FILE to format OUT-FMT using a command line converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. OUT-FMT is the desired output
+format. Use `org-export-odt-convert-process' as the converter.
+If PREFIX-ARG is non-nil then the newly converted file is opened
+using `org-open-file'."
+ (interactive
+ (append (org-lparse-convert-read-params) current-prefix-arg))
+ (org-lparse-do-convert in-file out-fmt prefix-arg))
+
+(defun org-odt-get (what &optional opt-plist)
+ (case what
+ (BACKEND 'odt)
+ (EXPORT-DIR (org-export-directory :html opt-plist))
+ (FILE-NAME-EXTENSION "odt")
+ (EXPORT-BUFFER-NAME "*Org ODT Export*")
+ (ENTITY-CONTROL org-odt-entity-control-callbacks-alist)
+ (ENTITY-FORMAT org-odt-entity-format-callbacks-alist)
+ (INIT-METHOD 'org-odt-init-outfile)
+ (FINAL-METHOD 'org-odt-finalize-outfile)
+ (SAVE-METHOD 'org-odt-save-as-outfile)
+ (CONVERT-METHOD
+ (and org-export-odt-convert-process
+ (cadr (assoc-string org-export-odt-convert-process
+ org-export-odt-convert-processes t))))
+ (CONVERT-CAPABILITIES
+ (and org-export-odt-convert-process
+ (cadr (assoc-string org-export-odt-convert-process
+ org-export-odt-convert-processes t))
+ org-export-odt-convert-capabilities))
+ (TOPLEVEL-HLEVEL 1)
+ (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
+ (INLINE-IMAGES 'maybe)
+ (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg"))
+ (PLAIN-TEXT-MAP '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (TABLE-FIRST-COLUMN-AS-LABELS nil)
+ (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
+ (CODING-SYSTEM-FOR-WRITE 'utf-8)
+ (CODING-SYSTEM-FOR-SAVE 'utf-8)
+ (t (error "Unknown property: %s" what))))
+
+(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
+(defun org-export-odt-do-preprocess-latex-fragments ()
+ "Convert LaTeX fragments to images."
+ (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments))
+ (latex-frag-opt ; massage the options
+ (or (and (member latex-frag-opt '(mathjax t))
+ (not (and (fboundp 'org-format-latex-mathml-available-p)
+ (org-format-latex-mathml-available-p)))
+ (prog1 org-lparse-latex-fragment-fallback
+ (org-lparse-warn
+ (concat
+ "LaTeX to MathML converter not available. "
+ (format "Using %S instead."
+ org-lparse-latex-fragment-fallback)))))
+ latex-frag-opt))
+ cache-dir display-msg)
+ (cond
+ ((eq latex-frag-opt 'dvipng)
+ (setq cache-dir org-latex-preview-ltxpng-directory)
+ (setq display-msg "Creating LaTeX image %s"))
+ ((member latex-frag-opt '(mathjax t))
+ (setq latex-frag-opt 'mathml)
+ (setq cache-dir "ltxmathml/")
+ (setq display-msg "Creating MathML formula %s")))
+ (when (and org-current-export-file)
+ (org-format-latex
+ (concat cache-dir (file-name-sans-extension
+ (file-name-nondirectory org-current-export-file)))
+ org-current-export-dir nil display-msg
+ nil nil latex-frag-opt))))
+
+(defadvice org-format-latex-as-mathml
+ (after org-odt-protect-latex-fragment activate)
+ "Encode LaTeX fragment as XML.
+Do this when translation to MathML fails."
+ (when (or (not (> (length ad-return-value) 0))
+ (get-text-property 0 'org-protected ad-return-value))
+ (setq ad-return-value
+ (org-propertize (org-odt-encode-plain-text (ad-get-arg 0))
+ 'org-protected t))))
+
+(defun org-export-odt-preprocess-latex-fragments ()
+ (when (equal org-export-current-backend 'odt)
+ (org-export-odt-do-preprocess-latex-fragments)))
+
+(defun org-export-odt-preprocess-label-references ()
+ (goto-char (point-min))
+ (let (label label-components category value pretty-label)
+ (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
+ (org-if-unprotected-at (match-beginning 1)
+ (replace-match
+ (let ((org-lparse-encode-pending t)
+ (label (match-string 1)))
+ ;; markup generated below is mostly an eye-candy. At
+ ;; pre-processing stage, there is no information on which
+ ;; entity a label reference points to. The actual markup
+ ;; is generated as part of `org-odt-fixup-label-references'
+ ;; which gets called at the fag end of export. By this
+ ;; time we would have seen and collected all the label
+ ;; definitions in `org-odt-entity-labels-alist'.
+ (org-odt-format-tags
+ '("<text:sequence-ref text:ref-name=\"%s\">" .
+ "</text:sequence-ref>")
+ "" (org-add-props label '(org-protected t)))) t t)))))
+
+;; process latex fragments as part of
+;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
+;; is the one that is closest and well before the call to
+;; `org-export-attach-captions-and-attributes' in
+;; `org-export-preprocess-string'. The above arrangement permits
+;; captions, labels and attributes to be attached to png images
+;; generated out of latex equations.
+(add-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-export-odt-preprocess-latex-fragments)
+
+(defun org-export-odt-preprocess (parameters)
+ (org-export-odt-preprocess-label-references))
+
+(declare-function archive-zip-extract "arc-mode.el" (archive name))
+(defun org-odt-zip-extract-one (archive member &optional target)
+ (require 'arc-mode)
+ (let* ((target (or target default-directory))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed"))))
+
+(defun org-odt-zip-extract (archive members &optional target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (member)
+ (org-odt-zip-extract-one archive member target))
+ members))
+
+(defun org-odt-copy-styles-file (&optional styles-file)
+ ;; Non-availability of styles.xml is not a critical error. For now
+ ;; throw an error purely for aesthetic reasons.
+ (setq styles-file (or styles-file
+ org-export-odt-styles-file
+ (expand-file-name "OrgOdtStyles.xml"
+ org-odt-styles-dir)
+ (error "org-odt: Missing styles file?")))
+ (cond
+ ((listp styles-file)
+ (let ((archive (nth 0 styles-file))
+ (members (nth 1 styles-file)))
+ (org-odt-zip-extract archive members)
+ (mapc
+ (lambda (member)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-create-manifest-file-entry media-type member))))
+ members)))
+ ((and (stringp styles-file) (file-exists-p styles-file))
+ (let ((styles-file-type (file-name-extension styles-file)))
+ (cond
+ ((string= styles-file-type "xml")
+ (copy-file styles-file "styles.xml" t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-odt-zip-extract styles-file "styles.xml")))))
+ (t
+ (error (format "Invalid specification of styles.xml file: %S"
+ org-export-odt-styles-file))))
+
+ ;; create a manifest entry for styles.xml
+ (org-odt-create-manifest-file-entry "text/xml" "styles.xml"))
+
+(defun org-odt-configure-outline-numbering (level)
+ "Outline numbering is retained only upto LEVEL.
+To disable outline numbering pass a LEVEL of 0."
+ (goto-char (point-min))
+ (let ((regex
+ "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
+ (replacement
+ "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
+ (while (re-search-forward regex nil t)
+ (when (> (string-to-number (match-string 2)) level)
+ (replace-match replacement t nil))))
+ (save-buffer 0))
+
+;;;###autoload
+(defun org-export-as-odf (latex-frag &optional odf-file)
+ "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
+Use `org-create-math-formula' to convert LATEX-FRAG first to
+MathML. When invoked as an interactive command, use
+`org-latex-regexps' to infer LATEX-FRAG from currently active
+region. If no LaTeX fragments are found, prompt for it. Push
+MathML source to kill ring, if `org-export-copy-to-kill-ring' is
+non-nil."
+ (interactive
+ `(,(let (frag)
+ (setq frag (and (setq frag (and (org-region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
+ (read-string "LaTeX Fragment: " frag nil frag))
+ ,(let ((odf-filename (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (read-file-name "ODF filename: " nil odf-filename nil
+ (file-name-nondirectory odf-filename)))))
+ (org-odt-cleanup-xml-buffers
+ (let* ((org-lparse-backend 'odf)
+ org-lparse-opt-plist
+ (filename (or odf-file
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (buffer (find-file-noselect (org-odt-init-outfile filename)))
+ (coding-system-for-write 'utf-8)
+ (save-buffer-coding-system 'utf-8))
+ (set-buffer buffer)
+ (set-buffer-file-coding-system coding-system-for-write)
+ (let ((mathml (org-create-math-formula latex-frag)))
+ (unless mathml (error "No Math formula created"))
+ (insert mathml)
+ (or (org-export-push-to-kill-ring
+ (upcase (symbol-name org-lparse-backend)))
+ (message "Exporting... done")))
+ (org-odt-save-as-outfile filename nil))))
+
+;;;###autoload
+(defun org-export-as-odf-and-open ()
+ "Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file."
+ (interactive)
+ (org-lparse-and-open
+ nil nil nil (call-interactively 'org-export-as-odf)))
+
+(provide 'org-odt)
+
+;;; org-odt.el ends here
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
new file mode 100644
index 0000000..6467840
--- /dev/null
+++ b/lisp/org-pcomplete.el
@@ -0,0 +1,337 @@
+;;; org-pcomplete.el --- In-buffer completion code
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; John Wiegley <johnw at gnu dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+;;;; Require other packages
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'org-macs)
+(require 'org-compat)
+(require 'pcomplete)
+
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-get-current-options "org-exp" ())
+(declare-function org-make-org-heading-search-string "org"
+ (&optional string heading))
+(declare-function org-get-buffer-tags "org" ())
+(declare-function org-get-tags "org" ())
+(declare-function org-buffer-property-keys "org"
+ (&optional include-specials include-defaults include-columns))
+(declare-function org-entry-properties "org" (&optional pom which specific))
+
+;;;; Customization variables
+
+(defgroup org-complete nil
+ "Outline-based notes management and organizer."
+ :tag "Org"
+ :group 'org)
+
+(defvar org-drawer-regexp)
+(defvar org-property-re)
+
+(defun org-thing-at-point ()
+ "Examine the thing at point and let the caller know what it is.
+The return value is a string naming the thing at point."
+ (let ((beg1 (save-excursion
+ (skip-chars-backward (org-re "[:alnum:]-_@"))
+ (point)))
+ (beg (save-excursion
+ (skip-chars-backward "a-zA-Z0-9-_:$")
+ (point)))
+ (line-to-here (buffer-substring (point-at-bol) (point))))
+ (cond
+ ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here)
+ (cons "block-option" "clocktable"))
+ ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here)
+ (cons "block-option" "src"))
+ ((save-excursion
+ (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
+ (line-beginning-position) t))
+ (cons "file-option" (match-string-no-properties 1)))
+ ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here)
+ (cons "file-option" nil))
+ ((equal (char-before beg) ?\[)
+ (cons "link" nil))
+ ((equal (char-before beg) ?\\)
+ (cons "tex" nil))
+ ((string-match "\\`\\*+[ \t]+\\'"
+ (buffer-substring (point-at-bol) beg))
+ (cons "todo" nil))
+ ((equal (char-before beg) ?*)
+ (cons "searchhead" nil))
+ ((and (equal (char-before beg1) ?:)
+ (equal (char-after (point-at-bol)) ?*))
+ (cons "tag" nil))
+ ((and (equal (char-before beg1) ?:)
+ (not (equal (char-after (point-at-bol)) ?*))
+ (save-excursion
+ (move-beginning-of-line 1)
+ (skip-chars-backward "[ \t\n]")
+ ;; org-drawer-regexp matches a whole line but while
+ ;; looking-back, we just ignore trailing whitespaces
+ (or (org-looking-back (substring org-drawer-regexp 0 -1))
+ (org-looking-back org-property-re))))
+ (cons "prop" nil))
+ ((and (equal (char-before beg1) ?:)
+ (not (equal (char-after (point-at-bol)) ?*)))
+ (cons "drawer" nil))
+ (t nil))))
+
+(defun org-command-at-point ()
+ "Return the qualified name of the Org completion entity at point.
+When completing for #+STARTUP, for example, this function returns
+\"file-option/startup\"."
+ (let ((thing (org-thing-at-point)))
+ (cond
+ ((string= "file-option" (car thing))
+ (concat (car thing) "/" (downcase (cdr thing))))
+ ((string= "block-option" (car thing))
+ (concat (car thing) "/" (downcase (cdr thing))))
+ (t
+ (car thing)))))
+
+(defun org-parse-arguments ()
+ "Parse whitespace separated arguments in the current region."
+ (let ((begin (line-beginning-position))
+ (end (line-end-position))
+ begins args)
+ (save-restriction
+ (narrow-to-region begin end)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n[")
+ (setq begins (cons (point) begins))
+ (skip-chars-forward "^ \t\n[")
+ (setq args (cons (buffer-substring-no-properties
+ (car begins) (point))
+ args)))
+ (cons (reverse args) (reverse begins))))))
+
+(defun org-pcomplete-initial ()
+ "Calls the right completion function for first argument completions."
+ (ignore
+ (funcall (or (pcomplete-find-completion-function
+ (car (org-thing-at-point)))
+ pcomplete-default-completion-function))))
+
+(defvar org-options-keywords) ; From org.el
+(defvar org-additional-option-like-keywords) ; From org.el
+(defun pcomplete/org-mode/file-option ()
+ "Complete against all valid file options."
+ (require 'org-exp)
+ (pcomplete-here
+ (org-pcomplete-case-double
+ (mapcar (lambda (x)
+ (if (= ?: (aref x (1- (length x))))
+ (concat x " ")
+ x))
+ (append org-options-keywords
+ org-additional-option-like-keywords)))
+ (substring pcomplete-stub 2)))
+
+(defvar org-startup-options)
+(defun pcomplete/org-mode/file-option/startup ()
+ "Complete arguments for the #+STARTUP file option."
+ (while (pcomplete-here
+ (let ((opts (pcomplete-uniqify-list
+ (mapcar 'car org-startup-options))))
+ ;; Some options are mutually exclusive, and shouldn't be completed
+ ;; against if certain other options have already been seen.
+ (dolist (arg pcomplete-args)
+ (cond
+ ((string= arg "hidestars")
+ (setq opts (delete "showstars" opts)))))
+ opts))))
+
+(defmacro pcomplete/org-mode/file-option/x (option)
+ "Complete arguments for OPTION."
+ `(while
+ (pcomplete-here
+ (pcomplete-uniqify-list
+ (delq nil
+ (mapcar (lambda(o)
+ (when (string-match (concat "^[ \t]*#\\+"
+ ,option ":[ \t]+\\(.*\\)[ \t]*$") o)
+ (match-string 1 o)))
+ (split-string (org-get-current-options) "\n")))))))
+
+(defun pcomplete/org-mode/file-option/options ()
+ "Complete arguments for the #+OPTIONS file option."
+ (pcomplete/org-mode/file-option/x "OPTIONS"))
+
+(defun pcomplete/org-mode/file-option/title ()
+ "Complete arguments for the #+TITLE file option."
+ (pcomplete/org-mode/file-option/x "TITLE"))
+
+(defun pcomplete/org-mode/file-option/author ()
+ "Complete arguments for the #+AUTHOR file option."
+ (pcomplete/org-mode/file-option/x "AUTHOR"))
+
+(defun pcomplete/org-mode/file-option/email ()
+ "Complete arguments for the #+EMAIL file option."
+ (pcomplete/org-mode/file-option/x "EMAIL"))
+
+(defun pcomplete/org-mode/file-option/date ()
+ "Complete arguments for the #+DATE file option."
+ (pcomplete/org-mode/file-option/x "DATE"))
+
+(defun pcomplete/org-mode/file-option/bind ()
+ "Complete arguments for the #+BIND file option, which are variable names."
+ (let (vars)
+ (mapatoms
+ (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars)))))
+ (pcomplete-here vars)))
+
+(defvar org-link-abbrev-alist-local)
+(defvar org-link-abbrev-alist)
+(defun pcomplete/org-mode/link ()
+ "Complete against defined #+LINK patterns."
+ (pcomplete-here
+ (pcomplete-uniqify-list
+ (copy-sequence
+ (append (mapcar 'car org-link-abbrev-alist-local)
+ (mapcar 'car org-link-abbrev-alist))))))
+
+(defvar org-entities)
+(defun pcomplete/org-mode/tex ()
+ "Complete against TeX-style HTML entity names."
+ (require 'org-entities)
+ (while (pcomplete-here
+ (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities)))
+ (substring pcomplete-stub 1))))
+
+(defvar org-todo-keywords-1)
+(defun pcomplete/org-mode/todo ()
+ "Complete against known TODO keywords."
+ (pcomplete-here (pcomplete-uniqify-list (copy-sequence org-todo-keywords-1))))
+
+(defvar org-todo-line-regexp)
+(defun pcomplete/org-mode/searchhead ()
+ "Complete against all headings.
+This needs more work, to handle headings with lots of spaces in them."
+ (while
+ (pcomplete-here
+ (save-excursion
+ (goto-char (point-min))
+ (let (tbl)
+ (while (re-search-forward org-todo-line-regexp nil t)
+ (push (org-make-org-heading-search-string
+ (match-string-no-properties 3) t)
+ tbl))
+ (pcomplete-uniqify-list tbl)))
+ (substring pcomplete-stub 1))))
+
+(defvar org-tag-alist)
+(defun pcomplete/org-mode/tag ()
+ "Complete a tag name. Omit tags already set."
+ (while (pcomplete-here
+ (mapcar (lambda (x)
+ (concat x ":"))
+ (let ((lst (pcomplete-uniqify-list
+ (or (remove
+ nil
+ (mapcar (lambda (x)
+ (and (stringp (car x)) (car x)))
+ org-tag-alist))
+ (mapcar 'car (org-get-buffer-tags))))))
+ (dolist (tag (org-get-tags))
+ (setq lst (delete tag lst)))
+ lst))
+ (and (string-match ".*:" pcomplete-stub)
+ (substring pcomplete-stub (match-end 0))))))
+
+(defun pcomplete/org-mode/prop ()
+ "Complete a property name. Omit properties already set."
+ (pcomplete-here
+ (mapcar (lambda (x)
+ (concat x ": "))
+ (let ((lst (pcomplete-uniqify-list
+ (copy-sequence
+ (org-buffer-property-keys nil t t)))))
+ (dolist (prop (org-entry-properties))
+ (setq lst (delete (car prop) lst)))
+ lst))
+ (substring pcomplete-stub 1)))
+
+(defvar org-drawers)
+
+(defun pcomplete/org-mode/drawer ()
+ "Complete a drawer name."
+ (let ((spc (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at "^\\([ \t]*\\):")
+ (match-string 1)))
+ (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
+ (pcomplete-here cpllist
+ (substring pcomplete-stub 1)
+ (unless (or (not (delete
+ nil
+ (mapcar (lambda(x)
+ (string-match (substring pcomplete-stub 1) x))
+ cpllist)))
+ (looking-at "[ \t]*\n.*:END:"))
+ (save-excursion (insert "\n" spc ":END:"))))))
+
+(defun pcomplete/org-mode/block-option/src ()
+ "Complete the arguments of a begin_src block.
+Complete a language in the first field, the header arguments and switches."
+ (pcomplete-here
+ (mapcar
+ (lambda(x) (symbol-name (nth 3 x)))
+ (cdr (car (cdr (memq :key-type (plist-get
+ (symbol-plist
+ 'org-babel-load-languages)
+ 'custom-type)))))))
+ (while (pcomplete-here
+ '("-n" "-r" "-l"
+ ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
+ ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
+ ":session" ":shebang" ":tangle" ":var"))))
+
+(defun pcomplete/org-mode/block-option/clocktable ()
+ "Complete keywords in a clocktable line."
+ (while (pcomplete-here '(":maxlevel" ":scope"
+ ":tstart" ":tend" ":block" ":step"
+ ":stepskip0" ":fileskip0"
+ ":emphasize" ":link" ":narrow" ":indent"
+ ":tcolumns" ":level" ":compact" ":timestamp"
+ ":formula" ":formatter"))))
+
+(defun org-pcomplete-case-double (list)
+ "Return list with both upcase and downcase version of all strings in LIST."
+ (let (e res)
+ (while (setq e (pop list))
+ (setq res (cons (downcase e) (cons (upcase e) res))))
+ (nreverse res)))
+
+;;;; Finish up
+
+(provide 'org-pcomplete)
+
+;;; org-pcomplete.el ends here
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
new file mode 100644
index 0000000..48d72ac
--- /dev/null
+++ b/lisp/org-plot.el
@@ -0,0 +1,354 @@
+;;; org-plot.el --- Support for plotting from Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Author: Eric Schulte <schulte dot eric at gmail dot com>
+;; Keywords: tables, plotting
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Borrows ideas and a couple of lines of code from org-exp.el.
+
+;; Thanks to the org-mode mailing list for testing and implementation
+;; and feature suggestions
+
+;;; Code:
+(require 'org)
+(require 'org-exp)
+(require 'org-table)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
+(declare-function gnuplot-mode "ext:gnuplot" ())
+(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ())
+
+(defvar org-plot/gnuplot-default-options
+ '((:plot-type . 2d)
+ (:with . lines)
+ (:ind . 0))
+ "Default options to gnuplot used by `org-plot/gnuplot'.")
+
+(defvar org-plot-timestamp-fmt nil)
+
+(defun org-plot/add-options-to-plist (p options)
+ "Parse an OPTIONS line and set values in the property list P.
+Returns the resulting property list."
+ (let (o)
+ (when options
+ (let ((op '(("type" . :plot-type)
+ ("script" . :script)
+ ("line" . :line)
+ ("set" . :set)
+ ("title" . :title)
+ ("ind" . :ind)
+ ("deps" . :deps)
+ ("with" . :with)
+ ("file" . :file)
+ ("labels" . :labels)
+ ("map" . :map)
+ ("timeind" . :timeind)
+ ("timefmt" . :timefmt)))
+ (multiples '("set" "line"))
+ (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
+ (start 0)
+ o)
+ (while (setq o (pop op))
+ (if (member (car o) multiples) ;; keys with multiple values
+ (while (string-match
+ (concat (regexp-quote (car o)) regexp)
+ options start)
+ (setq start (match-end 0))
+ (setq p (plist-put p (cdr o)
+ (cons (car (read-from-string
+ (match-string 1 options)))
+ (plist-get p (cdr o)))))
+ p)
+ (if (string-match (concat (regexp-quote (car o)) regexp)
+ options)
+ (setq p (plist-put p (cdr o)
+ (car (read-from-string
+ (match-string 1 options)))))))))))
+ p)
+
+(defun org-plot/goto-nearest-table ()
+ "Move the point forward to the beginning of nearest table.
+Return value is the point at the beginning of the table."
+ (interactive) (move-beginning-of-line 1)
+ (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
+ (goto-char (org-table-begin)))
+
+(defun org-plot/collect-options (&optional params)
+ "Collect options from an org-plot '#+Plot:' line.
+Accepts an optional property list PARAMS, to which the options
+will be added. Returns the resulting property list."
+ (interactive)
+ (let ((line (thing-at-point 'line)))
+ (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
+ (org-plot/add-options-to-plist params (match-string 1 line))
+ params)))
+
+(defun org-plot-quote-timestamp-field (s)
+ "Convert field S from timestamp to Unix time and export to gnuplot."
+ (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s)))
+
+(defun org-plot-quote-tsv-field (s)
+ "Quote field S for export to gnuplot."
+ (if (string-match org-table-number-regexp s) s
+ (if (string-match org-ts-regexp3 s)
+ (org-plot-quote-timestamp-field s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
+
+(defun org-plot/gnuplot-to-data (table data-file params)
+ "Export TABLE to DATA-FILE in a format readable by gnuplot.
+Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
+ (with-temp-file
+ data-file
+ (make-local-variable 'org-plot-timestamp-fmt)
+ (setq org-plot-timestamp-fmt (or
+ (plist-get params :timefmt)
+ "%Y-%m-%d-%H:%M:%S"))
+ (insert (orgtbl-to-generic
+ table
+ (org-combine-plists
+ '(:sep "\t" :fmt org-plot-quote-tsv-field)
+ params))))
+ nil)
+
+(defun org-plot/gnuplot-to-grid-data (table data-file params)
+ "Export the data in TABLE to DATA-FILE for gnuplot.
+This means in a format appropriate for grid plotting by gnuplot.
+PARAMS specifies which columns of TABLE should be plotted as independent
+and dependant variables."
+ (interactive)
+ (let* ((ind (- (plist-get params :ind) 1))
+ (deps (if (plist-member params :deps)
+ (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
+ (let (collector)
+ (dotimes (col (length (first table)))
+ (setf collector (cons col collector)))
+ collector)))
+ (counter 0)
+ row-vals)
+ (when (>= ind 0) ;; collect values of ind col
+ (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
+ (cons counter (nth ind row))) table)))
+ (when (or deps (>= ind 0)) ;; remove non-plotting columns
+ (setf deps (delq ind deps))
+ (setf table (mapcar (lambda (row)
+ (dotimes (col (length row))
+ (unless (memq col deps)
+ (setf (nth col row) nil)))
+ (delq nil row))
+ table)))
+ ;; write table to gnuplot grid datafile format
+ (with-temp-file data-file
+ (let ((num-rows (length table)) (num-cols (length (first table)))
+ (gnuplot-row (lambda (col row value)
+ (setf col (+ 1 col)) (setf row (+ 1 row))
+ (format "%f %f %f\n%f %f %f\n"
+ col (- row 0.5) value ;; lower edge
+ col (+ row 0.5) value))) ;; upper edge
+ front-edge back-edge)
+ (dotimes (col num-cols)
+ (dotimes (row num-rows)
+ (setf back-edge
+ (concat back-edge
+ (funcall gnuplot-row (- col 1) row
+ (string-to-number (nth col (nth row table))))))
+ (setf front-edge
+ (concat front-edge
+ (funcall gnuplot-row col row
+ (string-to-number (nth col (nth row table)))))))
+ ;; only insert once per row
+ (insert back-edge) (insert "\n") ;; back edge
+ (insert front-edge) (insert "\n") ;; front edge
+ (setf back-edge "") (setf front-edge ""))))
+ row-vals))
+
+(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
+ "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
+NUM-COLS controls the number of columns plotted in a 2-d plot.
+Optional argument PREFACE returns only option parameters in a
+manner suitable for prepending to a user-specified script."
+ (let* ((type (plist-get params :plot-type))
+ (with (if (equal type 'grid)
+ 'pm3d
+ (plist-get params :with)))
+ (sets (plist-get params :set))
+ (lines (plist-get params :line))
+ (map (plist-get params :map))
+ (title (plist-get params :title))
+ (file (plist-get params :file))
+ (ind (plist-get params :ind))
+ (time-ind (plist-get params :timeind))
+ (timefmt (plist-get params :timefmt))
+ (text-ind (plist-get params :textind))
+ (deps (if (plist-member params :deps) (plist-get params :deps)))
+ (col-labels (plist-get params :labels))
+ (x-labels (plist-get params :xlabels))
+ (y-labels (plist-get params :ylabels))
+ (plot-str "'%s' using %s%d%s with %s title '%s'")
+ (plot-cmd (case type
+ ('2d "plot")
+ ('3d "splot")
+ ('grid "splot")))
+ (script "reset")
+ ; ats = add-to-script
+ (ats (lambda (line) (setf script (format "%s\n%s" script line))))
+ plot-lines)
+ (when file ;; output file
+ (funcall ats (format "set term %s" (file-name-extension file)))
+ (funcall ats (format "set output '%s'" file)))
+ (case type ;; type
+ ('2d ())
+ ('3d (if map (funcall ats "set map")))
+ ('grid (if map (funcall ats "set pm3d map")
+ (funcall ats "set pm3d"))))
+ (when title (funcall ats (format "set title '%s'" title))) ;; title
+ (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
+ (when sets ;; set
+ (mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
+ (when x-labels ;; x labels (xtics)
+ (funcall ats
+ (format "set xtics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ x-labels ", "))))
+ (when y-labels ;; y labels (ytics)
+ (funcall ats
+ (format "set ytics (%s)"
+ (mapconcat (lambda (pair)
+ (format "\"%s\" %d" (cdr pair) (car pair)))
+ y-labels ", "))))
+ (when time-ind ;; timestamp index
+ (funcall ats "set xdata time")
+ (funcall ats (concat "set timefmt \""
+ (or timefmt ;; timefmt passed to gnuplot
+ "%Y-%m-%d-%H:%M:%S") "\"")))
+ (unless preface
+ (case type ;; plot command
+ ('2d (dotimes (col num-cols)
+ (unless (and (equal type '2d)
+ (or (and ind (equal (+ 1 col) ind))
+ (and deps (not (member (+ 1 col) deps)))))
+ (setf plot-lines
+ (cons
+ (format plot-str data-file
+ (or (and ind (> ind 0)
+ (not text-ind)
+ (format "%d:" ind)) "")
+ (+ 1 col)
+ (if text-ind (format ":xticlabel(%d)" ind) "")
+ with
+ (or (nth col col-labels) (format "%d" (+ 1 col))))
+ plot-lines)))))
+ ('3d
+ (setq plot-lines (list (format "'%s' matrix with %s title ''"
+ data-file with))))
+ ('grid
+ (setq plot-lines (list (format "'%s' with %s title ''"
+ data-file with)))))
+ (funcall ats
+ (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
+ script))
+
+;;-----------------------------------------------------------------------------
+;; facade functions
+;;;###autoload
+(defun org-plot/gnuplot (&optional params)
+ "Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
+If not given options will be taken from the +PLOT
+line directly before or after the table."
+ (interactive)
+ (require 'gnuplot)
+ (save-window-excursion
+ (delete-other-windows)
+ (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
+ (with-current-buffer "*gnuplot*"
+ (goto-char (point-max))
+ (gnuplot-delchar-or-maybe-eof nil)))
+ (org-plot/goto-nearest-table)
+ ;; set default options
+ (mapc
+ (lambda (pair)
+ (unless (plist-member params (car pair))
+ (setf params (plist-put params (car pair) (cdr pair)))))
+ org-plot/gnuplot-default-options)
+ ;; collect table and table information
+ (let* ((data-file (make-temp-file "org-plot"))
+ (table (org-table-to-lisp))
+ (num-cols (length (if (eq (first table) 'hline) (second table)
+ (first table)))))
+ (while (equal 'hline (first table)) (setf table (cdr table)))
+ (when (equal (second table) 'hline)
+ (setf params (plist-put params :labels (first table))) ;; headers to labels
+ (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
+ ;; collect options
+ (save-excursion (while (and (equal 0 (forward-line -1))
+ (looking-at "[[:space:]]*#\\+"))
+ (setf params (org-plot/collect-options params))))
+ ;; dump table to datafile (very different for grid)
+ (case (plist-get params :plot-type)
+ ('2d (org-plot/gnuplot-to-data table data-file params))
+ ('3d (org-plot/gnuplot-to-data table data-file params))
+ ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
+ table data-file params)))
+ (when y-labels (plist-put params :ylabels y-labels)))))
+ ;; check for timestamp ind column
+ (let ((ind (- (plist-get params :ind) 1)))
+ (when (and (>= ind 0) (equal '2d (plist-get params :plot-type)))
+ (if (= (length
+ (delq 0 (mapcar
+ (lambda (el)
+ (if (string-match org-ts-regexp3 el)
+ 0 1))
+ (mapcar (lambda (row) (nth ind row)) table)))) 0)
+ (plist-put params :timeind t)
+ ;; check for text ind column
+ (if (or (string= (plist-get params :with) "hist")
+ (> (length
+ (delq 0 (mapcar
+ (lambda (el)
+ (if (string-match org-table-number-regexp el)
+ 0 1))
+ (mapcar (lambda (row) (nth ind row)) table)))) 0))
+ (plist-put params :textind t)))))
+ ;; write script
+ (with-temp-buffer
+ (if (plist-get params :script) ;; user script
+ (progn (insert
+ (org-plot/gnuplot-script data-file num-cols params t))
+ (insert "\n")
+ (insert-file-contents (plist-get params :script))
+ (goto-char (point-min))
+ (while (re-search-forward "$datafile" nil t)
+ (replace-match data-file nil nil)))
+ (insert
+ (org-plot/gnuplot-script data-file num-cols params)))
+ ;; graph table
+ (gnuplot-mode)
+ (gnuplot-send-buffer-to-gnuplot))
+ ;; cleanup
+ (bury-buffer (get-buffer "*gnuplot*"))
+ (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file))))))
+
+(provide 'org-plot)
+
+;;; org-plot.el ends here
diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
new file mode 100644
index 0000000..31f6fb2
--- /dev/null
+++ b/lisp/org-protocol.el
@@ -0,0 +1,652 @@
+;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
+;;
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;;
+;; Authors: Bastien Guerry <bzg AT gnu DOT org>
+;; Daniel M German <dmg AT uvic DOT org>
+;; Sebastian Rose <sebastian_rose AT gmx DOT de>
+;; Ross Patterson <me AT rpatterson DOT net>
+;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
+;; Keywords: org, emacsclient, wp
+
+;; 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:
+;;
+;; Intercept calls from emacsclient to trigger custom actions.
+;;
+;; This is done by advising `server-visit-files' to scan the list of filenames
+;; for `org-protocol-the-protocol' and sub-protocols defined in
+;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'.
+;;
+;; Any application that supports calling external programs with an URL
+;; as argument may be used with this functionality.
+;;
+;;
+;; Usage:
+;; ------
+;;
+;; 1.) Add this to your init file (.emacs probably):
+;;
+;; (add-to-list 'load-path "/path/to/org-protocol/")
+;; (require 'org-protocol)
+;;
+;; 3.) Ensure emacs-server is up and running.
+;; 4.) Try this from the command line (adjust the URL as needed):
+;;
+;; $ emacsclient \
+;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
+;;
+;; 5.) Optionally add custom sub-protocols and handlers:
+;;
+;; (setq org-protocol-protocol-alist
+;; '(("my-protocol"
+;; :protocol "my-protocol"
+;; :function my-protocol-handler-function)))
+;;
+;; A "sub-protocol" will be found in URLs like this:
+;;
+;; org-protocol://sub-protocol://data
+;;
+;; If it works, you can now setup other applications for using this feature.
+;;
+;;
+;; As of March 2009 Firefox users follow the steps documented on
+;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
+;; http://www.opera.com/support/kb/view/535/
+;;
+;;
+;; Documentation
+;; -------------
+;;
+;; org-protocol.el comes with and installs handlers to open sources of published
+;; online content, store and insert the browser's URLs and cite online content
+;; by clicking on a bookmark in Firefox, Opera and probably other browsers and
+;; applications:
+;;
+;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
+;; URLs to local filenames defined in `org-protocol-project-alist'.
+;;
+;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and
+;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
+;; triggered through the sub-protocol \"store-link\".
+;;
+;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
+;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the
+;; template with the data provided. I.e. the browser's URL is inserted as an
+;; Org-link of which the page title will be the description part. If text
+;; was select in the browser, that text will be the body of the entry.
+;;
+;; * Call `org-protocol-remember' by using the sub-protocol \"remember\".
+;; This is provided for backward compatibility.
+;; You may read `org-capture' as `org-remember' throughout this file if
+;; you still use `org-remember'.
+;;
+;; You may use the same bookmark URL for all those standard handlers and just
+;; adjust the sub-protocol used:
+;;
+;; location.href='org-protocol://sub-protocol://'+
+;; encodeURIComponent(location.href)+'/'+
+;; encodeURIComponent(document.title)+'/'+
+;; encodeURIComponent(window.getSelection())
+;;
+;; The handler for the sub-protocol \"capture\" detects an optional template
+;; char that, if present, triggers the use of a special template.
+;; Example:
+;;
+;; location.href='org-protocol://sub-protocol://x/'+ ...
+;;
+;; use template ?x.
+;;
+;; Note, that using double slashes is optional from org-protocol.el's point of
+;; view because emacsclient squashes the slashes to one.
+;;
+;;
+;; provides: 'org-protocol
+;;
+;;; Code:
+
+(require 'org)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-publish-get-project-from-filename "org-publish"
+ (filename &optional up))
+(declare-function server-edit "server" (&optional arg))
+
+(define-obsolete-function-alias
+ 'org-protocol-unhex-compound 'org-link-unescape-compound
+ "2011-02-17")
+
+(define-obsolete-function-alias
+ 'org-protocol-unhex-string 'org-link-unescape
+ "2011-02-17")
+
+(define-obsolete-function-alias
+ 'org-protocol-unhex-single-byte-sequence
+ 'org-link-unescape-single-byte-sequence
+ "2011-02-17")
+
+(defgroup org-protocol nil
+ "Intercept calls from emacsclient to trigger custom actions.
+
+This is done by advising `server-visit-files' to scan the list of filenames
+for `org-protocol-the-protocol' and sub-protocols defined in
+`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'."
+ :version "22.1"
+ :group 'convenience
+ :group 'org)
+
+
+;;; Variables:
+
+(defconst org-protocol-protocol-alist-default
+ '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t)
+ ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t)
+ ("org-store-link" :protocol "store-link" :function org-protocol-store-link)
+ ("org-open-source" :protocol "open-source" :function org-protocol-open-source))
+ "Default protocols to use.
+See `org-protocol-protocol-alist' for a description of this variable.")
+
+(defconst org-protocol-the-protocol "org-protocol"
+ "This is the protocol to detect if org-protocol.el is loaded.
+`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
+the sub-protocols that trigger the required action. You will have to define
+just one protocol handler OS-wide (MS-Windows) or per application (Linux).
+That protocol handler should call emacsclient.")
+
+;;; User variables:
+
+(defcustom org-protocol-reverse-list-of-files t
+ "Non-nil means re-reverse the list of filenames passed on the command line.
+The filenames passed on the command line are passed to the emacs-server in
+reverse order. Set to t (default) to re-reverse the list, i.e. use the
+sequence on the command line. If nil, the sequence of the filenames is
+unchanged."
+ :group 'org-protocol
+ :type 'boolean)
+
+(defcustom org-protocol-project-alist nil
+ "Map URLs to local filenames for `org-protocol-open-source' (open-source).
+
+Each element of this list must be of the form:
+
+ (module-name :property value property: value ...)
+
+where module-name is an arbitrary name. All the values are strings.
+
+Possible properties are:
+
+ :online-suffix - the suffix to strip from the published URLs
+ :working-suffix - the replacement for online-suffix
+ :base-url - the base URL, e.g. http://www.example.com/project/
+ Last slash required.
+ :working-directory - the local working directory. This is, what base-url will
+ be replaced with.
+ :redirects - A list of cons cells, each of which maps a regular
+ expression to match to a path relative to :working-directory.
+
+Example:
+
+ (setq org-protocol-project-alist
+ '((\"http://orgmode.org/worg/\"
+ :online-suffix \".php\"
+ :working-suffix \".org\"
+ :base-url \"http://orgmode.org/worg/\"
+ :working-directory \"/home/user/org/Worg/\")
+ (\"http://localhost/org-notes/\"
+ :online-suffix \".html\"
+ :working-suffix \".org\"
+ :base-url \"http://localhost/org/\"
+ :working-directory \"/home/user/org/\"
+ :rewrites ((\"org/?$\" . \"index.php\")))))
+
+ The last line tells `org-protocol-open-source' to open
+ /home/user/org/index.php, if the URL cannot be mapped to an existing
+ file, and ends with either \"org\" or \"org/\".
+
+Consider using the interactive functions `org-protocol-create' and
+`org-protocol-create-for-org' to help you filling this variable with valid contents."
+ :group 'org-protocol
+ :type 'alist)
+
+(defcustom org-protocol-protocol-alist nil
+ "Register custom handlers for org-protocol.
+
+Each element of this list must be of the form:
+
+ (module-name :protocol protocol :function func :kill-client nil)
+
+protocol - protocol to detect in a filename without trailing colon and slashes.
+ See rfc1738 section 2.1 for more on this.
+ If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
+ will search filenames for \"org-protocol:/my-protocol:/\"
+ and trigger your action for every match. `org-protocol' is defined in
+ `org-protocol-the-protocol'. Double and triple slashes are compressed
+ to one by emacsclient.
+
+function - function that handles requests with protocol and takes exactly one
+ argument: the filename with all protocols stripped. If the function
+ returns nil, emacsclient and -server do nothing. Any non-nil return
+ value is considered a valid filename and thus passed to the server.
+
+ `org-protocol.el provides some support for handling those filenames,
+ if you stay with the conventions used for the standard handlers in
+ `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
+
+kill-client - If t, kill the client immediately, once the sub-protocol is
+ detected. This is necessary for actions that can be interrupted by
+ `C-g' to avoid dangling emacsclients. Note, that all other command
+ line arguments but the this one will be discarded, greedy handlers
+ still receive the whole list of arguments though.
+
+Here is an example:
+
+ (setq org-protocol-protocol-alist
+ '((\"my-protocol\"
+ :protocol \"my-protocol\"
+ :function my-protocol-handler-function)
+ (\"your-protocol\"
+ :protocol \"your-protocol\"
+ :function your-protocol-handler-function)))"
+ :group 'org-protocol
+ :type '(alist))
+
+(defcustom org-protocol-default-template-key nil
+ "The default template key to use.
+This is usually a single character string but can also be a
+string with two characters."
+ :group 'org-protocol
+ :type 'string)
+
+(defcustom org-protocol-data-separator "/+"
+ "The default data separator to use.
+ This should be a single regexp string."
+ :group 'org-protocol
+ :type 'string)
+
+;;; Helper functions:
+
+(defun org-protocol-sanitize-uri (uri)
+ "emacsclient compresses double and triple slashes.
+Slashes are sanitized to double slashes here."
+ (when (string-match "^\\([a-z]+\\):/" uri)
+ (let* ((splitparts (split-string uri "/+")))
+ (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
+ uri)
+
+(defun org-protocol-split-data (data &optional unhexify separator)
+ "Split what an org-protocol handler function gets as only argument.
+DATA is that one argument. DATA is split at each occurrence of
+SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
+nil, assume \"/+\". The results of that splitting are returned
+as a list. If UNHEXIFY is non-nil, hex-decode each split part.
+If UNHEXIFY is a function, use that function to decode each split
+part."
+ (let* ((sep (or separator "/+"))
+ (split-parts (split-string data sep)))
+ (if unhexify
+ (if (fboundp unhexify)
+ (mapcar unhexify split-parts)
+ (mapcar 'org-link-unescape split-parts))
+ split-parts)))
+
+(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
+ "Greedy handlers might receive a list like this from emacsclient:
+ '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
+where \"/dir/\" is the absolute path to emacsclients working directory. This
+function transforms it into a flat list using `org-protocol-flatten' and
+transforms the elements of that list as follows:
+
+If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
+param-list.
+
+If replacement is string, replace the \"/dir/\" prefix with it.
+
+The first parameter, the one that contains the protocols, is always changed.
+Everything up to the end of the protocols is stripped.
+
+Note, that this function will always behave as if
+`org-protocol-reverse-list-of-files' was set to t and the returned list will
+reflect that. I.e. emacsclients first parameter will be the first one in the
+returned list."
+ (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
+ param-list
+ (reverse param-list))))
+ (trigger (car l))
+ (len 0)
+ dir
+ ret)
+ (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
+ (setq dir (match-string 1 trigger))
+ (setq len (length dir))
+ (setcar l (concat dir (match-string 3 trigger))))
+ (if strip-path
+ (progn
+ (dolist (e l ret)
+ (setq ret
+ (append ret
+ (list
+ (if (stringp e)
+ (if (stringp replacement)
+ (setq e (concat replacement (substring e len)))
+ (setq e (substring e len)))
+ e)))))
+ ret)
+ l)))
+
+(defun org-protocol-flatten (l)
+ "Greedy handlers might receive a list like this from emacsclient:
+ '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
+where \"/dir/\" is the absolute path to emacsclients working directory.
+This function transforms it into a flat list."
+ (if (null l) ()
+ (if (listp l)
+ (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
+ (list l))))
+
+
+;;; Standard protocol handlers:
+
+(defun org-protocol-store-link (fname)
+ "Process an org-protocol://store-link:// style url.
+Additionally store a browser URL as an org link. Also pushes the
+link's URL to the `kill-ring'.
+
+The location for a browser's bookmark has to look like this:
+
+ javascript:location.href='org-protocol://store-link://'+ \\
+ encodeURIComponent(location.href)
+ encodeURIComponent(document.title)+'/'+ \\
+
+Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
+could contain slashes and the location definitely will.
+
+The sub-protocol used to reach this function is set in
+`org-protocol-protocol-alist'."
+ (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
+ (uri (org-protocol-sanitize-uri (car splitparts)))
+ (title (cadr splitparts))
+ orglink)
+ (if (boundp 'org-stored-links)
+ (setq org-stored-links (cons (list uri title) org-stored-links)))
+ (kill-new uri)
+ (message "`%s' to insert new org-link, `%s' to insert `%s'"
+ (substitute-command-keys"\\[org-insert-link]")
+ (substitute-command-keys"\\[yank]")
+ uri))
+ nil)
+
+(defun org-protocol-remember (info)
+ "Process an org-protocol://remember:// style url.
+
+The location for a browser's bookmark has to look like this:
+
+ javascript:location.href='org-protocol://remember://'+ \\
+ encodeURIComponent(location.href)+'/' \\
+ encodeURIComponent(document.title)+'/'+ \\
+ encodeURIComponent(window.getSelection())
+
+See the docs for `org-protocol-capture' for more information."
+
+ (if (and (boundp 'org-stored-links)
+ (fboundp 'org-capture)
+ (org-protocol-do-capture info 'org-remember))
+ (message "Item remembered."))
+ nil)
+
+(defun org-protocol-capture (info)
+ "Process an org-protocol://capture:// style url.
+
+The sub-protocol used to reach this function is set in
+`org-protocol-protocol-alist'.
+
+This function detects an URL, title and optional text, separated by '/'
+The location for a browser's bookmark has to look like this:
+
+ javascript:location.href='org-protocol://capture://'+ \\
+ encodeURIComponent(location.href)+'/' \\
+ encodeURIComponent(document.title)+'/'+ \\
+ encodeURIComponent(window.getSelection())
+
+By default, it uses the character `org-protocol-default-template-key',
+which should be associated with a template in `org-capture-templates'.
+But you may prepend the encoded URL with a character and a slash like so:
+
+ javascript:location.href='org-protocol://capture://b/'+ ...
+
+Now template ?b will be used."
+ (if (and (boundp 'org-stored-links)
+ (fboundp 'org-capture)
+ (org-protocol-do-capture info 'org-capture))
+ (message "Item captured."))
+ nil)
+
+(defun org-protocol-do-capture (info capture-func)
+ "Support `org-capture' and `org-remember' alike.
+CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
+ (let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
+ (template (or (and (>= 2 (length (car parts))) (pop parts))
+ org-protocol-default-template-key))
+ (url (org-protocol-sanitize-uri (car parts)))
+ (type (if (string-match "^\\([a-z]+\\):" url)
+ (match-string 1 url)))
+ (title (or (cadr parts) ""))
+ (region (or (caddr parts) ""))
+ (orglink (org-make-link-string
+ url (if (string-match "[^[:space:]]" title) title url)))
+ (org-capture-link-is-already-stored t) ;; avoid call to org-store-link
+ remember-annotation-functions)
+ (setq org-stored-links
+ (cons (list url title) org-stored-links))
+ (kill-new orglink)
+ (org-store-link-props :type type
+ :link url
+ :description title
+ :annotation orglink
+ :initial region)
+ (raise-frame)
+ (funcall capture-func nil template)))
+
+(defun org-protocol-open-source (fname)
+ "Process an org-protocol://open-source:// style url.
+
+Change a filename by mapping URLs to local filenames as set
+in `org-protocol-project-alist'.
+
+The location for a browser's bookmark should look like this:
+
+ javascript:location.href='org-protocol://open-source://'+ \\
+ encodeURIComponent(location.href)"
+ ;; As we enter this function for a match on our protocol, the return value
+ ;; defaults to nil.
+ (let ((result nil)
+ (f (org-link-unescape fname)))
+ (catch 'result
+ (dolist (prolist org-protocol-project-alist)
+ (let* ((base-url (plist-get (cdr prolist) :base-url))
+ (wsearch (regexp-quote base-url)))
+
+ (when (string-match wsearch f)
+ (let* ((wdir (plist-get (cdr prolist) :working-directory))
+ (strip-suffix (plist-get (cdr prolist) :online-suffix))
+ (add-suffix (plist-get (cdr prolist) :working-suffix))
+ ;; Strip "[?#].*$" if `f' is a redirect with another
+ ;; ending than strip-suffix here:
+ (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
+ (start-pos (+ (string-match wsearch f1) (length base-url)))
+ (end-pos (string-match
+ (regexp-quote strip-suffix) f1))
+ ;; We have to compare redirects without suffix below:
+ (f2 (concat wdir (substring f1 start-pos end-pos)))
+ (the-file (concat f2 add-suffix)))
+
+ ;; Note: the-file may still contain `%C3' et al here because browsers
+ ;; tend to encode `&auml;' in URLs to `%25C3' - `%25' being `%'.
+ ;; So the results may vary.
+
+ ;; -- start redirects --
+ (unless (file-exists-p the-file)
+ (message "File %s does not exist.\nTesting for rewritten URLs." the-file)
+ (let ((rewrites (plist-get (cdr prolist) :rewrites)))
+ (when rewrites
+ (message "Rewrites found: %S" rewrites)
+ (mapc
+ (lambda (rewrite)
+ "Try to match a rewritten URL and map it to a real file."
+ ;; Compare redirects without suffix:
+ (if (string-match (car rewrite) f2)
+ (throw 'result (concat wdir (cdr rewrite)))))
+ rewrites))))
+ ;; -- end of redirects --
+
+ (if (file-readable-p the-file)
+ (throw 'result the-file))
+ (if (file-exists-p the-file)
+ (message "%s: permission denied!" the-file)
+ (message "%s: no such file or directory." the-file))))))
+ result)))
+
+
+;;; Core functions:
+
+(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
+ "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
+Sub-protocols are registered in `org-protocol-protocol-alist' and
+`org-protocol-protocol-alist-default'.
+This is, how the matching is done:
+
+ (string-match \"protocol:/+sub-protocol:/+\" ...)
+
+protocol and sub-protocol are regexp-quoted.
+
+If a matching protocol is found, the protocol is stripped from fname and the
+result is passed to the protocols function as the only parameter. If the
+function returns nil, the filename is removed from the list of filenames
+passed from emacsclient to the server.
+If the function returns a non nil value, that value is passed to the server
+as filename."
+ (let ((sub-protocols (append org-protocol-protocol-alist
+ org-protocol-protocol-alist-default)))
+ (catch 'fname
+ (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
+ (when (string-match the-protocol fname)
+ (dolist (prolist sub-protocols)
+ (let ((proto (concat the-protocol
+ (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
+ (when (string-match proto fname)
+ (let* ((func (plist-get (cdr prolist) :function))
+ (greedy (plist-get (cdr prolist) :greedy))
+ (split (split-string fname proto))
+ (result (if greedy restoffiles (cadr split))))
+ (when (plist-get (cdr prolist) :kill-client)
+ (message "Greedy org-protocol handler. Killing client.")
+ (server-edit))
+ (when (fboundp func)
+ (unless greedy
+ (throw 'fname (funcall func result)))
+ (funcall func result)
+ (throw 'fname t))))))))
+ ;; (message "fname: %s" fname)
+ fname)))
+
+(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
+ "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
+ (let ((flist (if org-protocol-reverse-list-of-files
+ (reverse (ad-get-arg 0))
+ (ad-get-arg 0)))
+ (client (ad-get-arg 1)))
+ (catch 'greedy
+ (dolist (var flist)
+ ;; `\' to `/' on windows. FIXME: could this be done any better?
+ (let ((fname (expand-file-name (car var))))
+ (setq fname (org-protocol-check-filename-for-protocol
+ fname (member var flist) client))
+ (if (eq fname t) ;; greedy? We need the `t' return value.
+ (progn
+ (ad-set-arg 0 nil)
+ (throw 'greedy t))
+ (if (stringp fname) ;; probably filename
+ (setcar var fname)
+ (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
+
+;;; Org specific functions:
+
+(defun org-protocol-create-for-org ()
+ "Create a org-protocol project for the current file's Org-mode project.
+This works, if the file visited is part of a publishing project in
+`org-publish-project-alist'. This function calls `org-protocol-create' to do
+most of the work."
+ (interactive)
+ (require 'org-publish)
+ (let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
+ (if all (org-protocol-create (cdr all))
+ (message "Not in an org-project. Did mean %s?"
+ (substitute-command-keys"\\[org-protocol-create]")))))
+
+(defun org-protocol-create (&optional project-plist)
+ "Create a new org-protocol project interactively.
+An org-protocol project is an entry in `org-protocol-project-alist'
+which is used by `org-protocol-open-source'.
+Optionally use project-plist to initialize the defaults for this project. If
+project-plist is the CDR of an element in `org-publish-project-alist', reuse
+:base-directory, :html-extension and :base-extension."
+ (interactive)
+ (let ((working-dir (expand-file-name
+ (or (plist-get project-plist :base-directory)
+ default-directory)))
+ (base-url "http://orgmode.org/worg/")
+ (strip-suffix (or (plist-get project-plist :html-extension) ".html"))
+ (working-suffix (if (plist-get project-plist :base-extension)
+ (concat "." (plist-get project-plist :base-extension))
+ ".org"))
+ (worglet-buffer nil)
+ (insert-default-directory t)
+ (minibuffer-allow-text-properties nil))
+
+ (setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
+ (if (not (string-match "\\/$" base-url))
+ (setq base-url (concat base-url "/")))
+
+ (setq working-dir
+ (expand-file-name
+ (read-directory-name "Local working directory: " working-dir working-dir t)))
+ (if (not (string-match "\\/$" working-dir))
+ (setq working-dir (concat working-dir "/")))
+
+ (setq strip-suffix
+ (read-string
+ (concat "Extension to strip from published URLs (" strip-suffix "): ")
+ strip-suffix nil strip-suffix t))
+
+ (setq working-suffix
+ (read-string
+ (concat "Extension of editable files (" working-suffix "): ")
+ working-suffix nil working-suffix t))
+
+ (when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
+ (setq org-protocol-project-alist
+ (cons `(,base-url . (:base-url ,base-url
+ :working-directory ,working-dir
+ :online-suffix ,strip-suffix
+ :working-suffix ,working-suffix))
+ org-protocol-project-alist))
+ (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))
+
+(provide 'org-protocol)
+
+;;; org-protocol.el ends here
diff --git a/lisp/org-publish.el b/lisp/org-publish.el
new file mode 100644
index 0000000..947d52b
--- /dev/null
+++ b/lisp/org-publish.el
@@ -0,0 +1,1195 @@
+;;; org-publish.el --- publish related org-mode files as a website
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+
+;; Author: David O'Toole <dto@gnu.org>
+;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
+;; Keywords: hypermedia, outlines, wp
+
+;; 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 program allow configurable publishing of related sets of
+;; Org-mode files as a complete website.
+;;
+;; org-publish.el can do the following:
+;;
+;; + Publish all one's org-files to HTML or PDF
+;; + Upload HTML, images, attachments and other files to a web server
+;; + Exclude selected private pages from publishing
+;; + Publish a clickable sitemap of pages
+;; + Manage local timestamps for publishing only changed files
+;; + Accept plugin functions to extend range of publishable content
+;;
+;; Documentation for publishing is in the manual.
+
+;;; Code:
+
+
+(eval-when-compile
+ (require 'cl))
+(require 'org)
+(require 'org-exp)
+(require 'format-spec)
+
+(eval-and-compile
+ (unless (fboundp 'declare-function)
+ (defmacro declare-function (fn file &optional arglist fileonly))))
+
+(defvar org-publish-initial-buffer nil
+ "The buffer `org-publish' has been called from.")
+
+(defvar org-publish-temp-files nil
+ "Temporary list of files to be published.")
+
+;; Here, so you find the variable right before it's used the first time:
+(defvar org-publish-cache nil
+ "This will cache timestamps and titles for files in publishing projects.
+Blocks could hash sha1 values here.")
+
+(defgroup org-publish nil
+ "Options for publishing a set of Org-mode and related files."
+ :tag "Org Publishing"
+ :group 'org)
+
+(defcustom org-publish-project-alist nil
+ "Association list to control publishing behavior.
+Each element of the alist is a publishing 'project.' The CAR of
+each element is a string, uniquely identifying the project. The
+CDR of each element is in one of the following forms:
+
+1. A well-formed property list with an even number of elements, alternating
+ keys and values, specifying parameters for the publishing process.
+
+ (:property value :property value ... )
+
+2. A meta-project definition, specifying of a list of sub-projects:
+
+ (:components (\"project-1\" \"project-2\" ...))
+
+When the CDR of an element of org-publish-project-alist is in
+this second form, the elements of the list after :components are
+taken to be components of the project, which group together files
+requiring different publishing options. When you publish such a
+project with \\[org-publish], the components all publish.
+
+When a property is given a value in org-publish-project-alist, its
+setting overrides the value of the corresponding user variable
+\(if any) during publishing. However, options set within a file
+override everything.
+
+Most properties are optional, but some should always be set:
+
+ :base-directory Directory containing publishing source files
+ :base-extension Extension (without the dot!) of source files.
+ This can be a regular expression. If not given,
+ \"org\" will be used as default extension.
+ :publishing-directory Directory (possibly remote) where output
+ files will be published
+
+The :exclude property may be used to prevent certain files from
+being published. Its value may be a string or regexp matching
+file names you don't want to be published.
+
+The :include property may be used to include extra files. Its
+value may be a list of filenames to include. The filenames are
+considered relative to the base directory.
+
+When both :include and :exclude properties are given values, the
+exclusion step happens first.
+
+One special property controls which back-end function to use for
+publishing files in the project. This can be used to extend the
+set of file types publishable by org-publish, as well as the set
+of output formats.
+
+ :publishing-function Function to publish file. The default is
+ `org-publish-org-to-html', but other
+ values are possible. May also be a
+ list of functions, in which case
+ each function in the list is invoked
+ in turn.
+
+Another property allows you to insert code that prepares a
+project for publishing. For example, you could call GNU Make on a
+certain makefile, to ensure published files are built up to date.
+
+ :preparation-function Function to be called before publishing
+ this project. This may also be a list
+ of functions.
+ :completion-function Function to be called after publishing
+ this project. This may also be a list
+ of functions.
+
+Some properties control details of the Org publishing process,
+and are equivalent to the corresponding user variables listed in
+the right column. See the documentation for those variables to
+learn more about their use and default values.
+
+ :language `org-export-default-language'
+ :headline-levels `org-export-headline-levels'
+ :section-numbers `org-export-with-section-numbers'
+ :table-of-contents `org-export-with-toc'
+ :emphasize `org-export-with-emphasize'
+ :sub-superscript `org-export-with-sub-superscripts'
+ :TeX-macros `org-export-with-TeX-macros'
+ :fixed-width `org-export-with-fixed-width'
+ :tables `org-export-with-tables'
+ :table-auto-headline `org-export-highlight-first-table-line'
+ :style `org-export-html-style'
+ :convert-org-links `org-export-html-link-org-files-as-html'
+ :inline-images `org-export-html-inline-images'
+ :expand-quoted-html `org-export-html-expand'
+ :timestamp `org-export-html-with-timestamp'
+ :publishing-directory `org-export-publishing-directory'
+ :html-preamble `org-export-html-preamble'
+ :html-postamble `org-export-html-postamble'
+ :author `user-full-name'
+ :email `user-mail-address'
+
+The following properties may be used to control publishing of a
+sitemap of files or summary page for a given project.
+
+ :auto-sitemap Whether to publish a sitemap during
+ `org-publish-current-project' or `org-publish-all'.
+ :sitemap-filename Filename for output of sitemap. Defaults
+ to 'sitemap.org' (which becomes 'sitemap.html').
+ :sitemap-title Title of sitemap page. Defaults to name of file.
+ :sitemap-function Plugin function to use for generation of sitemap.
+ Defaults to `org-publish-org-sitemap', which
+ generates a plain list of links to all files
+ in the project.
+ :sitemap-style Can be `list' (sitemap is just an itemized list
+ of the titles of the files involved) or
+ `tree' (the directory structure of the source
+ files is reflected in the sitemap). Defaults to
+ `tree'.
+ :sitemap-sans-extension Remove extension from sitemap's
+ filenames. Useful to have cool
+ URIs (see
+ http://www.w3.org/Provider/Style/URI).
+ Defaults to nil.
+
+ If you create a sitemap file, adjust the sorting like this:
+
+ :sitemap-sort-folders Where folders should appear in the sitemap.
+ Set this to `first' (default) or `last' to
+ display folders first or last, respectively.
+ Any other value will mix files and folders.
+ :sitemap-sort-files The site map is normally sorted alphabetically.
+ You can change this behaviour setting this to
+ `chronologically', `anti-chronologically' or nil.
+ :sitemap-ignore-case Should sorting be case-sensitive? Default nil.
+
+The following properties control the creation of a concept index.
+
+ :makeindex Create a concept index.
+
+Other properties affecting publication.
+
+ :body-only Set this to 't' to publish only the body of the
+ documents, excluding everything outside and
+ including the <body> tags in HTML, or
+ \begin{document}..\end{document} in LaTeX."
+ :group 'org-publish
+ :type 'alist)
+
+(defcustom org-publish-use-timestamps-flag t
+ "Non-nil means use timestamp checking to publish only changed files.
+When nil, do no timestamp checking and always publish all files."
+ :group 'org-publish
+ :type 'boolean)
+
+(defcustom org-publish-timestamp-directory (convert-standard-filename
+ "~/.org-timestamps/")
+ "Name of directory in which to store publishing timestamps."
+ :group 'org-publish
+ :type 'directory)
+
+(defcustom org-publish-list-skipped-files t
+ "Non-nil means show message about files *not* published."
+ :group 'org-publish
+ :type 'boolean)
+
+(defcustom org-publish-before-export-hook nil
+ "Hook run before export on the Org file.
+The hook may modify the file in arbitrary ways before publishing happens.
+The original version of the buffer will be restored after publishing."
+ :group 'org-publish
+ :type 'hook)
+
+(defcustom org-publish-after-export-hook nil
+ "Hook run after export on the exported buffer.
+Any changes made by this hook will be saved."
+ :group 'org-publish
+ :type 'hook)
+
+(defcustom org-publish-sitemap-sort-files 'alphabetically
+ "How sitemaps files should be sorted by default?
+Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil.
+If `alphabetically', files will be sorted alphabetically.
+If `chronologically', files will be sorted with older modification time first.
+If `anti-chronologically', files will be sorted with newer modification time first.
+nil won't sort files.
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-sort-files'."
+ :group 'org-publish
+ :version "24.1"
+ :type 'symbol)
+
+(defcustom org-publish-sitemap-sort-folders 'first
+ "A symbol, denoting if folders are sorted first in sitemaps.
+Possible values are `first', `last', and nil.
+If `first', folders will be sorted before files.
+If `last', folders are sorted to the end after the files.
+Any other value will not mix files and folders.
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-sort-folders'."
+ :group 'org-publish
+ :version "24.1"
+ :type 'symbol)
+
+(defcustom org-publish-sitemap-sort-ignore-case nil
+ "Sort sitemaps case insensitively by default?
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-ignore-case'."
+ :group 'org-publish
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
+ "Format for `format-time-string' which is used to print a date
+in the sitemap."
+ :group 'org-publish
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-publish-sitemap-file-entry-format "%t"
+ "How a sitemap file entry is formatted.
+You could use brackets to delimit on what part the link will be.
+
+%t is the title.
+%a is the author.
+%d is the date formatted using `org-publish-sitemap-date-format'."
+ :group 'org-publish
+ :version "24.1"
+ :type 'string)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Sanitize-plist (FIXME why?)
+
+(defun org-publish-sanitize-plist (plist)
+ ;; FIXME document
+ (mapcar (lambda (x)
+ (or (cdr (assq x '((:index-filename . :sitemap-filename)
+ (:index-title . :sitemap-title)
+ (:index-function . :sitemap-function)
+ (:index-style . :sitemap-style)
+ (:auto-index . :auto-sitemap))))
+ x))
+ plist))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Timestamp-related functions
+
+(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
+ "Return path to timestamp file for filename FILENAME."
+ (setq filename (concat filename "::" (or pub-dir "") "::"
+ (format "%s" (or pub-func ""))))
+ (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+
+(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
+ "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
+TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
+this - maybe it can eventually be used to check if the file is present at
+the target location, and how old it is. Right now we cannot do this, because
+we do not know under what file name the file will be stored - the publishing
+function can still decide about that independently."
+ (let ((rtn
+ (if org-publish-use-timestamps-flag
+ (org-publish-cache-file-needs-publishing
+ filename pub-dir pub-func base-dir)
+ ;; don't use timestamps, always return t
+ t)))
+ (if rtn
+ (message "Publishing file %s using `%s'" filename pub-func)
+ (when org-publish-list-skipped-files
+ (message "Skipping unmodified file %s" filename)))
+ rtn))
+
+(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir)
+ "Update publishing timestamp for file FILENAME.
+If there is no timestamp, create one."
+ (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (stamp (org-publish-cache-ctime-of-src filename)))
+ (org-publish-cache-set key stamp)))
+
+(defun org-publish-remove-all-timestamps ()
+ "Remove all files in the timestamp directory."
+ (let ((dir org-publish-timestamp-directory)
+ files)
+ (when (and (file-exists-p dir)
+ (file-directory-p dir))
+ (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (org-publish-reset-cache))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Compatibility aliases
+
+;; Delete-dups is not in Emacs <22
+(if (fboundp 'delete-dups)
+ (defalias 'org-publish-delete-dups 'delete-dups)
+ (defun org-publish-delete-dups (list)
+ "Destructively remove `equal' duplicates from LIST.
+Store the result in LIST and return it. LIST must be a proper list.
+Of several `equal' occurrences of an element in LIST, the first
+one is kept.
+
+This is a compatibility function for Emacsen without `delete-dups'."
+ ;; Code from `subr.el' in Emacs 22:
+ (let ((tail list))
+ (while tail
+ (setcdr tail (delete (car tail) (cdr tail)))
+ (setq tail (cdr tail))))
+ list))
+
+(declare-function org-publish-delete-dups "org-publish" (list))
+(declare-function find-lisp-find-files "find-lisp" (directory regexp))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Getting project information out of org-publish-project-alist
+
+(defun org-publish-expand-projects (projects-alist)
+ "Expand projects in PROJECTS-ALIST.
+This splices all the components into the list."
+ (let ((rest projects-alist) rtn p components)
+ (while (setq p (pop rest))
+ (if (setq components (plist-get (cdr p) :components))
+ (setq rest (append
+ (mapcar (lambda (x) (assoc x org-publish-project-alist))
+ components)
+ rest))
+ (push p rtn)))
+ (nreverse (org-publish-delete-dups (delq nil rtn)))))
+
+(defvar org-sitemap-sort-files)
+(defvar org-sitemap-sort-folders)
+(defvar org-sitemap-ignore-case)
+(defvar org-sitemap-requested)
+(defvar org-sitemap-date-format)
+(defvar org-sitemap-file-entry-format)
+(defun org-publish-compare-directory-files (a b)
+ "Predicate for `sort', that sorts folders and files for sitemap."
+ (let ((retval t))
+ (when (or org-sitemap-sort-files org-sitemap-sort-folders)
+ ;; First we sort files:
+ (when org-sitemap-sort-files
+ (cond ((equal org-sitemap-sort-files 'alphabetically)
+ (let* ((adir (file-directory-p a))
+ (aorg (and (string-match "\\.org$" a) (not adir)))
+ (bdir (file-directory-p b))
+ (borg (and (string-match "\\.org$" b) (not bdir)))
+ (A (if aorg
+ (concat (file-name-directory a)
+ (org-publish-find-title a)) a))
+ (B (if borg
+ (concat (file-name-directory b)
+ (org-publish-find-title b)) b)))
+ (setq retval (if org-sitemap-ignore-case
+ (not (string-lessp (upcase B) (upcase A)))
+ (not (string-lessp B A))))))
+ ((or (equal org-sitemap-sort-files 'chronologically)
+ (equal org-sitemap-sort-files 'anti-chronologically))
+ (let* ((adate (org-publish-find-date a))
+ (bdate (org-publish-find-date b))
+ (A (+ (lsh (car adate) 16) (cadr adate)))
+ (B (+ (lsh (car bdate) 16) (cadr bdate))))
+ (setq retval (if (equal org-sitemap-sort-files 'chronologically)
+ (<= A B)
+ (>= A B)))))))
+ ;; Directory-wise wins:
+ (when org-sitemap-sort-folders
+ ;; a is directory, b not:
+ (cond
+ ((and (file-directory-p a) (not (file-directory-p b)))
+ (setq retval (equal org-sitemap-sort-folders 'first)))
+ ;; a is not a directory, but b is:
+ ((and (not (file-directory-p a)) (file-directory-p b))
+ (setq retval (equal org-sitemap-sort-folders 'last))))))
+ retval))
+
+(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
+ "Set `org-publish-temp-files' with files from BASE-DIR directory.
+If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
+non-nil, restrict this list to the files matching the regexp
+MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
+SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
+matching the regexp SKIP-DIR when recursing through BASE-DIR."
+ (mapc (lambda (f)
+ (let ((fd-p (file-directory-p f))
+ (fnd (file-name-nondirectory f)))
+ (if (and fd-p recurse
+ (not (string-match "^\\.+$" fnd))
+ (if skip-dir (not (string-match skip-dir fnd)) t))
+ (org-publish-get-base-files-1 f recurse match skip-file skip-dir)
+ (unless (or fd-p ;; this is a directory
+ (and skip-file (string-match skip-file fnd))
+ (not (file-exists-p (file-truename f)))
+ (not (string-match match fnd)))
+
+ (pushnew f org-publish-temp-files)))))
+ (if org-sitemap-requested
+ (sort (directory-files base-dir t (unless recurse match))
+ 'org-publish-compare-directory-files)
+ (directory-files base-dir t (unless recurse match)))))
+
+(defun org-publish-get-base-files (project &optional exclude-regexp)
+ "Return a list of all files in PROJECT.
+If EXCLUDE-REGEXP is set, this will be used to filter out
+matching filenames."
+ (let* ((project-plist (cdr project))
+ (base-dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (include-list (plist-get project-plist :include))
+ (recurse (plist-get project-plist :recursive))
+ (extension (or (plist-get project-plist :base-extension) "org"))
+ ;; sitemap-... variables are dynamically scoped for
+ ;; org-publish-compare-directory-files:
+ (org-sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-filename
+ (or (plist-get project-plist :sitemap-filename)
+ "sitemap.org"))
+ (org-sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-publish-sitemap-sort-folders))
+ (org-sitemap-sort-files
+ (cond ((plist-member project-plist :sitemap-sort-files)
+ (plist-get project-plist :sitemap-sort-files))
+ ;; For backward compatibility:
+ ((plist-member project-plist :sitemap-alphabetically)
+ (if (plist-get project-plist :sitemap-alphabetically)
+ 'alphabetically nil))
+ (t org-publish-sitemap-sort-files)))
+ (org-sitemap-ignore-case
+ (if (plist-member project-plist :sitemap-ignore-case)
+ (plist-get project-plist :sitemap-ignore-case)
+ org-publish-sitemap-sort-ignore-case))
+ (match (if (eq extension 'any)
+ "^[^\\.]"
+ (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
+ ;; Make sure `org-sitemap-sort-folders' has an accepted value
+ (unless (memq org-sitemap-sort-folders '(first last))
+ (setq org-sitemap-sort-folders nil))
+
+ (setq org-publish-temp-files nil)
+ (if org-sitemap-requested
+ (pushnew (expand-file-name (concat base-dir sitemap-filename))
+ org-publish-temp-files))
+ (org-publish-get-base-files-1 base-dir recurse match
+ ;; FIXME distinguish exclude regexp
+ ;; for skip-file and skip-dir?
+ exclude-regexp exclude-regexp)
+ (mapc (lambda (f)
+ (pushnew
+ (expand-file-name (concat base-dir f))
+ org-publish-temp-files))
+ include-list)
+ org-publish-temp-files))
+
+(defun org-publish-get-project-from-filename (filename &optional up)
+ "Return the project that FILENAME belongs to."
+ (let* ((filename (expand-file-name filename))
+ project-name)
+
+ (catch 'p-found
+ (dolist (prj org-publish-project-alist)
+ (unless (plist-get (cdr prj) :components)
+ ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+ (let* ((r (plist-get (cdr prj) :recursive))
+ (b (expand-file-name (file-name-as-directory
+ (plist-get (cdr prj) :base-directory))))
+ (x (or (plist-get (cdr prj) :base-extension) "org"))
+ (e (plist-get (cdr prj) :exclude))
+ (i (plist-get (cdr prj) :include))
+ (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+ (when
+ (or
+ (and
+ i (member filename
+ (mapcar
+ (lambda (file) (expand-file-name file b))
+ i)))
+ (and
+ (not (and e (string-match e filename)))
+ (string-match xm filename)))
+ (setq project-name (car prj))
+ (throw 'p-found project-name))))))
+ (when up
+ (dolist (prj org-publish-project-alist)
+ (if (member project-name (plist-get (cdr prj) :components))
+ (setq project-name (car prj)))))
+ (assoc project-name org-publish-project-alist)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Pluggable publishing back-end functions
+
+(defun org-publish-org-to (format plist filename pub-dir)
+ "Publish an org file to FORMAT.
+PLIST is the property list for the given project.
+FILENAME is the filename of the org file to be published.
+PUB-DIR is the publishing directory."
+ (require 'org)
+ (unless (file-exists-p pub-dir)
+ (make-directory pub-dir t))
+ (let ((visiting (find-buffer-visiting filename)))
+ (save-excursion
+ (org-pop-to-buffer-same-window (or visiting (find-file filename)))
+ (let* ((plist (cons :buffer-will-be-killed (cons t plist)))
+ (init-buf (current-buffer))
+ (init-point (point))
+ (init-buf-string (buffer-string))
+ export-buf-or-file)
+ ;; run hooks before exporting
+ (run-hooks 'org-publish-before-export-hook)
+ ;; export the possibly modified buffer
+ (setq export-buf-or-file
+ (funcall (intern (concat "org-export-as-" format))
+ (plist-get plist :headline-levels)
+ nil plist nil
+ (plist-get plist :body-only)
+ pub-dir))
+ (when (and (bufferp export-buf-or-file)
+ (buffer-live-p export-buf-or-file))
+ (set-buffer export-buf-or-file)
+ ;; run hooks after export and save export
+ (progn (run-hooks 'org-publish-after-export-hook)
+ (if (buffer-modified-p) (save-buffer)))
+ (kill-buffer export-buf-or-file))
+ ;; maybe restore buffer's content
+ (set-buffer init-buf)
+ (when (buffer-modified-p init-buf)
+ (erase-buffer)
+ (insert init-buf-string)
+ (save-buffer)
+ (goto-char init-point))
+ (unless visiting
+ (kill-buffer init-buf))))))
+
+(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
+ "Execute BODY with a modified hook to preprocess for index."
+ `(let ((org-export-preprocess-after-headline-targets-hook
+ (if (plist-get project-plist :makeindex)
+ (cons 'org-publish-aux-preprocess
+ org-export-preprocess-after-headline-targets-hook)
+ org-export-preprocess-after-headline-targets-hook)))
+ ,@body))
+(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
+
+(defvar project-plist)
+(defun org-publish-org-to-latex (plist filename pub-dir)
+ "Publish an org file to LaTeX.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "latex" plist filename pub-dir)))
+
+(defun org-publish-org-to-pdf (plist filename pub-dir)
+ "Publish an org file to PDF (via LaTeX).
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "pdf" plist filename pub-dir)))
+
+(defun org-publish-org-to-html (plist filename pub-dir)
+ "Publish an org file to HTML.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "html" plist filename pub-dir)))
+
+(defun org-publish-org-to-org (plist filename pub-dir)
+ "Publish an org file to HTML.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-org-to "org" plist filename pub-dir))
+
+(defun org-publish-org-to-ascii (plist filename pub-dir)
+ "Publish an org file to ASCII.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "ascii" plist filename pub-dir)))
+
+(defun org-publish-org-to-latin1 (plist filename pub-dir)
+ "Publish an org file to Latin-1.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "latin1" plist filename pub-dir)))
+
+(defun org-publish-org-to-utf8 (plist filename pub-dir)
+ "Publish an org file to UTF-8.
+See `org-publish-org-to' to the list of arguments."
+ (org-publish-with-aux-preprocess-maybe
+ (org-publish-org-to "utf8" plist filename pub-dir)))
+
+(defun org-publish-attachment (plist filename pub-dir)
+ "Publish a file with no transformation of any kind.
+See `org-publish-org-to' to the list of arguments."
+ ;; make sure eshell/cp code is loaded
+ (unless (file-directory-p pub-dir)
+ (make-directory pub-dir t))
+ (or (equal (expand-file-name (file-name-directory filename))
+ (file-name-as-directory (expand-file-name pub-dir)))
+ (copy-file filename
+ (expand-file-name (file-name-nondirectory filename) pub-dir)
+ t)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Publishing files, sets of files, and indices
+
+(defun org-publish-file (filename &optional project no-cache)
+ "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-publish-projects'."
+ (let* ((project
+ (or project
+ (or (org-publish-get-project-from-filename filename)
+ (error "File %s not part of any known project"
+ (abbreviate-file-name filename)))))
+ (project-plist (cdr project))
+ (ftname (expand-file-name filename))
+ (publishing-function
+ (or (plist-get project-plist :publishing-function)
+ 'org-publish-org-to-html))
+ (base-dir
+ (file-name-as-directory
+ (expand-file-name
+ (or (plist-get project-plist :base-directory)
+ (error "Project %s does not have :base-directory defined"
+ (car project))))))
+ (pub-dir
+ (file-name-as-directory
+ (file-truename
+ (or (eval (plist-get project-plist :publishing-directory))
+ (error "Project %s does not have :publishing-directory defined"
+ (car project))))))
+ tmp-pub-dir)
+
+ (unless no-cache
+ (org-publish-initialize-cache (car project)))
+
+ (setq tmp-pub-dir
+ (file-name-directory
+ (concat pub-dir
+ (and (string-match (regexp-quote base-dir) ftname)
+ (substring ftname (match-end 0))))))
+ (if (listp publishing-function)
+ ;; allow chain of publishing functions
+ (mapc (lambda (f)
+ (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
+ (funcall f project-plist filename tmp-pub-dir)
+ (org-publish-update-timestamp filename pub-dir f base-dir)))
+ publishing-function)
+ (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir)
+ (funcall publishing-function project-plist filename tmp-pub-dir)
+ (org-publish-update-timestamp
+ filename pub-dir publishing-function base-dir)))
+ (unless no-cache (org-publish-write-cache-file))))
+
+(defun org-publish-projects (projects)
+ "Publish all files belonging to the PROJECTS alist.
+If :auto-sitemap is set, publish the sitemap too.
+If :makeindex is set, also produce a file theindex.org."
+ (mapc
+ (lambda (project)
+ ;; Each project uses its own cache file:
+ (org-publish-initialize-cache (car project))
+ (let*
+ ((project-plist (cdr project))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (sitemap-p (plist-get project-plist :auto-sitemap))
+ (sitemap-filename (or (plist-get project-plist :sitemap-filename)
+ "sitemap.org"))
+ (sitemap-function (or (plist-get project-plist :sitemap-function)
+ 'org-publish-org-sitemap))
+ (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
+ org-publish-sitemap-date-format))
+ (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
+ org-publish-sitemap-file-entry-format))
+ (preparation-function (plist-get project-plist :preparation-function))
+ (completion-function (plist-get project-plist :completion-function))
+ (files (org-publish-get-base-files project exclude-regexp)) file)
+ (when preparation-function (run-hooks 'preparation-function))
+ (if sitemap-p (funcall sitemap-function project sitemap-filename))
+ (while (setq file (pop files))
+ (org-publish-file file project t))
+ (when (plist-get project-plist :makeindex)
+ (org-publish-index-generate-theindex
+ (plist-get project-plist :base-directory))
+ (org-publish-file (expand-file-name
+ "theindex.org"
+ (plist-get project-plist :base-directory))
+ project t))
+ (when completion-function (run-hooks 'completion-function))
+ (org-publish-write-cache-file)))
+ (org-publish-expand-projects projects)))
+
+(defun org-publish-org-sitemap (project &optional sitemap-filename)
+ "Create a sitemap of pages in set defined by PROJECT.
+Optionally set the filename of the sitemap with SITEMAP-FILENAME.
+Default for SITEMAP-FILENAME is 'sitemap.org'."
+ (let* ((project-plist (cdr project))
+ (dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (localdir (file-name-directory dir))
+ (indent-str (make-string 2 ?\ ))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (files (nreverse (org-publish-get-base-files project exclude-regexp)))
+ (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
+ (sitemap-title (or (plist-get project-plist :sitemap-title)
+ (concat "Sitemap for project " (car project))))
+ (sitemap-style (or (plist-get project-plist :sitemap-style)
+ 'tree))
+ (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
+ (visiting (find-buffer-visiting sitemap-filename))
+ (ifn (file-name-nondirectory sitemap-filename))
+ file sitemap-buffer)
+ (with-current-buffer (setq sitemap-buffer
+ (or visiting (find-file sitemap-filename)))
+ (erase-buffer)
+ (insert (concat "#+TITLE: " sitemap-title "\n\n"))
+ (while (setq file (pop files))
+ (let ((fn (file-name-nondirectory file))
+ (link (file-relative-name file dir))
+ (oldlocal localdir))
+ (when sitemap-sans-extension
+ (setq link (file-name-sans-extension link)))
+ ;; sitemap shouldn't list itself
+ (unless (equal (file-truename sitemap-filename)
+ (file-truename file))
+ (if (eq sitemap-style 'list)
+ (message "Generating list-style sitemap for %s" sitemap-title)
+ (message "Generating tree-style sitemap for %s" sitemap-title)
+ (setq localdir (concat (file-name-as-directory dir)
+ (file-name-directory link)))
+ (unless (string= localdir oldlocal)
+ (if (string= localdir dir)
+ (setq indent-str (make-string 2 ?\ ))
+ (let ((subdirs
+ (split-string
+ (directory-file-name
+ (file-name-directory
+ (file-relative-name localdir dir))) "/"))
+ (subdir "")
+ (old-subdirs (split-string
+ (file-relative-name oldlocal dir) "/")))
+ (setq indent-str (make-string 2 ?\ ))
+ (while (string= (car old-subdirs) (car subdirs))
+ (setq indent-str (concat indent-str (make-string 2 ?\ )))
+ (pop old-subdirs)
+ (pop subdirs))
+ (dolist (d subdirs)
+ (setq subdir (concat subdir d "/"))
+ (insert (concat indent-str " + " d "\n"))
+ (setq indent-str (make-string
+ (+ (length indent-str) 2) ?\ )))))))
+ ;; This is common to 'flat and 'tree
+ (let ((entry
+ (org-publish-format-file-entry org-sitemap-file-entry-format
+ file project-plist))
+ (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
+ (cond ((string-match-p regexp entry)
+ (string-match regexp entry)
+ (insert (concat indent-str " + " (match-string 1 entry)
+ "[[file:" link "]["
+ (match-string 2 entry)
+ "]]" (match-string 3 entry) "\n")))
+ (t
+ (insert (concat indent-str " + [[file:" link "]["
+ entry
+ "]]\n"))))))))
+ (save-buffer))
+ (or visiting (kill-buffer sitemap-buffer))))
+
+(defun org-publish-format-file-entry (fmt file project-plist)
+ (format-spec fmt
+ `((?t . ,(org-publish-find-title file t))
+ (?d . ,(format-time-string org-sitemap-date-format
+ (org-publish-find-date file)))
+ (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+
+(defun org-publish-find-title (file &optional reset)
+ "Find the title of FILE in project."
+ (or
+ (and (not reset) (org-publish-cache-get-file-property file :title nil t))
+ (let* ((visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file)))
+ title)
+ (with-current-buffer buffer
+ (let* ((opt-plist (org-combine-plists (org-default-export-plist)
+ (org-infile-export-plist))))
+ (setq title
+ (or (plist-get opt-plist :title)
+ (and (not
+ (plist-get opt-plist :skip-before-1st-heading))
+ (org-export-grab-title-from-buffer))
+ (file-name-nondirectory (file-name-sans-extension file))))))
+ (unless visiting
+ (kill-buffer buffer))
+ (org-publish-cache-set-file-property file :title title)
+ title)))
+
+(defun org-publish-find-date (file)
+ "Find the date of FILE in project.
+If FILE provides a #+date keyword use it else use the file
+system's modification time.
+
+It returns time in `current-time' format."
+ (let ((visiting (find-buffer-visiting file)))
+ (save-excursion
+ (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
+ (let* ((plist (org-infile-export-plist))
+ (date (plist-get plist :date)))
+ (unless visiting
+ (kill-buffer (current-buffer)))
+ (if date
+ (org-time-string-to-time date)
+ (when (file-exists-p file)
+ (nth 5 (file-attributes file))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive publishing functions
+
+;;;###autoload
+(defalias 'org-publish-project 'org-publish)
+
+;;;###autoload
+(defun org-publish (project &optional force)
+ "Publish PROJECT."
+ (interactive
+ (list
+ (assoc (org-icompleting-read
+ "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ current-prefix-arg))
+ (setq org-publish-initial-buffer (current-buffer))
+ (save-window-excursion
+ (let* ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-projects
+ (if (stringp project)
+ ;; If this function is called in batch mode,
+ ;; project is still a string here.
+ (list (assoc project org-publish-project-alist))
+ (list project))))))
+
+;;;###autoload
+(defun org-publish-all (&optional force)
+ "Publish all projects.
+With prefix argument, remove all files in the timestamp
+directory and force publishing all files."
+ (interactive "P")
+ (when force
+ (org-publish-remove-all-timestamps))
+ (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-projects org-publish-project-alist))))
+
+
+;;;###autoload
+(defun org-publish-current-file (&optional force)
+ "Publish the current file.
+With prefix argument, force publish the file."
+ (interactive "P")
+ (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-file (buffer-file-name)))))
+
+;;;###autoload
+(defun org-publish-current-project (&optional force)
+ "Publish the project associated with the current file.
+With a prefix argument, force publishing of all files in
+the project."
+ (interactive "P")
+ (save-window-excursion
+ (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
+ (org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (if (not project)
+ (error "File %s is not part of any known project" (buffer-file-name)))
+ ;; FIXME: force is not used here?
+ (org-publish project))))
+
+
+;;; Index generation
+
+(defun org-publish-aux-preprocess ()
+ "Find index entries and write them to an .orgx file."
+ (let ((case-fold-search t)
+ entry index target)
+ (goto-char (point-min))
+ (while
+ (and
+ (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
+ (> (match-end 1) (match-beginning 1)))
+ (setq entry (match-string 1))
+ (when (eq org-export-current-backend 'latex)
+ (replace-match (format "\\index{%s}" entry) t t))
+ (save-excursion
+ (ignore-errors (org-back-to-heading t))
+ (setq target (get-text-property (point) 'target))
+ (setq target (or (cdr (assoc target org-export-preferred-target-alist))
+ (cdr (assoc target org-export-id-target-alist))
+ target ""))
+ (push (cons entry target) index)))
+ (with-temp-file
+ (concat
+ (file-name-directory org-current-export-file) "."
+ (file-name-sans-extension
+ (file-name-nondirectory org-current-export-file)) ".orgx")
+ (dolist (entry (nreverse index))
+ (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
+
+(defun org-publish-index-generate-theindex (directory)
+ "Generate the index from all .orgx files in DIRECTORY."
+ (require 'find-lisp)
+ (let* ((fulldir (file-name-as-directory
+ (expand-file-name directory)))
+ (full-files (find-lisp-find-files directory "\\.orgx\\'"))
+ (re (concat "\\`" fulldir))
+ (files (mapcar (lambda (f) (if (string-match re f)
+ (substring f (match-end 0))
+ f))
+ full-files))
+ (default-directory directory)
+ index origfile buf target entry ibuffer
+ main last-main letter last-letter file sub link tgext)
+ ;; `files' contains the list of relative file names
+ (dolist (file files)
+ (setq origfile
+ (concat (file-name-directory file)
+ (substring (file-name-nondirectory file) 1 -1)))
+ (setq buf (find-file-noselect file))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t)
+ (setq target (match-string 1)
+ entry (match-string 2))
+ (push (list entry origfile target) index)))
+ (kill-buffer buf))
+ (setq index (sort index (lambda (a b) (string< (downcase (car a))
+ (downcase (car b))))))
+ (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
+ (with-current-buffer ibuffer
+ (erase-buffer)
+ (insert "* Index\n")
+ (setq last-letter nil)
+ (dolist (idx index)
+ (setq entry (car idx) file (nth 1 idx) target (nth 2 idx))
+ (if (and (stringp target) (string-match "\\S-" target))
+ (setq tgext (concat "::#" target))
+ (setq tgext ""))
+ (setq letter (upcase (substring entry 0 1)))
+ (when (not (equal letter last-letter))
+ (insert "** " letter "\n")
+ (setq last-letter letter))
+ (if (string-match "!" entry)
+ (setq main (substring entry 0 (match-beginning 0))
+ sub (substring entry (match-end 0)))
+ (setq main nil sub nil last-main nil))
+ (when (and main (not (equal main last-main)))
+ (insert " - " main "\n")
+ (setq last-main main))
+ (setq link (concat "[[file:" file tgext "]"
+ "[" (or sub entry) "]]"))
+ (if (and main sub)
+ (insert " - " link "\n")
+ (insert " - " link "\n")))
+ (save-buffer))
+ (kill-buffer ibuffer)
+ ;; Create theindex.org if it doesn't exist already
+ (let ((index-file (expand-file-name "theindex.org" directory)))
+ (unless (file-exists-p index-file)
+ (setq ibuffer (find-file-noselect index-file))
+ (with-current-buffer ibuffer
+ (erase-buffer)
+ (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
+ (save-buffer))
+ (kill-buffer ibuffer)))))
+
+;; Caching functions:
+
+(defun org-publish-write-cache-file (&optional free-cache)
+ "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (or org-publish-cache
+ (error "`org-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-publish-cache-get ":cache-file:")))
+ (or cache-file
+ (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let ((print-level nil)
+ (print-length nil))
+ (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
+ (maphash (lambda (k v)
+ (insert
+ (format (concat "(puthash %S "
+ (if (or (listp v) (symbolp v))
+ "'" "")
+ "%S org-publish-cache)\n") k v)))
+ org-publish-cache)))
+ (when free-cache (org-publish-reset-cache))))
+
+(defun org-publish-initialize-cache (project-name)
+ "Initialize the projects cache if not initialized yet and return it."
+
+ (or project-name
+ (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
+
+ (unless (file-exists-p org-publish-timestamp-directory)
+ (make-directory org-publish-timestamp-directory t))
+ (if (not (file-directory-p org-publish-timestamp-directory))
+ (error "Org publish timestamp: %s is not a directory"
+ org-publish-timestamp-directory))
+
+ (unless (and org-publish-cache
+ (string= (org-publish-cache-get ":project:") project-name))
+ (let* ((cache-file (concat
+ (expand-file-name org-publish-timestamp-directory)
+ project-name
+ ".cache"))
+ (cexists (file-exists-p cache-file)))
+
+ (when org-publish-cache
+ (org-publish-reset-cache))
+
+ (if cexists
+ (load-file cache-file)
+ (setq org-publish-cache
+ (make-hash-table :test 'equal :weakness nil :size 100))
+ (org-publish-cache-set ":project:" project-name)
+ (org-publish-cache-set ":cache-file:" cache-file))
+ (unless cexists (org-publish-write-cache-file nil))))
+ org-publish-cache)
+
+(defun org-publish-reset-cache ()
+ "Empty org-publish-cache and reset it nil."
+ (message "%s" "Resetting org-publish-cache")
+ (if (hash-table-p org-publish-cache)
+ (clrhash org-publish-cache))
+ (setq org-publish-cache nil))
+
+(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir)
+ "Check the timestamp of the last publishing of FILENAME.
+Return `t', if the file needs publishing. The function also
+checks if any included files have been more recently published,
+so that the file including them will be republished as well."
+ (or org-publish-cache
+ (error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-publish-cache-get key))
+ (visiting (find-buffer-visiting filename))
+ (case-fold-search t)
+ included-files-ctime buf)
+
+ (when (equal (file-name-extension filename) "org")
+ (setq buf (find-file (expand-file-name filename)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
+ (let* ((included-file (expand-file-name (match-string 1))))
+ (add-to-list 'included-files-ctime
+ (org-publish-cache-ctime-of-src included-file) t))))
+ ;; FIXME don't kill current buffer
+ (unless visiting (kill-buffer buf)))
+ (if (null pstamp)
+ t
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (or (< pstamp ctime)
+ (when included-files-ctime
+ (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
+ included-files-ctime))))))))))
+
+(defun org-publish-cache-set-file-property (filename property value &optional project-name)
+ "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
+Use cache file of PROJECT-NAME. If the entry does not exist, it will be
+created. Return VALUE."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename)))
+ (if pl
+ (progn
+ (plist-put pl property value)
+ value)
+ (org-publish-cache-get-file-property
+ filename property value nil project-name))))
+
+(defun org-publish-cache-get-file-property
+ (filename property &optional default no-create project-name)
+ "Return the value for a PROPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
+DEFAULT, if the value does not yet exist.
+If the entry will be created, unless NO-CREATE is not nil."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename))
+ (retval nil))
+ (if pl
+ (if (plist-member pl property)
+ (setq retval (plist-get pl property))
+ (setq retval default))
+ ;; no pl yet:
+ (unless no-create
+ (org-publish-cache-set filename (list property default)))
+ (setq retval default))
+ retval))
+
+(defun org-publish-cache-get (key)
+ "Return the value stored in `org-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+ (or org-publish-cache
+ (error "`org-publish-cache-get' called, but no cache present"))
+ (gethash key org-publish-cache))
+
+(defun org-publish-cache-set (key value)
+ "Store KEY VALUE pair in `org-publish-cache'.
+Returns value on success, else nil."
+ (or org-publish-cache
+ (error "`org-publish-cache-set' called, but no cache present"))
+ (puthash key value org-publish-cache))
+
+(defun org-publish-cache-ctime-of-src (file)
+ "Get the ctime of filename F as an integer."
+ (let ((attr (file-attributes
+ (expand-file-name (or (file-symlink-p file) file)
+ (file-name-directory file)))))
+ (+ (lsh (car (nth 5 attr)) 16)
+ (cadr (nth 5 attr)))))
+
+(provide 'org-publish)
+
+;;; org-publish.el ends here
diff --git a/lisp/org-remember.el b/lisp/org-remember.el
new file mode 100644
index 0000000..7a1eb77
--- /dev/null
+++ b/lisp/org-remember.el
@@ -0,0 +1,1152 @@
+;;; org-remember.el --- Fast note taking in Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the system to take fast notes with Org-mode.
+;; This system is used together with John Wiegley's `remember.el'.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org)
+(require 'org-compat)
+(require 'org-datetree)
+
+(declare-function remember-mode "remember" ())
+(declare-function remember "remember" (&optional initial))
+(declare-function remember-buffer-desc "remember" ())
+(declare-function remember-finalize "remember" ())
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+
+(defvar remember-save-after-remembering)
+(defvar remember-register)
+(defvar remember-buffer)
+(defvar remember-handler-functions)
+(defvar remember-annotation-functions)
+(defvar org-clock-heading)
+(defvar org-clock-heading-for-remember)
+
+(defgroup org-remember nil
+ "Options concerning interaction with remember.el."
+ :tag "Org Remember"
+ :group 'org)
+
+(defcustom org-remember-store-without-prompt t
+ "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \
+stores the remember note without further prompts.
+It then uses the file and headline specified by the template or (if the
+template does not specify them) by the variables `org-default-notes-file'
+and `org-remember-default-headline'. To force prompting anyway, use
+\\[universal-argument] \\[org-remember-finalize] to file the note.
+
+When this variable is nil, \\[org-remember-finalize] gives you the prompts, and
+\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack."
+ :group 'org-remember
+ :type 'boolean)
+
+(defcustom org-remember-interactive-interface 'refile
+ "The interface to be used for interactive filing of remember notes.
+This is only used when the interactive mode for selecting a filing
+location is used (see the variable `org-remember-store-without-prompt').
+Allowed values are:
+outline The interface shows an outline of the relevant file
+ and the correct heading is found by moving through
+ the outline or by searching with incremental search.
+outline-path-completion Headlines in the current buffer are offered via
+ completion.
+refile Use the refile interface, and offer headlines,
+ possibly from different buffers."
+ :group 'org-remember
+ :type '(choice
+ (const :tag "Refile" refile)
+ (const :tag "Outline" outline)
+ (const :tag "Outline-path-completion" outline-path-completion)))
+
+(defcustom org-remember-default-headline ""
+ "The headline that should be the default location in the notes file.
+When filing remember notes, the cursor will start at that position.
+You can set this on a per-template basis with the variable
+`org-remember-templates'."
+ :group 'org-remember
+ :type 'string)
+
+(defcustom org-remember-templates nil
+ "Templates for the creation of remember buffers.
+When nil, just let remember make the buffer.
+When non-nil, this is a list of (up to) 6-element lists. In each entry,
+the first element is the name of the template, which should be a single
+short word. The second element is a character, a unique key to select
+this template. The third element is the template.
+
+The fourth element is optional and can specify a destination file for
+remember items created with this template. The default file is given
+by `org-default-notes-file'. If the file name is not an absolute path,
+it will be interpreted relative to `org-directory'.
+
+An optional fifth element can specify the headline in that file that should
+be offered first when the user is asked to file the entry. The default
+headline is given in the variable `org-remember-default-headline'. When
+this element is `top' or `bottom', the note will be placed as a level-1
+entry at the beginning or end of the file, respectively.
+
+An optional sixth element specifies the contexts in which the template
+will be offered to the user. This element can be a list of major modes
+or a function, and the template will only be offered if `org-remember'
+is called from a mode in the list, or if the function returns t.
+Templates that specify t or nil for the context will always be added
+to the list of selectable templates.
+
+The template specifies the structure of the remember buffer. It should have
+a first line starting with a star, to act as the org-mode headline.
+Furthermore, the following %-escapes will be replaced with content:
+
+ %^{PROMPT} prompt the user for a string and replace this sequence with it.
+ A default value and a completion table can be specified like this:
+ %^{prompt|default|completion2|completion3|...}
+ The arrow keys access a prompt-specific history.
+ %a annotation, normally the link created with `org-store-link'
+ %A like %a, but prompt for the description part
+ %i initial content, copied from the active region. If %i is
+ indented, the entire inserted text will be indented as well.
+ %t time stamp, date only
+ %T time stamp with date and time
+ %u, %U like the above, but inactive time stamps
+ %^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
+ You may define a prompt like %^{Please specify birthday}t
+ %n user name (taken from `user-full-name')
+ %c current kill ring head
+ %x content of the X clipboard
+ %:keyword specific information for certain link types, see below
+ %^C interactive selection of which kill or clip to use
+ %^L like %^C, but insert as link
+ %k title of the currently clocked task
+ %K link to the currently clocked task
+ %^g prompt for tags, completing tags in the target file
+ %^G prompt for tags, completing all tags in all agenda files
+ %^{PROP}p Prompt the user for a value for property PROP
+ %[PATHNAME] insert the contents of the file given by PATHNAME
+ %(SEXP) evaluate elisp `(SEXP)' and replace with the result
+ %! store this note immediately after completing the template\
+ \\<org-remember-mode-map>
+ (skipping the \\[org-remember-finalize] that normally triggers storing)
+ %& jump to target location immediately after storing note
+ %? after completing the template, position cursor here.
+
+Apart from these general escapes, you can access information specific to the
+link type that is created. For example, calling `remember' in emails or gnus
+will record the author and the subject of the message, which you can access
+with %:fromname and %:subject, respectively. Here is a complete list of what
+is recorded for each link type.
+
+Link type | Available information
+-------------------+------------------------------------------------------
+bbdb | %:type %:name %:company
+vm, wl, mh, rmail | %:type %:subject %:message-id
+ | %:from %:fromname %:fromaddress
+ | %:to %:toname %:toaddress
+ | %:fromto (either \"to NAME\" or \"from NAME\")
+gnus | %:group, for messages also all email fields and
+ | %:org-date (the Date: header in Org format)
+w3, w3m | %:type %:url
+info | %:type %:file %:node
+calendar | %:type %:date"
+ :group 'org-remember
+ :get (lambda (var) ; Make sure all entries have at least 5 elements
+ (mapcar (lambda (x)
+ (if (not (stringp (car x))) (setq x (cons "" x)))
+ (cond ((= (length x) 4) (append x '(nil)))
+ ((= (length x) 3) (append x '(nil nil)))
+ (t x)))
+ (default-value var)))
+ :type '(repeat
+ :tag "enabled"
+ (list :value ("" ?a "\n" nil nil nil)
+ (string :tag "Name")
+ (character :tag "Selection Key")
+ (string :tag "Template")
+ (choice :tag "Destination file"
+ (file :tag "Specify")
+ (function :tag "Function")
+ (const :tag "Use `org-default-notes-file'" nil))
+ (choice :tag "Destin. headline"
+ (string :tag "Specify")
+ (function :tag "Function")
+ (const :tag "Use `org-remember-default-headline'" nil)
+ (const :tag "At beginning of file" top)
+ (const :tag "At end of file" bottom)
+ (const :tag "In a date tree" date-tree))
+ (choice :tag "Context"
+ (const :tag "Use in all contexts" nil)
+ (const :tag "Use in all contexts" t)
+ (repeat :tag "Use only if in major mode"
+ (symbol :tag "Major mode"))
+ (function :tag "Perform a check against function")))))
+
+(defcustom org-remember-delete-empty-lines-at-end t
+ "Non-nil means clean up final empty lines in remember buffer."
+ :group 'org-remember
+ :type 'boolean)
+
+(defcustom org-remember-before-finalize-hook nil
+ "Hook that is run right before a remember process is finalized.
+The remember buffer is still current when this hook runs."
+ :group 'org-remember
+ :type 'hook)
+
+(defvar org-remember-mode-map (make-sparse-keymap)
+ "Keymap for `org-remember-mode', a minor mode.
+Use this map to set additional keybindings for when Org-mode is used
+for a Remember buffer.")
+(defvar org-remember-mode-hook nil
+ "Hook for the minor `org-remember-mode'.")
+
+(define-minor-mode org-remember-mode
+ "Minor mode for special key bindings in a remember buffer."
+ nil " Rem" org-remember-mode-map
+ (run-hooks 'org-remember-mode-hook))
+(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize)
+(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill)
+
+(defcustom org-remember-clock-out-on-exit 'query
+ "Non-nil means stop the clock when exiting a clocking remember buffer.
+This only applies if the clock is running in the remember buffer. If the
+clock is not stopped, it continues to run in the storage location.
+Instead of nil or t, this may also be the symbol `query' to prompt the
+user each time a remember buffer with a running clock is filed away."
+ :group 'org-remember
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Query user" query)))
+
+(defcustom org-remember-backup-directory nil
+ "Directory where to store all remember buffers, for backup purposes.
+After a remember buffer has been stored successfully, the backup file
+will be removed. However, if you forget to finish the remember process,
+the file will remain there.
+See also `org-remember-auto-remove-backup-files'."
+ :group 'org-remember
+ :type '(choice
+ (const :tag "No backups" nil)
+ (directory :tag "Directory")))
+
+(defcustom org-remember-auto-remove-backup-files t
+ "Non-nil means remove remember backup files after successfully storage.
+When remember is finished successfully, with storing the note at the
+desired target, remove the backup files related to this remember process
+and show a message about remaining backup files, from previous, unfinished
+remember sessions.
+Backup files will only be made at all, when `org-remember-backup-directory'
+is set."
+ :group 'org-remember
+ :type 'boolean)
+
+(defcustom org-remember-warn-about-backups t
+ "Non-nil means warn about backup files in `org-remember-backup-directory'.
+
+Set this to nil if you find that you don't need the warning.
+
+If you cancel remember calls frequently and know when they
+contain useful information (because you know that you made an
+error or Emacs crashed, for example) nil is more useful. In the
+opposite case, the default, t, is more useful."
+ :group 'org-remember
+ :type 'boolean)
+
+;;;###autoload
+(defun org-remember-insinuate ()
+ "Setup remember.el for use with Org-mode."
+ (org-require-remember)
+ (setq remember-annotation-functions '(org-remember-annotation))
+ (setq remember-handler-functions '(org-remember-handler))
+ (add-hook 'remember-mode-hook 'org-remember-apply-template))
+
+;;;###autoload
+(defun org-remember-annotation ()
+ "Return a link to the current location as an annotation for remember.el.
+If you are using Org-mode files as target for data storage with
+remember.el, then the annotations should include a link compatible with the
+conventions in Org-mode. This function returns such a link."
+ (org-store-link nil))
+
+(defconst org-remember-help
+ "Select a destination location for the note.
+UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
+RET on headline -> Store as sublevel entry to current headline
+RET at beg-of-buf -> Append to file as level 2 headline
+<left>/<right> -> before/after current headline, same headings level")
+
+(defvar org-jump-to-target-location nil)
+(defvar org-remember-previous-location nil)
+(defvar org-remember-reference-date nil)
+(defvar org-force-remember-template-char) ;; dynamically scoped
+
+;; Save the major mode of the buffer we called remember from
+(defvar org-select-template-temp-major-mode nil)
+
+;; Temporary store the buffer where remember was called from
+(defvar org-select-template-original-buffer nil)
+
+(defun org-select-remember-template (&optional use-char)
+ (when org-remember-templates
+ (let* ((pre-selected-templates
+ (mapcar
+ (lambda (tpl)
+ (let ((ctxt (nth 5 tpl))
+ (mode org-select-template-temp-major-mode)
+ (buf org-select-template-original-buffer))
+ (and (or (not ctxt) (eq ctxt t)
+ (and (listp ctxt) (memq mode ctxt))
+ (and (functionp ctxt)
+ (with-current-buffer buf
+ ;; Protect the user-defined function from error
+ (condition-case nil (funcall ctxt) (error nil)))))
+ tpl)))
+ org-remember-templates))
+ ;; If no template at this point, add the default templates:
+ (pre-selected-templates1
+ (if (not (delq nil pre-selected-templates))
+ (mapcar (lambda(x) (if (not (nth 5 x)) x))
+ org-remember-templates)
+ pre-selected-templates))
+ ;; Then unconditionally add template for any contexts
+ (pre-selected-templates2
+ (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x))
+ org-remember-templates)
+ (delq nil pre-selected-templates1)))
+ (templates (mapcar (lambda (x)
+ (if (stringp (car x))
+ (append (list (nth 1 x) (car x)) (cddr x))
+ (append (list (car x) "") (cdr x))))
+ (delq nil pre-selected-templates2)))
+ msg
+ (char (or use-char
+ (cond
+ ((= (length templates) 1)
+ (caar templates))
+ ((and (boundp 'org-force-remember-template-char)
+ org-force-remember-template-char)
+ (if (stringp org-force-remember-template-char)
+ (string-to-char org-force-remember-template-char)
+ org-force-remember-template-char))
+ (t
+ (setq msg (format
+ "Select template: %s%s"
+ (mapconcat
+ (lambda (x)
+ (cond
+ ((not (string-match "\\S-" (nth 1 x)))
+ (format "[%c]" (car x)))
+ ((equal (downcase (car x))
+ (downcase (aref (nth 1 x) 0)))
+ (format "[%c]%s" (car x)
+ (substring (nth 1 x) 1)))
+ (t (format "[%c]%s" (car x) (nth 1 x)))))
+ templates " ")
+ (if (assoc ?C templates)
+ ""
+ " [C]customize templates")))
+ (let ((inhibit-quit t) char0)
+ (while (not char0)
+ (message msg)
+ (setq char0 (read-char-exclusive))
+ (when (and (not (assoc char0 templates))
+ (not (equal char0 ?\C-g))
+ (not (equal char0 ?C)))
+ (message "No such template \"%c\"" char0)
+ (ding) (sit-for 1)
+ (setq char0 nil)))
+ (when (equal char0 ?\C-g)
+ (jump-to-register remember-register)
+ (kill-buffer remember-buffer)
+ (error "Abort"))
+ (when (not (assoc char0 templates))
+ (jump-to-register remember-register)
+ (kill-buffer remember-buffer)
+ (customize-variable 'org-remember-templates)
+ (error "Customize templates"))
+ char0))))))
+ (cddr (assoc char templates)))))
+
+;;;###autoload
+(defun org-remember-apply-template (&optional use-char skip-interactive)
+ "Initialize *remember* buffer with template, invoke `org-mode'.
+This function should be placed into `remember-mode-hook' and in fact requires
+to be run from that hook to function properly."
+ (when (and (boundp 'initial) (stringp initial))
+ (setq initial (org-no-properties initial)))
+ (if org-remember-templates
+ (let* ((entry (org-select-remember-template use-char))
+ (ct (or org-overriding-default-time (org-current-time)))
+ (dct (decode-time ct))
+ (ct1
+ (if (< (nth 2 dct) org-extend-today-until)
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+ ct))
+ (tpl (car entry))
+ (plist-p (if org-store-link-plist t nil))
+ (file (if (and (nth 1 entry)
+ (or (and (stringp (nth 1 entry))
+ (string-match "\\S-" (nth 1 entry)))
+ (functionp (nth 1 entry))))
+ (nth 1 entry)
+ org-default-notes-file))
+ (headline (nth 2 entry))
+ (v-c (and (> (length kill-ring) 0) (current-kill 0)))
+ (v-x (or (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)))
+ (v-t (format-time-string (car org-time-stamp-formats) ct))
+ (v-T (format-time-string (cdr org-time-stamp-formats) ct))
+ (v-u (concat "[" (substring v-t 1 -1) "]"))
+ (v-U (concat "[" (substring v-T 1 -1) "]"))
+ ;; `initial' and `annotation' are bound in `remember'.
+ ;; But if the property list has them, we prefer those values
+ (v-i (or (plist-get org-store-link-plist :initial)
+ (and (boundp 'initial) (symbol-value 'initial))
+ ""))
+ (v-a (or (plist-get org-store-link-plist :annotation)
+ (and (boundp 'annotation) (symbol-value 'annotation))
+ ""))
+ ;; Is the link empty? Then we do not want it...
+ (v-a (if (equal v-a "[[]]") "" v-a))
+ (clipboards (remove nil (list v-i
+ (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)
+ v-c)))
+ (v-A (if (and v-a
+ (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
+ (replace-match "[\\1[%^{Link description}]]" nil nil v-a)
+ v-a))
+ (v-n user-full-name)
+ (v-k (if (marker-buffer org-clock-marker)
+ (org-no-properties org-clock-heading)))
+ (v-K (if (marker-buffer org-clock-marker)
+ (org-make-link-string
+ (buffer-file-name (marker-buffer org-clock-marker))
+ org-clock-heading)))
+ v-I
+ (org-startup-folded nil)
+ (org-inhibit-startup t)
+ org-time-was-given org-end-time-was-given x
+ prompt completions char time pos default histvar)
+
+ (when (functionp file)
+ (setq file (funcall file)))
+ (when (functionp headline)
+ (setq headline (funcall headline)))
+ (when (and file (not (file-name-absolute-p file)))
+ (setq file (expand-file-name file org-directory)))
+
+ (setq org-store-link-plist
+ (plist-put org-store-link-plist :annotation v-a)
+ org-store-link-plist
+ (plist-put org-store-link-plist :initial v-i))
+
+ (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
+ (erase-buffer)
+ (insert (substitute-command-keys
+ (format
+ "## %s \"%s\" -> \"* %s\"
+## C-u C-c C-c like C-c C-c, and immediately visit note at target location
+## C-0 C-c C-c \"%s\" -> \"* %s\"
+## %s to select file and header location interactively.
+## C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item
+## To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n"
+ (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c")
+ (abbreviate-file-name (or file org-default-notes-file))
+ (or headline "")
+ (or (car org-remember-previous-location) "???")
+ (or (cdr org-remember-previous-location) "???")
+ (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c"))))
+ (insert tpl)
+
+ ;; %[] Insert contents of a file.
+ (goto-char (point-min))
+ (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
+ (unless (org-remember-escaped-%)
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (filename (expand-file-name (match-string 1))))
+ (goto-char start)
+ (delete-region start end)
+ (condition-case error
+ (insert-file-contents filename)
+ (error (insert (format "%%![Couldn't insert %s: %s]"
+ filename error)))))))
+ ;; Simple %-escapes
+ (goto-char (point-min))
+ (let ((init (and (boundp 'initial)
+ (symbol-value 'initial))))
+ (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
+ (unless (org-remember-escaped-%)
+ (when (and init (equal (match-string 0) "%i"))
+ (save-match-data
+ (let* ((lead (buffer-substring
+ (point-at-bol) (match-beginning 0))))
+ (setq v-i (mapconcat 'identity
+ (org-split-string init "\n")
+ (concat "\n" lead))))))
+ (replace-match
+ (or (eval (intern (concat "v-" (match-string 1)))) "")
+ t t))))
+
+ ;; %() embedded elisp
+ (goto-char (point-min))
+ (while (re-search-forward "%\\((.+)\\)" nil t)
+ (unless (org-remember-escaped-%)
+ (goto-char (match-beginning 0))
+ (let ((template-start (point)))
+ (forward-char 1)
+ (let ((result
+ (condition-case error
+ (eval (read (current-buffer)))
+ (error (format "%%![Error: %s]" error)))))
+ (delete-region template-start (point))
+ (insert result)))))
+
+ ;; From the property list
+ (when plist-p
+ (goto-char (point-min))
+ (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
+ (unless (org-remember-escaped-%)
+ (and (setq x (or (plist-get org-store-link-plist
+ (intern (match-string 1))) ""))
+ (replace-match x t t)))))
+
+ ;; Turn on org-mode in the remember buffer, set local variables
+ (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))
+ (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
+ (org-set-local 'org-default-notes-file file))
+ (if headline
+ (org-set-local 'org-remember-default-headline headline))
+ (org-set-local 'org-remember-reference-date
+ (list (nth 4 dct) (nth 3 dct) (nth 5 dct)))
+ ;; Interactive template entries
+ (goto-char (point-min))
+ (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
+ (unless (org-remember-escaped-%)
+ (setq char (if (match-end 3) (match-string 3))
+ prompt (if (match-end 2) (match-string 2)))
+ (goto-char (match-beginning 0))
+ (replace-match "")
+ (setq completions nil default nil)
+ (when prompt
+ (setq completions (org-split-string prompt "|")
+ prompt (pop completions)
+ default (car completions)
+ histvar (intern (concat
+ "org-remember-template-prompt-history::"
+ (or prompt "")))
+ completions (mapcar 'list completions)))
+ (cond
+ ((member char '("G" "g"))
+ (let* ((org-last-tags-completion-table
+ (org-global-tags-completion-table
+ (if (equal char "G") (org-agenda-files) (and file (list file)))))
+ (org-add-colon-after-tag-completion t)
+ (ins (org-icompleting-read
+ (if prompt (concat prompt ": ") "Tags: ")
+ 'org-tags-completion-function nil nil nil
+ 'org-tags-history)))
+ (setq ins (mapconcat 'identity
+ (org-split-string ins (org-re "[^[:alnum:]_@#%]+"))
+ ":"))
+ (when (string-match "\\S-" ins)
+ (or (equal (char-before) ?:) (insert ":"))
+ (insert ins)
+ (or (equal (char-after) ?:) (insert ":")))))
+ ((equal char "C")
+ (cond ((= (length clipboards) 1) (insert (car clipboards)))
+ ((> (length clipboards) 1)
+ (insert (read-string "Clipboard/kill value: "
+ (car clipboards) '(clipboards . 1)
+ (car clipboards))))))
+ ((equal char "L")
+ (cond ((= (length clipboards) 1)
+ (org-insert-link 0 (car clipboards)))
+ ((> (length clipboards) 1)
+ (org-insert-link 0 (read-string "Clipboard/kill value: "
+ (car clipboards)
+ '(clipboards . 1)
+ (car clipboards))))))
+ ((equal char "p")
+ (let*
+ ((prop (org-no-properties prompt))
+ (pall (concat prop "_ALL"))
+ (allowed
+ (with-current-buffer
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (or (cdr (assoc pall org-file-properties))
+ (cdr (assoc pall org-global-properties))
+ (cdr (assoc pall org-global-properties-fixed)))))
+ (existing (with-current-buffer
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (mapcar 'list (org-property-values prop))))
+ (propprompt (concat "Value for " prop ": "))
+ (val (if allowed
+ (org-completing-read
+ propprompt
+ (mapcar 'list (org-split-string allowed "[ \t]+"))
+ nil 'req-match)
+ (org-completing-read-no-i propprompt existing nil nil
+ "" nil ""))))
+ (org-set-property prop val)))
+ (char
+ ;; These are the date/time related ones
+ (setq org-time-was-given (equal (upcase char) char))
+ (setq time (org-read-date (equal (upcase char) "U") t nil
+ prompt))
+ (org-insert-time-stamp time org-time-was-given
+ (member char '("u" "U"))
+ nil nil (list org-end-time-was-given)))
+ (t
+ (let (org-completion-use-ido)
+ (insert (org-without-partial-completion
+ (org-completing-read-no-i
+ (concat (if prompt prompt "Enter string")
+ (if default (concat " [" default "]"))
+ ": ")
+ completions nil nil nil histvar default))))))))
+
+ (goto-char (point-min))
+ (if (re-search-forward "%\\?" nil t)
+ (replace-match "")
+ (and (re-search-forward "^[^#\n]" nil t) (backward-char 1))))
+ (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)))
+ (when (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "%&" nil t))
+ (replace-match "")
+ (org-set-local 'org-jump-to-target-location t))
+ (when org-remember-backup-directory
+ (unless (file-directory-p org-remember-backup-directory)
+ (make-directory org-remember-backup-directory))
+ (org-set-local 'auto-save-file-name-transforms nil)
+ (setq buffer-file-name
+ (expand-file-name
+ (format-time-string "remember-%Y-%m-%d-%H-%M-%S")
+ org-remember-backup-directory))
+ (save-buffer)
+ (org-set-local 'auto-save-visited-file-name t)
+ (auto-save-mode 1))
+ (when (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "%!" nil t))
+ (replace-match "")
+ (add-hook 'post-command-hook 'org-remember-finish-immediately 'append)))
+
+(defun org-remember-escaped-% ()
+ (if (equal (char-before (match-beginning 0)) ?\\)
+ (progn
+ (delete-region (1- (match-beginning 0)) (match-beginning 0))
+ t)
+ nil))
+
+
+(defun org-remember-finish-immediately ()
+ "File remember note immediately.
+This should be run in `post-command-hook' and will remove itself
+from that hook."
+ (remove-hook 'post-command-hook 'org-remember-finish-immediately)
+ (org-remember-finalize))
+
+(defun org-remember-visit-immediately ()
+ "File remember note immediately.
+This should be run in `post-command-hook' and will remove itself
+from that hook."
+ (org-remember '(16))
+ (goto-char (or (text-property-any
+ (point) (save-excursion (org-end-of-subtree t t))
+ 'org-position-cursor t)
+ (point)))
+ (message "%s"
+ (format
+ (substitute-command-keys
+ "Restore window configuration with \\[jump-to-register] %c")
+ remember-register)))
+
+(defvar org-clock-marker) ; Defined in org.el
+(defun org-remember-finalize ()
+ "Finalize the remember process."
+ (interactive)
+ (unless org-remember-mode
+ (error "This does not seem to be a remember buffer for Org-mode"))
+ (run-hooks 'org-remember-before-finalize-hook)
+ (unless (fboundp 'remember-finalize)
+ (defalias 'remember-finalize 'remember-buffer))
+ (when (and org-clock-marker
+ (equal (marker-buffer org-clock-marker) (current-buffer)))
+ ;; the clock is running in this buffer.
+ (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
+ (or (eq org-remember-clock-out-on-exit t)
+ (and org-remember-clock-out-on-exit
+ (y-or-n-p "The clock is running in this buffer. Clock out now? "))))
+ (let (org-log-note-clock-out) (org-clock-out))))
+ (when buffer-file-name
+ (do-auto-save))
+ (remember-finalize))
+
+(defun org-remember-kill ()
+ "Abort the current remember process."
+ (interactive)
+ (let ((org-note-abort t))
+ (org-remember-finalize)))
+
+;;;###autoload
+(defun org-remember (&optional goto org-force-remember-template-char)
+ "Call `remember'. If this is already a remember buffer, re-apply template.
+If there is an active region, make sure remember uses it as initial content
+of the remember buffer.
+
+When called interactively with a \\[universal-argument] \
+prefix argument GOTO, don't remember
+anything, just go to the file/headline where the selected template usually
+stores its notes. With a double prefix argument \
+\\[universal-argument] \\[universal-argument], go to the last
+note stored by remember.
+
+Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
+associated with a template in `org-remember-templates'."
+ (interactive "P")
+ (org-require-remember)
+ (cond
+ ((equal goto '(4)) (org-go-to-remember-target))
+ ((equal goto '(16)) (org-remember-goto-last-stored))
+ (t
+ ;; set temporary variables that will be needed in
+ ;; `org-select-remember-template'
+ (setq org-select-template-temp-major-mode major-mode)
+ (setq org-select-template-original-buffer (current-buffer))
+ (if org-remember-mode
+ (progn
+ (when (< (length org-remember-templates) 2)
+ (error "No other template available"))
+ (erase-buffer)
+ (let ((annotation (plist-get org-store-link-plist :annotation))
+ (initial (plist-get org-store-link-plist :initial)))
+ (org-remember-apply-template))
+ (message "Press C-c C-c to remember data"))
+ (if (org-region-active-p)
+ (org-do-remember (buffer-substring (point) (mark)))
+ (org-do-remember))))))
+
+(defvar org-remember-last-stored-marker (make-marker)
+ "Marker pointing to the entry most recently stored with `org-remember'.")
+
+(defun org-remember-goto-last-stored ()
+ "Go to the location where the last remember note was stored."
+ (interactive)
+ (org-goto-marker-or-bmk org-remember-last-stored-marker
+ "org-remember-last-stored")
+ (message "This is the last note stored by remember"))
+
+(defun org-go-to-remember-target (&optional template-key)
+ "Go to the target location of a remember template.
+The user is queried for the template."
+ (interactive)
+ (let* (org-select-template-temp-major-mode
+ (entry (org-select-remember-template template-key))
+ (file (nth 1 entry))
+ (heading (nth 2 entry))
+ visiting)
+ (unless (and file (stringp file) (string-match "\\S-" file))
+ (setq file org-default-notes-file))
+ (when (and file (not (file-name-absolute-p file)))
+ (setq file (expand-file-name file org-directory)))
+ (unless (and heading (stringp heading) (string-match "\\S-" heading))
+ (setq heading org-remember-default-headline))
+ (setq visiting (org-find-base-buffer-visiting file))
+ (if (not visiting) (find-file-noselect file))
+ (org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (format org-complex-heading-regexp-format (regexp-quote heading))
+ nil t)
+ (goto-char (match-beginning 0))
+ (error "Target headline not found: %s" heading))))
+
+;; FIXME (bzg): let's clean up of final empty lines happen only once
+;; (see the org-remember-delete-empty-lines-at-end option below)
+;;;###autoload
+(defun org-remember-handler ()
+ "Store stuff from remember.el into an org file.
+When the template has specified a file and a headline, the entry is filed
+there, or in the location defined by `org-default-notes-file' and
+`org-remember-default-headline'.
+\\<org-remember-mode-map>
+If no defaults have been defined, or if the current prefix argument
+is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive
+process is used to select the target location.
+
+When the prefix is 0 (i.e. when remember is exited with \
+C-0 \\[org-remember-finalize]),
+the entry is filed to the same location as the previous note.
+
+When the prefix is 2 (i.e. when remember is exited with \
+C-2 \\[org-remember-finalize]),
+the entry is filed as a subentry of the entry where the clock is
+currently running.
+
+When \\[universal-argument] has been used as prefix argument, the
+note is stored and Emacs moves point to the new location of the
+note, so that editing can be continued there (similar to
+inserting \"%&\" into the template).
+
+Before storing the note, the function ensures that the text has an
+org-mode-style headline, i.e. a first line that starts with
+a \"*\". If not, a headline is constructed from the current date and
+some additional data.
+
+If the variable `org-adapt-indentation' is non-nil, the entire text is
+also indented so that it starts in the same column as the headline
+\(i.e. after the stars).
+
+See also the variable `org-reverse-note-order'."
+ (when (and (equal current-prefix-arg 2)
+ (not (marker-buffer org-clock-marker)))
+ (error "No running clock"))
+ (when (org-bound-and-true-p org-jump-to-target-location)
+ (let* ((end (min (point-max) (1+ (point))))
+ (beg (point)))
+ (if (= end beg) (setq beg (1- beg)))
+ (put-text-property beg end 'org-position-cursor t)))
+ (goto-char (point-min))
+ (while (looking-at "^[ \t]*\n\\|^##.*\n")
+ (replace-match ""))
+ (when org-remember-delete-empty-lines-at-end
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (while (and (looking-at "[ \t]*$\\|##.*") (> (point) 1))
+ (delete-region (1- (point)) (point-max))
+ (beginning-of-line 1)))
+ (catch 'quit
+ (if org-note-abort (throw 'quit t))
+ (let* ((visitp (org-bound-and-true-p org-jump-to-target-location))
+ (backup-file
+ (and buffer-file-name
+ (equal (file-name-directory buffer-file-name)
+ (file-name-as-directory
+ (expand-file-name org-remember-backup-directory)))
+ (string-match "^remember-[0-9]\\{4\\}"
+ (file-name-nondirectory buffer-file-name))
+ buffer-file-name))
+
+ (dummy
+ (unless (string-match "\\S-" (buffer-string))
+ (message "Nothing to remember")
+ (and backup-file
+ (ignore-errors
+ (delete-file backup-file)
+ (delete-file (concat backup-file "~"))))
+ (set-buffer-modified-p nil)
+ (throw 'quit t)))
+ (reference-date org-remember-reference-date)
+ (previousp (and (member current-prefix-arg '((16) 0))
+ org-remember-previous-location))
+ (clockp (equal current-prefix-arg 2))
+ (clocksp (equal current-prefix-arg 3))
+ (fastp (org-xor (equal current-prefix-arg 1)
+ org-remember-store-without-prompt))
+ (file (cond
+ (fastp org-default-notes-file)
+ ((and (eq org-remember-interactive-interface 'refile)
+ org-refile-targets)
+ org-default-notes-file)
+ ((not previousp)
+ (org-get-org-file))))
+ (heading org-remember-default-headline)
+ (visiting (and file (org-find-base-buffer-visiting file)))
+ (org-startup-folded nil)
+ (org-startup-align-all-tables nil)
+ (org-goto-start-pos 1)
+ spos exitcmd level reversed txt text-before-node-creation)
+ (when (equal current-prefix-arg '(4))
+ (setq visitp t))
+ (when previousp
+ (setq file (car org-remember-previous-location)
+ visiting (and file (org-find-base-buffer-visiting file))
+ heading (cdr org-remember-previous-location)
+ fastp t))
+ (when (or clockp clocksp)
+ (setq file (buffer-file-name (marker-buffer org-clock-marker))
+ visiting (and file (org-find-base-buffer-visiting file))
+ heading org-clock-heading-for-remember
+ fastp t))
+ (setq current-prefix-arg nil)
+ ;; Modify text so that it becomes a nice subtree which can be inserted
+ ;; into an org tree.
+ (when org-remember-delete-empty-lines-at-end
+ (goto-char (point-min))
+ (if (re-search-forward "[ \t\n]+\\'" nil t)
+ ;; remove empty lines at end
+ (replace-match "")))
+ (goto-char (point-min))
+ (setq text-before-node-creation (buffer-string))
+ (unless (looking-at org-outline-regexp)
+ ;; add a headline
+ (insert (concat "* " (current-time-string)
+ " (" (remember-buffer-desc) ")\n"))
+ (backward-char 1)
+ (when org-adapt-indentation
+ (while (re-search-forward "^" nil t)
+ (insert " "))))
+ ;; Delete final empty lines
+ (when org-remember-delete-empty-lines-at-end
+ (goto-char (point-min))
+ (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t)
+ (replace-match "\n\n")
+ (if (re-search-forward "[ \t\n]*\\'")
+ (replace-match "\n"))))
+ (goto-char (point-min))
+ (setq txt (buffer-string))
+ (org-save-markers-in-region (point-min) (point-max))
+ (set-buffer-modified-p nil)
+ (when (and (eq org-remember-interactive-interface 'refile)
+ (not fastp))
+ (org-refile nil (or visiting (find-file-noselect file)))
+ (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
+ (save-excursion
+ (bookmark-jump "org-refile-last-stored")
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point)))
+ (throw 'quit t))
+ ;; Find the file
+ (with-current-buffer (or visiting (find-file-noselect file))
+ (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom)))
+ (error "Target files for notes must be in Org-mode if not filing to top/bottom"))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq reversed (org-notes-order-reversed-p))
+
+ ;; Find the default location
+ (when heading
+ (cond
+ ((not (derived-mode-p 'org-mode))
+ (if (eq heading 'top)
+ (goto-char (point-min))
+ (goto-char (point-max))
+ (or (bolp) (newline)))
+ (insert text-before-node-creation)
+ (when remember-save-after-remembering
+ (save-buffer)
+ (if (not visiting) (kill-buffer (current-buffer))))
+ (throw 'quit t))
+ ((eq heading 'top)
+ (goto-char (point-min))
+ (or (looking-at org-outline-regexp)
+ (re-search-forward org-outline-regexp nil t))
+ (setq org-goto-start-pos (or (match-beginning 0) (point-min))))
+ ((eq heading 'bottom)
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (setq org-goto-start-pos (point)))
+ ((eq heading 'date-tree)
+ (org-datetree-find-date-create reference-date)
+ (setq reversed nil)
+ (setq org-goto-start-pos (point)))
+ ((and (stringp heading) (string-match "\\S-" heading))
+ (goto-char (point-min))
+ (if (re-search-forward
+ (format org-complex-heading-regexp-format
+ (regexp-quote heading))
+ nil t)
+ (setq org-goto-start-pos (match-beginning 0))
+ (when fastp
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (insert "* " heading "\n")
+ (setq org-goto-start-pos (point-at-bol 0)))))
+ (t (goto-char (point-min)) (setq org-goto-start-pos (point)
+ heading 'top))))
+
+ ;; Ask the User for a location, using the appropriate interface
+ (cond
+ ((and fastp (memq heading '(top bottom)))
+ (setq spos org-goto-start-pos
+ exitcmd (if (eq heading 'top) 'left nil)))
+ (fastp (setq spos org-goto-start-pos
+ exitcmd 'return))
+ ((eq org-remember-interactive-interface 'outline)
+ (setq spos (org-get-location (current-buffer)
+ org-remember-help)
+ exitcmd (cdr spos)
+ spos (car spos)))
+ ((eq org-remember-interactive-interface 'outline-path-completion)
+ (let ((org-refile-targets '((nil . (:maxlevel . 10))))
+ (org-refile-use-outline-path t))
+ (setq spos (org-refile-get-location "Heading")
+ exitcmd 'return
+ spos (nth 3 spos))))
+ (t (error "This should not happen")))
+ (if (not spos) (throw 'quit nil)) ; return nil to show we did
+ ; not handle this note
+ (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
+ (goto-char spos)
+ (cond ((org-at-heading-p t)
+ (org-back-to-heading t)
+ (setq level (funcall outline-level))
+ (cond
+ ((eq exitcmd 'return)
+ ;; sublevel of current
+ (setq org-remember-previous-location
+ (cons (abbreviate-file-name file)
+ (org-get-heading 'notags)))
+ (if reversed
+ (outline-next-heading)
+ (org-end-of-subtree t)
+ (if (not (bolp))
+ (if (looking-at "[ \t]*\n")
+ (beginning-of-line 2)
+ (end-of-line 1)
+ (insert "\n"))))
+ (org-paste-subtree (if clocksp
+ level
+ (org-get-valid-level level 1)) txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point)))
+ ((eq exitcmd 'left)
+ ;; before current
+ (org-paste-subtree level txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point)))
+ ((eq exitcmd 'right)
+ ;; after current
+ (org-end-of-subtree t)
+ (org-paste-subtree level txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point)))
+ (t (error "This should not happen"))))
+
+ ((eq heading 'bottom)
+ (org-paste-subtree 1 txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point)))
+
+ ((and (bobp) (not reversed))
+ ;; Put it at the end, one level below level 1
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (if (not (bolp)) (newline))
+ (org-paste-subtree (org-get-valid-level 1 1) txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point))))
+
+ ((and (bobp) reversed)
+ ;; Put it at the start, as level 1
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward org-outline-regexp-bol nil t)
+ (beginning-of-line 1)
+ (org-paste-subtree 1 txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point))))
+ (t
+ ;; Put it right there, with automatic level determined by
+ ;; org-paste-subtree or from prefix arg
+ (org-paste-subtree
+ (if (numberp current-prefix-arg) current-prefix-arg)
+ txt)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (bookmark-set "org-remember-last-stored")
+ (move-marker org-remember-last-stored-marker (point))))
+
+ (when remember-save-after-remembering
+ (save-buffer)
+ (if (and (not visiting)
+ (not (equal (marker-buffer org-clock-marker)
+ (current-buffer))))
+ (kill-buffer (current-buffer))))
+ (when org-remember-auto-remove-backup-files
+ (when backup-file
+ (ignore-errors
+ (delete-file backup-file)
+ (delete-file (concat backup-file "~"))))
+ (when org-remember-backup-directory
+ (let ((n (length
+ (directory-files
+ org-remember-backup-directory nil
+ "^remember-.*[0-9]$"))))
+ (when (and org-remember-warn-about-backups
+ (> n 0))
+ (message
+ "%d backup files (unfinished remember calls) in %s"
+ n org-remember-backup-directory))))))))))
+
+ t) ;; return t to indicate that we took care of this note.
+
+(defun org-do-remember (&optional initial)
+ "Call remember."
+ (remember initial))
+
+(defun org-require-remember ()
+ "Make sure remember is loaded, or install our own emergency version of it."
+ (condition-case nil
+ (require 'remember)
+ (error
+ ;; Lets install our own micro version of remember
+ (defvar remember-register ?R)
+ (defvar remember-mode-hook nil)
+ (defvar remember-handler-functions nil)
+ (defvar remember-buffer "*Remember*")
+ (defvar remember-save-after-remembering t)
+ (defvar remember-annotation-functions '(buffer-file-name))
+ (defun remember-finalize ()
+ (run-hook-with-args-until-success 'remember-handler-functions)
+ (when (equal remember-buffer (buffer-name))
+ (kill-buffer (current-buffer))
+ (jump-to-register remember-register)))
+ (defun remember-mode ()
+ (fundamental-mode)
+ (setq mode-name "Remember")
+ (run-hooks 'remember-mode-hook))
+ (defun remember (&optional initial)
+ (window-configuration-to-register remember-register)
+ (let* ((annotation (run-hook-with-args-until-success
+ 'remember-annotation-functions)))
+ (switch-to-buffer-other-window (get-buffer-create remember-buffer))
+ (remember-mode)))
+ (defun remember-buffer-desc ()
+ (buffer-substring (point-min) (save-excursion (goto-char (point-min))
+ (point-at-eol)))))))
+
+(provide 'org-remember)
+
+;;; org-remember.el ends here
diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el
new file mode 100644
index 0000000..4be7bcb
--- /dev/null
+++ b/lisp/org-rmail.el
@@ -0,0 +1,121 @@
+;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to Rmail messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+;; Declare external functions and variables
+(declare-function rmail-show-message "rmail" (&optional n no-summary))
+(declare-function rmail-what-message "rmail" (&optional pos))
+(declare-function rmail-toggle-header "rmail" (&optional arg))
+(declare-function rmail-widen "rmail" ())
+(defvar rmail-current-message) ; From rmail.el
+(defvar rmail-header-style) ; From rmail.el
+
+;; Install the link type
+(org-add-link-type "rmail" 'org-rmail-open)
+(add-hook 'org-store-link-functions 'org-rmail-store-link)
+
+;; Implementation
+(defun org-rmail-store-link ()
+ "Store a link to an Rmail folder or message."
+ (when (or (eq major-mode 'rmail-mode)
+ (eq major-mode 'rmail-summary-mode))
+ (save-window-excursion
+ (save-restriction
+ (when (eq major-mode 'rmail-summary-mode)
+ (rmail-show-message rmail-current-message))
+ (when (fboundp 'rmail-narrow-to-non-pruned-header)
+ (rmail-narrow-to-non-pruned-header))
+ (when (eq rmail-header-style 'normal)
+ (rmail-toggle-header -1))
+ (let* ((folder buffer-file-name)
+ (message-id (mail-fetch-field "message-id"))
+ (from (mail-fetch-field "from"))
+ (to (mail-fetch-field "to"))
+ (subject (mail-fetch-field "subject"))
+ (date (mail-fetch-field "date"))
+ (date-ts (and date (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time date))))
+ (date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ desc link)
+ (org-store-link-props
+ :type "rmail" :from from :to to
+ :subject subject :message-id message-id)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq message-id (org-remove-angle-brackets message-id))
+ (setq desc (org-email-link-description))
+ (setq link (concat "rmail:" folder "#" message-id))
+ (org-add-link-props :link link :description desc)
+ (rmail-show-message rmail-current-message)
+ link)))))
+
+(defun org-rmail-open (path)
+ "Follow an Rmail message link to the specified PATH."
+ (let (folder article)
+ (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in Rmail link"))
+ (setq folder (match-string 1 path)
+ article (match-string 3 path))
+ (org-rmail-follow-link folder article)))
+
+(defun org-rmail-follow-link (folder article)
+ "Follow an Rmail link to FOLDER and ARTICLE."
+ (require 'rmail)
+ (setq article (org-add-angle-brackets article))
+ (let (message-number)
+ (save-excursion
+ (save-window-excursion
+ (rmail (if (string= folder "RMAIL") rmail-file-name folder))
+ (setq message-number
+ (save-restriction
+ (rmail-widen)
+ (goto-char (point-max))
+ (if (re-search-backward
+ (concat "^Message-ID:\\s-+" (regexp-quote
+ (or article "")))
+ nil t)
+ (rmail-what-message))))))
+ (if message-number
+ (progn
+ (rmail (if (string= folder "RMAIL") rmail-file-name folder))
+ (rmail-show-message message-number)
+ message-number)
+ (error "Message not found"))))
+
+(provide 'org-rmail)
+
+;;; org-rmail.el ends here
diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el
new file mode 100644
index 0000000..ddd6120
--- /dev/null
+++ b/lisp/org-special-blocks.el
@@ -0,0 +1,104 @@
+;;; org-special-blocks.el --- handle Org special blocks
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Chris Gray <chrismgray@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+
+;; This package generalizes the #+begin_foo and #+end_foo tokens.
+
+;; To use, put the following in your init file:
+;;
+;; (require 'org-special-blocks)
+
+;; The tokens #+begin_center, #+begin_verse, etc. existed previously.
+;; This package generalizes them (at least for the LaTeX and html
+;; exporters). When a #+begin_foo token is encountered by the LaTeX
+;; exporter, it is expanded into \begin{foo}. The text inside the
+;; environment is not protected, as text inside environments generally
+;; is. When #+begin_foo is encountered by the html exporter, a div
+;; with class foo is inserted into the HTML file. It is up to the
+;; user to add this class to his or her stylesheet if this div is to
+;; mean anything.
+
+(require 'org-html)
+(require 'org-compat)
+
+(declare-function org-open-par "org-html" ())
+(declare-function org-close-par-maybe "org-html" ())
+
+(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
+ "A regexp indicating the names of blocks that should be ignored
+by org-special-blocks. These blocks will presumably be
+interpreted by other mechanisms.")
+
+(defvar org-export-current-backend) ; dynamically bound in org-exp.el
+(defun org-special-blocks-make-special-cookies ()
+ "Adds special cookies when #+begin_foo and #+end_foo tokens are
+seen. This is run after a few special cases are taken care of."
+ (when (or (eq org-export-current-backend 'html)
+ (eq org-export-current-backend 'latex))
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
+ (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2))
+ (replace-match
+ (if (equal (downcase (match-string 1)) "begin")
+ (concat "ORG-" (match-string 2) "-START")
+ (concat "ORG-" (match-string 2) "-END"))
+ t t)))))
+
+(add-hook 'org-export-preprocess-after-blockquote-hook
+ 'org-special-blocks-make-special-cookies)
+
+(defun org-special-blocks-convert-latex-special-cookies ()
+ "Converts the special cookies into LaTeX blocks."
+ (goto-char (point-min))
+ (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t)
+ (replace-match
+ (if (equal (match-string 3) "START")
+ (concat "\\begin{" (match-string 1) "}" (match-string 2))
+ (concat "\\end{" (match-string 1) "}"))
+ t t)))
+
+
+(add-hook 'org-export-latex-after-blockquotes-hook
+ 'org-special-blocks-convert-latex-special-cookies)
+
+(defvar org-line)
+(defun org-special-blocks-convert-html-special-cookies ()
+ "Converts the special cookies into div blocks."
+ ;; Uses the dynamically-bound variable `org-line'.
+ (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line))
+ (message "%s" (match-string 1))
+ (when (equal (match-string 2 org-line) "START")
+ (org-close-par-maybe)
+ (insert "\n<div class=\"" (match-string 1 org-line) "\">")
+ (org-open-par))
+ (when (equal (match-string 2 org-line) "END")
+ (org-close-par-maybe)
+ (insert "\n</div>")
+ (org-open-par))
+ (throw 'nextline nil)))
+
+(add-hook 'org-export-html-after-blockquotes-hook
+ 'org-special-blocks-convert-html-special-cookies)
+
+(provide 'org-special-blocks)
+
+;;; org-special-blocks.el ends here
diff --git a/lisp/org-src.el b/lisp/org-src.el
new file mode 100644
index 0000000..9d6bc1a
--- /dev/null
+++ b/lisp/org-src.el
@@ -0,0 +1,866 @@
+;;; org-src.el --- Source code examples in Org
+;;
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Bastien Guerry <bzg AT gnu DOT org>
+;; Dan Davison <davison at stats dot ox dot ac dot uk>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code dealing with source code examples in Org-mode.
+
+;;; Code:
+
+(require 'org-macs)
+(require 'org-compat)
+(require 'ob-keys)
+(require 'ob-comint)
+(eval-when-compile
+ (require 'cl))
+
+(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-at-table.el-p "org" ())
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-switch-to-buffer-other-window "org" (&rest args))
+(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-strip-protective-commas "org" (beg end))
+(declare-function org-base-buffer "org" (buffer))
+
+(defcustom org-edit-src-region-extra nil
+ "Additional regexps to identify regions for editing with `org-edit-src-code'.
+For examples see the function `org-edit-src-find-region-and-lang'.
+The regular expression identifying the begin marker should end with a newline,
+and the regexp marking the end line should start with a newline, to make sure
+there are kept outside the narrowed region."
+ :group 'org-edit-structure
+ :type '(repeat
+ (list
+ (regexp :tag "begin regexp")
+ (regexp :tag "end regexp")
+ (choice :tag "language"
+ (string :tag "specify")
+ (integer :tag "from match group")
+ (const :tag "from `lang' element")
+ (const :tag "from `style' element")))))
+
+(defcustom org-coderef-label-format "(ref:%s)"
+ "The default coderef format.
+This format string will be used to search for coderef labels in literal
+examples (EXAMPLE and SRC blocks). The format can be overwritten in
+an individual literal example with the -l option, like
+
+#+BEGIN_SRC pascal +n -r -l \"((%s))\"
+...
+#+END_SRC
+
+If you want to use this for HTML export, make sure that the format does
+not introduce special font-locking, and avoid the HTML special
+characters `<', `>', and `&'. The reason for this restriction is that
+the labels are searched for only after htmlize has done its job."
+ :group 'org-edit-structure ; FIXME this is not in the right group
+ :type 'string)
+
+(defcustom org-edit-fixed-width-region-mode 'artist-mode
+ "The mode that should be used to edit fixed-width regions.
+These are the regions where each line starts with a colon."
+ :group 'org-edit-structure
+ :type '(choice
+ (const artist-mode)
+ (const picture-mode)
+ (const fundamental-mode)
+ (function :tag "Other (specify)")))
+
+(defcustom org-src-preserve-indentation nil
+ "If non-nil preserve leading whitespace characters on export.
+If non-nil leading whitespace characters in source code blocks
+are preserved on export, and when switching between the org
+buffer and the language mode edit buffer. If this variable is nil
+then, after editing with \\[org-edit-src-code], the
+minimum (across-lines) number of leading whitespace characters
+are removed from all lines, and the code block is uniformly
+indented according to the value of `org-edit-src-content-indentation'."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-edit-src-content-indentation 2
+ "Indentation for the content of a source code block.
+This should be the number of spaces added to the indentation of the #+begin
+line in order to compute the indentation of the block content after
+editing it with \\[org-edit-src-code]. Has no effect if
+`org-src-preserve-indentation' is non-nil."
+ :group 'org-edit-structure
+ :type 'integer)
+
+(defvar org-src-strip-leading-and-trailing-blank-lines nil
+ "If non-nil, blank lines are removed when exiting the code edit buffer.")
+
+(defcustom org-edit-src-persistent-message t
+ "Non-nil means show persistent exit help message while editing src examples.
+The message is shown in the header-line, which will be created in the
+first line of the window showing the editing buffer."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-src-window-setup 'reorganize-frame
+ "How the source code edit buffer should be displayed.
+Possible values for this option are:
+
+current-window Show edit buffer in the current window, keeping all other
+ windows.
+other-window Use `switch-to-buffer-other-window' to display edit buffer.
+reorganize-frame Show only two windows on the current frame, the current
+ window and the edit buffer. When exiting the edit buffer,
+ return to one window.
+other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
+ Also, when exiting the edit buffer, kill that frame."
+ :group 'org-edit-structure
+ :type '(choice
+ (const current-window)
+ (const other-frame)
+ (const other-window)
+ (const reorganize-frame)))
+
+(defvar org-src-mode-hook nil
+ "Hook run after Org switched a source code snippet to its Emacs mode.
+This hook will run
+
+- when editing a source code snippet with \"C-c '\".
+- When formatting a source code snippet for export with htmlize.
+
+You may want to use this hook for example to turn off `outline-minor-mode'
+or similar things which you want to have when editing a source code file,
+but which mess up the display of a snippet in Org exported files.")
+
+(defcustom org-src-lang-modes
+ '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
+ ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++)
+ ("screen" . shell-script))
+ "Alist mapping languages to their major mode.
+The key is the language name, the value is the string that should
+be inserted as the name of the major mode. For many languages this is
+simple, but for language where this is not the case, this variable
+provides a way to simplify things on the user side.
+For example, there is no ocaml-mode in Emacs, but the mode to use is
+`tuareg-mode'."
+ :group 'org-edit-structure
+ :type '(repeat
+ (cons
+ (string "Language name")
+ (symbol "Major mode"))))
+
+;;; Editing source examples
+
+(defvar org-src-mode-map (make-sparse-keymap))
+(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
+(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
+
+(defvar org-edit-src-force-single-line nil)
+(defvar org-edit-src-from-org-mode nil)
+(defvar org-edit-src-allow-write-back-p t)
+(defvar org-edit-src-picture nil)
+(defvar org-edit-src-beg-marker nil)
+(defvar org-edit-src-end-marker nil)
+(defvar org-edit-src-overlay nil)
+(defvar org-edit-src-block-indentation nil)
+(defvar org-edit-src-saved-temp-window-config nil)
+
+(defvar org-src-ask-before-returning-to-edit-buffer t
+ "If nil, when org-edit-src code is used on a block that already
+has an active edit buffer, it will switch to that edit buffer
+immediately; otherwise it will ask whether you want to return to
+the existing edit buffer.")
+
+(defvar org-src-babel-info nil)
+
+(define-minor-mode org-src-mode
+ "Minor mode for language major mode buffers generated by org.
+This minor mode is turned on in two situations:
+- when editing a source code snippet with \"C-c '\".
+- When formatting a source code snippet for export with htmlize.
+There is a mode hook, and keybindings for `org-edit-src-exit' and
+`org-edit-src-save'")
+
+(defun org-edit-src-code (&optional context code edit-buffer-name)
+ "Edit the source CODE example at point.
+The example is copied to a separate buffer, and that buffer is
+switched to the correct language mode. When done, exit with
+\\[org-edit-src-exit]. This will remove the original code in the
+Org buffer, and replace it with the edited version. An optional
+argument CONTEXT is used by \\[org-edit-src-save] when calling
+this function. See `org-src-window-setup' to configure the
+display of windows containing the Org buffer and the code
+buffer."
+ (interactive)
+ (unless (eq context 'save)
+ (setq org-edit-src-saved-temp-window-config (current-window-configuration)))
+ (let* ((mark (and (org-region-active-p) (mark)))
+ (case-fold-search t)
+ (info (org-edit-src-find-region-and-lang))
+ (full-info (org-babel-get-src-block-info 'light))
+ (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
+ (beg (make-marker))
+ (end (make-marker))
+ (allow-write-back-p (null code))
+ block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
+ begline markline markcol line col transmitted-variables)
+ (if (not info)
+ nil
+ (setq beg (move-marker beg (nth 0 info))
+ end (move-marker end (nth 1 info))
+ msg (if allow-write-back-p
+ (substitute-command-keys
+ "Edit, then exit with C-c ' (C-c and single quote)")
+ "Exit with C-c ' (C-c and single quote)")
+ code (or code (buffer-substring-no-properties beg end))
+ lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
+ (nth 2 info))
+ lang (if (symbolp lang) (symbol-name lang) lang)
+ single (nth 3 info)
+ block-nindent (nth 5 info)
+ lang-f (intern (concat lang "-mode"))
+ begline (save-excursion (goto-char beg) (org-current-line))
+ transmitted-variables
+ `((org-edit-src-content-indentation
+ ,org-edit-src-content-indentation)
+ (org-edit-src-force-single-line ,single)
+ (org-edit-src-from-org-mode ,org-mode-p)
+ (org-edit-src-allow-write-back-p ,allow-write-back-p)
+ (org-src-preserve-indentation ,org-src-preserve-indentation)
+ (org-src-babel-info ,(org-babel-get-src-block-info 'light))
+ (org-coderef-label-format
+ ,(or (nth 4 info) org-coderef-label-format))
+ (org-edit-src-beg-marker ,beg)
+ (org-edit-src-end-marker ,end)
+ (org-edit-src-block-indentation ,block-nindent)))
+ (if (and mark (>= mark beg) (<= mark (1+ end)))
+ (save-excursion (goto-char (min mark end))
+ (setq markline (org-current-line)
+ markcol (current-column))))
+ (if (equal lang-f 'table.el-mode)
+ (setq lang-f (lambda ()
+ (text-mode)
+ (if (org-bound-and-true-p flyspell-mode)
+ (flyspell-mode -1))
+ (table-recognize)
+ (org-set-local 'org-edit-src-content-indentation 0))))
+ (unless (functionp lang-f)
+ (error "No such language mode: %s" lang-f))
+ (save-excursion
+ (if (> (point) end) (goto-char end))
+ (setq line (org-current-line)
+ col (current-column)))
+ (if (and (setq buffer (org-edit-src-find-buffer beg end))
+ (or (eq context 'save)
+ (if org-src-ask-before-returning-to-edit-buffer
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t)))
+ (org-src-switch-to-buffer buffer 'return)
+ (when buffer
+ (with-current-buffer buffer
+ (if (boundp 'org-edit-src-overlay)
+ (delete-overlay org-edit-src-overlay)))
+ (kill-buffer buffer))
+ (setq buffer (generate-new-buffer
+ (or edit-buffer-name
+ (org-src-construct-edit-buffer-name (buffer-name) lang))))
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'edit-buffer buffer)
+ (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
+ (overlay-put ovl :read-only "Leave me alone")
+ (setq transmitted-variables
+ (append transmitted-variables `((org-edit-src-overlay ,ovl))))
+ (org-src-switch-to-buffer buffer 'edit)
+ (if (eq single 'macro-definition)
+ (setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
+ (insert code)
+ (remove-text-properties (point-min) (point-max)
+ '(display nil invisible nil intangible nil))
+ (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
+ (setq total-nindent (or (org-do-remove-indentation) 0)))
+ (let ((org-inhibit-startup t))
+ (condition-case e
+ (funcall lang-f)
+ (error
+ (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
+ (dolist (pair transmitted-variables)
+ (org-set-local (car pair) (cadr pair)))
+ (if (derived-mode-p 'org-mode)
+ (progn
+ (goto-char (point-min))
+ (while (re-search-forward "^," nil t)
+ (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
+ (replace-match "")))
+ (org-strip-protective-commas (point-min) (point-max)))
+ (when markline
+ (org-goto-line (1+ (- markline begline)))
+ (org-move-to-column
+ (if org-src-preserve-indentation markcol
+ (max 0 (- markcol total-nindent))))
+ (push-mark (point) 'no-message t)
+ (setq deactivate-mark nil))
+ (org-goto-line (1+ (- line begline)))
+ (org-move-to-column
+ (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ (setq buffer-file-name nil)
+ (and org-edit-src-persistent-message
+ (org-set-local 'header-line-format msg))
+ (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
+ (when (fboundp edit-prep-func)
+ (funcall edit-prep-func full-info))))
+ t)))
+
+(defun org-edit-src-continue (e)
+ "Continue editing source blocks." ;; Fixme: be more accurate
+ (interactive "e")
+ (mouse-set-point e)
+ (let ((buf (get-char-property (point) 'edit-buffer)))
+ (if buf (org-src-switch-to-buffer buf 'continue)
+ (error "Something is wrong here"))))
+
+(defun org-src-switch-to-buffer (buffer context)
+ (case org-src-window-setup
+ ('current-window
+ (org-pop-to-buffer-same-window buffer))
+ ('other-window
+ (switch-to-buffer-other-window buffer))
+ ('other-frame
+ (case context
+ ('exit
+ (let ((frame (selected-frame)))
+ (switch-to-buffer-other-frame buffer)
+ (delete-frame frame)))
+ ('save
+ (kill-buffer (current-buffer))
+ (org-pop-to-buffer-same-window buffer))
+ (t
+ (switch-to-buffer-other-frame buffer))))
+ ('reorganize-frame
+ (if (eq context 'edit) (delete-other-windows))
+ (org-switch-to-buffer-other-window buffer)
+ (if (eq context 'exit) (delete-other-windows)))
+ ('switch-invisibly
+ (set-buffer buffer))
+ (t
+ (message "Invalid value %s for org-src-window-setup"
+ (symbol-name org-src-window-setup))
+ (org-pop-to-buffer-same-window buffer))))
+
+(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
+ "Construct the buffer name for a source editing buffer."
+ (concat "*Org Src " org-buffer-name "[ " lang " ]*"))
+
+(defun org-src-edit-buffer-p (&optional buffer)
+ "Test whether BUFFER (or the current buffer if BUFFER is nil)
+is a source block editing buffer."
+ (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
+ (and (buffer-name buffer)
+ (string-match "\\`*Org Src " (buffer-name buffer))
+ (local-variable-p 'org-edit-src-beg-marker buffer)
+ (local-variable-p 'org-edit-src-end-marker buffer))))
+
+(defun org-edit-src-find-buffer (beg end)
+ "Find a source editing buffer that is already editing the region BEG to END."
+ (catch 'exit
+ (mapc
+ (lambda (b)
+ (with-current-buffer b
+ (if (and (string-match "\\`*Org Src " (buffer-name))
+ (local-variable-p 'org-edit-src-beg-marker (current-buffer))
+ (local-variable-p 'org-edit-src-end-marker (current-buffer))
+ (equal beg org-edit-src-beg-marker)
+ (equal end org-edit-src-end-marker))
+ (throw 'exit (current-buffer)))))
+ (buffer-list))
+ nil))
+
+(defun org-edit-fixed-width-region ()
+ "Edit the fixed-width ascii drawing at point.
+This must be a region where each line starts with a colon followed by
+a space character.
+An new buffer is created and the fixed-width region is copied into it,
+and the buffer is switched into `artist-mode' for editing. When done,
+exit with \\[org-edit-src-exit]. The edited text will then replace
+the fragment in the Org-mode buffer."
+ (interactive)
+ (let ((line (org-current-line))
+ (col (current-column))
+ (case-fold-search t)
+ (msg (substitute-command-keys
+ "Edit, then exit with C-c ' (C-c and single quote)"))
+ (org-mode-p (derived-mode-p 'org-mode))
+ (beg (make-marker))
+ (end (make-marker))
+ (preserve-indentation org-src-preserve-indentation)
+ block-nindent ovl beg1 end1 code begline buffer)
+ (beginning-of-line 1)
+ (if (looking-at "[ \t]*[^:\n \t]")
+ nil
+ (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
+ (setq beg1 (point) end1 beg1)
+ (save-excursion
+ (if (re-search-backward "^[ \t]*[^: \t]" nil 'move)
+ (setq beg1 (point-at-bol 2))
+ (setq beg1 (point))))
+ (save-excursion
+ (if (re-search-forward "^[ \t]*[^: \t]" nil 'move)
+ (setq end1 (1- (match-beginning 0)))
+ (setq end1 (point))))
+ (org-goto-line line))
+ (setq beg (move-marker beg beg1)
+ end (move-marker end end1)
+ code (buffer-substring-no-properties beg end)
+ begline (save-excursion (goto-char beg) (org-current-line)))
+ (if (and (setq buffer (org-edit-src-find-buffer beg end))
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))
+ (org-pop-to-buffer-same-window buffer)
+ (when buffer
+ (with-current-buffer buffer
+ (if (boundp 'org-edit-src-overlay)
+ (delete-overlay org-edit-src-overlay)))
+ (kill-buffer buffer))
+ (setq buffer (generate-new-buffer
+ (org-src-construct-edit-buffer-name
+ (buffer-name) "Fixed Width")))
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl 'edit-buffer buffer)
+ (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
+ (overlay-put ovl :read-only "Leave me alone")
+ (org-pop-to-buffer-same-window buffer)
+ (insert code)
+ (remove-text-properties (point-min) (point-max)
+ '(display nil invisible nil intangible nil))
+ (setq block-nindent (or (org-do-remove-indentation) 0))
+ (cond
+ ((eq org-edit-fixed-width-region-mode 'artist-mode)
+ (fundamental-mode)
+ (artist-mode 1))
+ (t (funcall org-edit-fixed-width-region-mode)))
+ (set (make-local-variable 'org-edit-src-force-single-line) nil)
+ (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
+ (set (make-local-variable 'org-edit-src-picture) t)
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*: ?" nil t)
+ (replace-match ""))
+ (org-goto-line (1+ (- line begline)))
+ (org-move-to-column (max 0 (- col block-nindent 2)))
+ (org-set-local 'org-edit-src-beg-marker beg)
+ (org-set-local 'org-edit-src-end-marker end)
+ (org-set-local 'org-edit-src-overlay ovl)
+ (org-set-local 'org-edit-src-block-indentation block-nindent)
+ (org-set-local 'org-edit-src-content-indentation 0)
+ (org-set-local 'org-src-preserve-indentation nil)
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ (and org-edit-src-persistent-message
+ (org-set-local 'header-line-format msg)))
+ (message "%s" msg)
+ t)))
+
+(defun org-edit-src-find-region-and-lang ()
+ "Find the region and language for a local edit.
+Return a list with beginning and end of the region, a string representing
+the language, a switch telling if the content should be in a single line."
+ (let ((re-list
+ (append
+ org-edit-src-region-extra
+ '(
+ ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
+ ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
+ ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
+ ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
+ ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
+ ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
+ ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
+ ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2)
+ ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental")
+ ("^[ \t]*#\\+html:" "\n" "html" single-line)
+ ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html")
+ ("^[ \t]*#\\+latex:" "\n" "latex" single-line)
+ ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
+ ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
+ ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
+ ("^[ \t]*#\\+docbook:" "\n" "xml" single-line)
+ ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)"
+ "\n" "fundamental" macro-definition)
+ ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml")
+ )))
+ (pos (point))
+ re1 re2 single beg end lang lfmt match-re1 ind entry)
+ (catch 'exit
+ (while (setq entry (pop re-list))
+ (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
+ single (nth 3 entry))
+ (save-excursion
+ (if (or (looking-at re1)
+ (re-search-backward re1 nil t))
+ (progn
+ (setq match-re1 (match-string 0))
+ (setq beg (match-end 0)
+ lang (org-edit-src-get-lang lang)
+ lfmt (org-edit-src-get-label-format match-re1)
+ ind (org-edit-src-get-indentation (match-beginning 0)))
+ (if (and (re-search-forward re2 nil t)
+ (>= (match-end 0) pos))
+ (throw 'exit (list beg (match-beginning 0)
+ lang single lfmt ind))))
+ (if (or (looking-at re2)
+ (re-search-forward re2 nil t))
+ (progn
+ (setq end (match-beginning 0))
+ (if (and (re-search-backward re1 nil t)
+ (<= (match-beginning 0) pos))
+ (progn
+ (setq lfmt (org-edit-src-get-label-format
+ (match-string 0))
+ ind (org-edit-src-get-indentation
+ (match-beginning 0)))
+ (throw 'exit
+ (list (match-end 0) end
+ (org-edit-src-get-lang lang)
+ single lfmt ind)))))))))
+ (when (org-at-table.el-p)
+ (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
+ (setq beg (1+ (point-at-eol)))
+ (goto-char beg)
+ (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
+ (progn (goto-char (point-max)) (newline)))
+ (setq end (point-at-bol))
+ (setq ind (org-edit-src-get-indentation beg))
+ (throw 'exit (list beg end 'table.el nil nil ind))))))
+
+(defun org-edit-src-get-lang (lang)
+ "Extract the src language."
+ (let ((m (match-string 0)))
+ (cond
+ ((stringp lang) lang)
+ ((integerp lang) (match-string lang))
+ ((and (eq lang 'lang)
+ (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
+ (match-string 1 m))
+ ((and (eq lang 'style)
+ (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
+ (match-string 1 m))
+ (t "fundamental"))))
+
+(defun org-edit-src-get-label-format (s)
+ "Extract the label format."
+ (save-match-data
+ (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
+ (match-string 1 s))))
+
+(defun org-edit-src-get-indentation (pos)
+ "Count leading whitespace characters on line."
+ (save-match-data
+ (goto-char pos)
+ (org-get-indentation)))
+
+(defun org-add-protective-commas (beg end &optional line)
+ "Add protective commas in region.
+Return the delta in size of the region."
+ (interactive "r")
+ (let ((org-re "^\\(.\\)")
+ (other-re "^\\([*]\\|[ \t]*#\\+\\)")
+ (delta 0))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward (if (derived-mode-p 'org-mode) org-re other-re)
+ end t)
+ (if (and line (eq (org-current-line) line)) (setq delta (1+ delta)))
+ (replace-match ",\\1")))
+ delta))
+
+(defun org-edit-src-exit (&optional context)
+ "Exit special edit and protect problematic lines."
+ (interactive)
+ (unless (org-bound-and-true-p org-edit-src-from-org-mode)
+ (error "This is not a sub-editing buffer, something is wrong"))
+ (widen)
+ (let* ((beg org-edit-src-beg-marker)
+ (end org-edit-src-end-marker)
+ (ovl org-edit-src-overlay)
+ (bufstr (buffer-string))
+ (buffer (current-buffer))
+ (single (org-bound-and-true-p org-edit-src-force-single-line))
+ (macro (eq single 'macro-definition))
+ (total-nindent (+ (or org-edit-src-block-indentation 0)
+ org-edit-src-content-indentation))
+ (preserve-indentation org-src-preserve-indentation)
+ (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
+ (delta 0) code line col indent)
+ (when allow-write-back-p
+ (unless preserve-indentation (untabify (point-min) (point-max)))
+ (if org-src-strip-leading-and-trailing-blank-lines
+ (save-excursion
+ (goto-char (point-min))
+ (if (looking-at "[ \t\n]*\n") (replace-match ""))
+ (unless macro
+ (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
+ (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
+ 1
+ (org-current-line))
+ col (current-column))
+ (when allow-write-back-p
+ (when single
+ (goto-char (point-min))
+ (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
+ (goto-char (point-min))
+ (let ((cnt 0))
+ (while (re-search-forward "\n" nil t)
+ (setq cnt (1+ cnt))
+ (replace-match (if macro "\\n" " ") t t))
+ (when (and macro (> cnt 0))
+ (goto-char (point-max)) (insert "\\n")))
+ (goto-char (point-min))
+ (if (looking-at "\\s-*") (replace-match " ")))
+ (when (org-bound-and-true-p org-edit-src-from-org-mode)
+ (setq delta (+ delta (org-add-protective-commas
+ (point-min) (point-max) line))))
+ (when (org-bound-and-true-p org-edit-src-picture)
+ (setq preserve-indentation nil)
+ (untabify (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "^" nil t)
+ (replace-match ": ")))
+ (unless (or single preserve-indentation (= total-nindent 0))
+ (setq indent (make-string total-nindent ?\ ))
+ (goto-char (point-min))
+ (while (re-search-forward "^" nil t)
+ (replace-match indent)))
+ (if (org-bound-and-true-p org-edit-src-picture)
+ (setq total-nindent (+ total-nindent 2)))
+ (setq code (buffer-string))
+ (when (eq context 'save)
+ (erase-buffer)
+ (insert bufstr))
+ (set-buffer-modified-p nil))
+ (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
+ (if (eq context 'save) (save-buffer)
+ (kill-buffer buffer))
+ (goto-char beg)
+ (when allow-write-back-p
+ (delete-region beg (1- end))
+ (insert code)
+ (delete-char 1)
+ (goto-char beg)
+ (if single (just-one-space)))
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-hide-block))
+ (overlays-at (point))))
+ ;; Block is hidden; put point at start of block
+ (beginning-of-line 0)
+ ;; Block is visible, put point where it was in the code buffer
+ (org-goto-line (1- (+ (org-current-line) line)))
+ (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))
+ (unless (eq context 'save)
+ (move-marker beg nil)
+ (move-marker end nil)))
+ (unless (eq context 'save)
+ (when org-edit-src-saved-temp-window-config
+ (set-window-configuration org-edit-src-saved-temp-window-config)
+ (setq org-edit-src-saved-temp-window-config nil))))
+
+(defmacro org-src-in-org-buffer (&rest body)
+ `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
+ (save-window-excursion
+ (org-edit-src-exit 'save)
+ ,@body
+ (setq msg (current-message))
+ (if (eq org-src-window-setup 'other-frame)
+ (let ((org-src-window-setup 'current-window))
+ (org-edit-src-code 'save))
+ (org-edit-src-code 'save)))
+ (setq buffer-undo-list ul)
+ (push-mark m 'nomessage)
+ (goto-char (min p (point-max)))
+ (message (or msg ""))))
+(def-edebug-spec org-src-in-org-buffer (body))
+
+(defun org-edit-src-save ()
+ "Save parent buffer with current state source-code buffer."
+ (interactive)
+ (org-src-in-org-buffer (save-buffer)))
+
+(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang))
+
+(defun org-src-tangle (arg)
+ "Tangle the parent buffer."
+ (interactive)
+ (org-src-in-org-buffer (org-babel-tangle arg)))
+
+(defun org-src-mode-configure-edit-buffer ()
+ (when (org-bound-and-true-p org-edit-src-from-org-mode)
+ (org-add-hook 'kill-buffer-hook
+ #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
+ (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
+ (progn
+ (setq buffer-offer-save t)
+ (setq buffer-file-name
+ (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
+ "[" (buffer-name) "]"))
+ (if (featurep 'xemacs)
+ (progn
+ (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4
+ (setq write-contents-hooks '(org-edit-src-save)))
+ (setq write-contents-functions '(org-edit-src-save))))
+ (setq buffer-read-only t))))
+
+(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
+
+
+(defun org-src-associate-babel-session (info)
+ "Associate edit buffer with comint session."
+ (interactive)
+ (let ((session (cdr (assoc :session (nth 2 info)))))
+ (and session (not (string= session "none"))
+ (org-babel-comint-buffer-livep session)
+ ((lambda (f) (and (fboundp f) (funcall f session)))
+ (intern (format "org-babel-%s-associate-session" (nth 0 info)))))))
+
+(defun org-src-babel-configure-edit-buffer ()
+ (when org-src-babel-info
+ (org-src-associate-babel-session org-src-babel-info)))
+
+(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer)
+(defmacro org-src-do-at-code-block (&rest body)
+ "Execute a command from an edit buffer in the Org-mode buffer."
+ `(let ((beg-marker org-edit-src-beg-marker))
+ (if beg-marker
+ (with-current-buffer (marker-buffer beg-marker)
+ (goto-char (marker-position beg-marker))
+ ,@body))))
+(def-edebug-spec org-src-do-at-code-block (body))
+
+(defun org-src-do-key-sequence-at-code-block (&optional key)
+ "Execute key sequence at code block in the source Org buffer.
+The command bound to KEY in the Org-babel key map is executed
+remotely with point temporarily at the start of the code block in
+the Org buffer.
+
+This command is not bound to a key by default, to avoid conflicts
+with language major mode bindings. To bind it to C-c @ in all
+language major modes, you could use
+
+ (add-hook 'org-src-mode-hook
+ (lambda () (define-key org-src-mode-map \"\\C-c@\"
+ 'org-src-do-key-sequence-at-code-block)))
+
+In that case, for example, C-c @ t issued in code edit buffers
+would tangle the current Org code block, C-c @ e would execute
+the block and C-c @ h would display the other available
+Org-babel commands."
+ (interactive "kOrg-babel key: ")
+ (if (equal key (kbd "C-g")) (keyboard-quit)
+ (org-edit-src-save)
+ (org-src-do-at-code-block
+ (call-interactively
+ (lookup-key org-babel-map key)))))
+
+(defcustom org-src-tab-acts-natively nil
+ "If non-nil, the effect of TAB in a code block is as if it were
+issued in the language major mode buffer."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-babel)
+
+(defun org-src-native-tab-command-maybe ()
+ "Perform language-specific TAB action.
+Alter code block according to effect of TAB in the language major
+mode."
+ (and org-src-tab-acts-natively
+ (let ((org-src-strip-leading-and-trailing-blank-lines nil))
+ (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
+
+(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
+
+(defun org-src-font-lock-fontify-block (lang start end)
+ "Fontify code block.
+This function is called by emacs automatic fontification, as long
+as `org-src-fontify-natively' is non-nil. For manual
+fontification of code blocks see `org-src-fontify-block' and
+`org-src-fontify-buffer'"
+ (let ((lang-mode (org-src-get-lang-mode lang)))
+ (if (fboundp lang-mode)
+ (let ((string (buffer-substring-no-properties start end))
+ (modified (buffer-modified-p))
+ (org-buffer (current-buffer)) pos next)
+ (remove-text-properties start end '(face nil))
+ (with-current-buffer
+ (get-buffer-create
+ (concat " org-src-fontification:" (symbol-name lang-mode)))
+ (delete-region (point-min) (point-max))
+ (insert string " ") ;; so there's a final property change
+ (unless (eq major-mode lang-mode) (funcall lang-mode))
+ (font-lock-fontify-buffer)
+ (setq pos (point-min))
+ (while (setq next (next-single-property-change pos 'face))
+ (put-text-property
+ (+ start (1- pos)) (1- (+ start next)) 'face
+ (get-text-property pos 'face) org-buffer)
+ (setq pos next)))
+ (add-text-properties
+ start end
+ '(font-lock-fontified t fontified t font-lock-multiline t))
+ (set-buffer-modified-p modified)))))
+
+(defun org-src-fontify-block ()
+ "Fontify code block at point."
+ (interactive)
+ (save-excursion
+ (let ((org-src-fontify-natively t)
+ (info (org-edit-src-find-region-and-lang)))
+ (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
+
+(defun org-src-fontify-buffer ()
+ "Fontify all code blocks in the current buffer."
+ (interactive)
+ (org-babel-map-src-blocks nil
+ (org-src-fontify-block)))
+
+(defun org-src-get-lang-mode (lang)
+ "Return major mode that should be used for LANG.
+LANG is a string, and the returned major mode is a symbol."
+ (intern
+ (concat
+ ((lambda (l) (if (symbolp l) (symbol-name l) l))
+ (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
+
+(provide 'org-src)
+
+;;; org-src.el ends here
diff --git a/lisp/org-table.el b/lisp/org-table.el
new file mode 100644
index 0000000..3eb63b6
--- /dev/null
+++ b/lisp/org-table.el
@@ -0,0 +1,4835 @@
+;;; org-table.el --- The table editor for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the table editor and spreadsheet for Org-mode.
+
+;; Watch out: Here we are talking about two different kind of tables.
+;; Most of the code is for the tables created with the Org-mode table editor.
+;; Sometimes, we talk about tables created and edited with the table.el
+;; Emacs package. We call the former org-type tables, and the latter
+;; table.el-type tables.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org)
+
+(declare-function org-table-clean-before-export "org-exp"
+ (lines &optional maybe-quoted))
+(declare-function org-format-org-table-html "org-html" (lines &optional splice))
+(declare-function aa2u "ext:ascii-art-to-unicode" ())
+(defvar orgtbl-mode) ; defined below
+(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
+(defvar org-export-html-table-tag) ; defined in org-exp.el
+(defvar constants-unit-system)
+(defvar org-table-follow-field-mode)
+
+(defvar orgtbl-after-send-table-hook nil
+ "Hook for functions attaching to `C-c C-c', if the table is sent.
+This can be used to add additional functionality after the table is sent
+to the receiver position, otherwise, if table is not sent, the functions
+are not run.")
+
+(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
+ "Non-nil means use the optimized table editor version for `orgtbl-mode'.
+In the optimized version, the table editor takes over all simple keys that
+normally just insert a character. In tables, the characters are inserted
+in a way to minimize disturbing the table structure (i.e. in overwrite mode
+for empty fields). Outside tables, the correct binding of the keys is
+restored.
+
+The default for this option is t if the optimized version is also used in
+Org-mode. See the variable `org-enable-table-editor' for details. Changing
+this variable requires a restart of Emacs to become effective."
+ :group 'org-table
+ :type 'boolean)
+
+(defcustom orgtbl-radio-table-templates
+ '((latex-mode "% BEGIN RECEIVE ORGTBL %n
+% END RECEIVE ORGTBL %n
+\\begin{comment}
+#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0
+| | |
+\\end{comment}\n")
+ (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n
+@c END RECEIVE ORGTBL %n
+@ignore
+#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
+| | |
+@end ignore\n")
+ (html-mode "<!-- BEGIN RECEIVE ORGTBL %n -->
+<!-- END RECEIVE ORGTBL %n -->
+<!--
+#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
+| | |
+-->\n")
+ (org-mode "#+ BEGIN RECEIVE ORGTBL %n
+#+ END RECEIVE ORGTBL %n
+
+#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0
+| | |
+"))
+ "Templates for radio tables in different major modes.
+All occurrences of %n in a template will be replaced with the name of the
+table, obtained by prompting the user."
+ :group 'org-table
+ :type '(repeat
+ (list (symbol :tag "Major mode")
+ (string :tag "Format"))))
+
+(defgroup org-table-settings nil
+ "Settings for tables in Org-mode."
+ :tag "Org Table Settings"
+ :group 'org-table)
+
+(defcustom org-table-default-size "5x2"
+ "The default size for newly created tables, Columns x Rows."
+ :group 'org-table-settings
+ :type 'string)
+
+(defcustom org-table-number-regexp
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
+ "Regular expression for recognizing numbers in table columns.
+If a table column contains mostly numbers, it will be aligned to the
+right. If not, it will be aligned to the left.
+
+The default value of this option is a regular expression which allows
+anything which looks remotely like a number as used in scientific
+context. For example, all of the following will be considered a
+number:
+ 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
+
+Other options offered by the customize interface are more restrictive."
+ :group 'org-table-settings
+ :type '(choice
+ (const :tag "Positive Integers"
+ "^[0-9]+$")
+ (const :tag "Integers"
+ "^[-+]?[0-9]+$")
+ (const :tag "Floating Point Numbers"
+ "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$")
+ (const :tag "Floating Point Number or Integer"
+ "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
+ (const :tag "Exponential, Floating point, Integer"
+ "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
+ (const :tag "Very General Number-Like, including hex"
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
+ (const :tag "Very General Number-Like, including hex, allows comma as decimal mark"
+ "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
+ (string :tag "Regexp:")))
+
+(defcustom org-table-number-fraction 0.5
+ "Fraction of numbers in a column required to make the column align right.
+In a column all non-white fields are considered. If at least
+this fraction of fields is matched by `org-table-number-regexp',
+alignment to the right border applies."
+ :group 'org-table-settings
+ :type 'number)
+
+(defgroup org-table-editing nil
+ "Behavior of tables during editing in Org-mode."
+ :tag "Org Table Editing"
+ :group 'org-table)
+
+(defcustom org-table-automatic-realign t
+ "Non-nil means automatically re-align table when pressing TAB or RETURN.
+When nil, aligning is only done with \\[org-table-align], or after column
+removal/insertion."
+ :group 'org-table-editing
+ :type 'boolean)
+
+(defcustom org-table-auto-blank-field t
+ "Non-nil means automatically blank table field when starting to type into it.
+This only happens when typing immediately after a field motion
+command (TAB, S-TAB or RET).
+Only relevant when `org-enable-table-editor' is equal to `optimized'."
+ :group 'org-table-editing
+ :type 'boolean)
+
+(defcustom org-table-exit-follow-field-mode-when-leaving-table t
+ "Non-nil means automatically exit the follow mode.
+When nil, the follow mode will stay on and be active in any table
+the cursor enters. Since the table follow filed mode messes with the
+window configuration, it is not recommended to set this variable to nil,
+except maybe locally in a special file that has mostly tables with long
+fields."
+ :group 'org-table
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-table-fix-formulas-confirm nil
+ "Whether the user should confirm when Org fixes formulas."
+ :group 'org-table-editing
+ :version "24.1"
+ :type '(choice
+ (const :tag "with yes-or-no" yes-or-no-p)
+ (const :tag "with y-or-n" y-or-n-p)
+ (const :tag "no confirmation" nil)))
+(put 'org-table-fix-formulas-confirm
+ 'safe-local-variable
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
+(defcustom org-table-tab-jumps-over-hlines t
+ "Non-nil means tab in the last column of a table with jump over a hline.
+If a horizontal separator line is following the current line,
+`org-table-next-field' can either create a new row before that line, or jump
+over the line. When this option is nil, a new line will be created before
+this line."
+ :group 'org-table-editing
+ :type 'boolean)
+
+(defgroup org-table-calculation nil
+ "Options concerning tables in Org-mode."
+ :tag "Org Table Calculation"
+ :group 'org-table)
+
+(defcustom org-table-use-standard-references 'from
+ "Should org-mode work with table references like B3 instead of @3$2?
+Possible values are:
+nil never use them
+from accept as input, do not present for editing
+t accept as input and present for editing"
+ :group 'org-table-calculation
+ :type '(choice
+ (const :tag "Never, don't even check user input for them" nil)
+ (const :tag "Always, both as user input, and when editing" t)
+ (const :tag "Convert user input, don't offer during editing" from)))
+
+(defcustom org-table-copy-increment t
+ "Non-nil means increment when copying current field with \\[org-table-copy-down]."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-calc-default-modes
+ '(calc-internal-prec 12
+ calc-float-format (float 8)
+ calc-angle-mode deg
+ calc-prefer-frac nil
+ calc-symbolic-mode nil
+ calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
+ calc-display-working-message t
+ )
+ "List with Calc mode settings for use in `calc-eval' for table formulas.
+The list must contain alternating symbols (Calc modes variables and values).
+Don't remove any of the default settings, just change the values. Org-mode
+relies on the variables to be present in the list."
+ :group 'org-table-calculation
+ :type 'plist)
+
+(defcustom org-table-duration-custom-format 'hours
+ "Format for the output of calc computations like $1+$2;t.
+The default value is 'hours, and will output the results as a
+number of hours. Other allowed values are 'seconds, 'minutes and
+'days, and the output will be a fraction of seconds, minutes or
+days."
+ :group 'org-table-calculation
+ :version "24.1"
+ :type '(choice (symbol :tag "Seconds" 'seconds)
+ (symbol :tag "Minutes" 'minutes)
+ (symbol :tag "Hours " 'hours)
+ (symbol :tag "Days " 'days)))
+
+(defcustom org-table-formula-field-format "%s"
+ "Format for fields which contain the result of a formula.
+For example, using \"~%s~\" will display the result within tilde
+characters. Beware that modifying the display can prevent the
+field from being used in another formula."
+ :group 'org-table-settings
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-table-formula-evaluate-inline t
+ "Non-nil means TAB and RET evaluate a formula in current table field.
+If the current field starts with an equal sign, it is assumed to be a formula
+which should be evaluated as described in the manual and in the documentation
+string of the command `org-table-eval-formula'. This feature requires the
+Emacs calc package.
+When this variable is nil, formula calculation is only available through
+the command \\[org-table-eval-formula]."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-table-formula-use-constants t
+ "Non-nil means interpret constants in formulas in tables.
+A constant looks like `$c' or `$Grav' and will be replaced before evaluation
+by the value given in `org-table-formula-constants', or by a value obtained
+from the `constants.el' package."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-table-formula-constants nil
+ "Alist with constant names and values, for use in table formulas.
+The car of each element is a name of a constant, without the `$' before it.
+The cdr is the value as a string. For example, if you'd like to use the
+speed of light in a formula, you would configure
+
+ (setq org-table-formula-constants '((\"c\" . \"299792458.\")))
+
+and then use it in an equation like `$1*$c'.
+
+Constants can also be defined on a per-file basis using a line like
+
+#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6"
+ :group 'org-table-calculation
+ :type '(repeat
+ (cons (string :tag "name")
+ (string :tag "value"))))
+
+(defcustom org-table-allow-automatic-line-recalculation t
+ "Non-nil means lines marked with |#| or |*| will be recomputed automatically.
+Automatically means when TAB or RET or C-c C-c are pressed in the line."
+ :group 'org-table-calculation
+ :type 'boolean)
+
+(defcustom org-table-error-on-row-ref-crossing-hline t
+ "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'."
+ :group 'org-table
+ :type 'boolean)
+
+(defcustom org-table-relative-ref-may-cross-hline t
+ "Non-nil means relative formula references may cross hlines.
+Here are the allowed values:
+
+nil Relative references may not cross hlines. They will reference the
+ field next to the hline instead. Coming from below, the reference
+ will be to the field below the hline. Coming from above, it will be
+ to the field above.
+t Relative references may cross hlines.
+error An attempt to cross a hline will throw an error.
+
+It is probably good to never set this variable to nil, for the sake of
+portability of tables."
+ :group 'org-table-calculation
+ :type '(choice
+ (const :tag "Allow to cross" t)
+ (const :tag "Stick to hline" nil)
+ (const :tag "Error on attempt to cross" error)))
+
+(defgroup org-table-import-export nil
+ "Options concerning table import and export in Org-mode."
+ :tag "Org Table Import Export"
+ :group 'org-table)
+
+(defcustom org-table-export-default-format "orgtbl-to-tsv"
+ "Default export parameters for `org-table-export'.
+These can be overridden for a specific table by setting the
+TABLE_EXPORT_FORMAT property. See the manual section on orgtbl
+radio tables for the different export transformations and
+available parameters."
+ :group 'org-table-import-export
+ :type 'string)
+
+(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
+ "Detects a table line marked for automatic recalculation.")
+(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
+ "Detects a table line marked for automatic recalculation.")
+(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
+ "Detects a table line marked for automatic recalculation.")
+(defconst org-table-border-regexp "^[ \t]*[^| \t]"
+ "Searching from within a table (any type) this finds the first line outside the table.")
+(defvar org-table-last-highlighted-reference nil)
+(defvar org-table-formula-history nil)
+
+(defvar org-table-column-names nil
+ "Alist with column names, derived from the `!' line.")
+(defvar org-table-column-name-regexp nil
+ "Regular expression matching the current column names.")
+(defvar org-table-local-parameters nil
+ "Alist with parameter names, derived from the `$' line.")
+(defvar org-table-named-field-locations nil
+ "Alist with locations of named fields.")
+
+(defvar org-table-current-line-types nil
+ "Table row types, non-nil only for the duration of a command.")
+(defvar org-table-current-begin-line nil
+ "Table begin line, non-nil only for the duration of a command.")
+(defvar org-table-current-begin-pos nil
+ "Table begin position, non-nil only for the duration of a command.")
+(defvar org-table-current-ncol nil
+ "Number of columns in table, non-nil only for the duration of a command.")
+(defvar org-table-dlines nil
+ "Vector of data line line numbers in the current table.")
+(defvar org-table-hlines nil
+ "Vector of hline line numbers in the current table.")
+
+(defconst org-table-range-regexp
+ "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
+ ;; 1 2 3 4 5
+ "Regular expression for matching ranges in formulas.")
+
+(defconst org-table-range-regexp2
+ (concat
+ "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)"
+ "\\.\\."
+ "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
+ "Match a range for reference display.")
+
+(defun org-table-colgroup-line-p (line)
+ "Is this a table line colgroup information?"
+ (save-match-data
+ (and (string-match "[<>]\\|&[lg]t;" line)
+ (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'"
+ line)
+ (not (delq
+ nil
+ (mapcar
+ (lambda (s)
+ (not (member s '("" "<" ">" "<>" "&lt;" "&gt;" "&lt;&gt;"))))
+ (org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
+
+(defun org-table-cookie-line-p (line)
+ "Is this a table line with only alignment/width cookies?"
+ (save-match-data
+ (and (string-match "[<>]\\|&[lg]t;" line)
+ (or (string-match
+ "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line)
+ (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line))
+ (not (delq nil (mapcar
+ (lambda (s)
+ (not (or (equal s "")
+ (string-match
+ "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s)
+ (string-match
+ "\\`&lt;\\([lrc]?[0-9]+\\|[lrc]\\)&gt;\\'"
+ s))))
+ (org-split-string (match-string 1 line)
+ "[ \t]*|[ \t]*")))))))
+
+(defconst org-table-translate-regexp
+ (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
+ "Match a reference that needs translation, for reference display.")
+
+(defun org-table-create-with-table.el ()
+ "Use the table.el package to insert a new table.
+If there is already a table at point, convert between Org-mode tables
+and table.el tables."
+ (interactive)
+ (require 'table)
+ (cond
+ ((org-at-table.el-p)
+ (if (y-or-n-p "Convert table to Org-mode table? ")
+ (org-table-convert)))
+ ((org-at-table-p)
+ (when (y-or-n-p "Convert table to table.el table? ")
+ (org-table-align)
+ (org-table-convert)))
+ (t (call-interactively 'table-insert))))
+
+(defun org-table-create-or-convert-from-region (arg)
+ "Convert region to table, or create an empty table.
+If there is an active region, convert it to a table, using the function
+`org-table-convert-region'. See the documentation of that function
+to learn how the prefix argument is interpreted to determine the field
+separator.
+If there is no such region, create an empty table with `org-table-create'."
+ (interactive "P")
+ (if (org-region-active-p)
+ (org-table-convert-region (region-beginning) (region-end) arg)
+ (org-table-create arg)))
+
+(defun org-table-create (&optional size)
+ "Query for a size and insert a table skeleton.
+SIZE is a string Columns x Rows like for example \"3x2\"."
+ (interactive "P")
+ (unless size
+ (setq size (read-string
+ (concat "Table size Columns x Rows [e.g. "
+ org-table-default-size "]: ")
+ "" nil org-table-default-size)))
+
+ (let* ((pos (point))
+ (indent (make-string (current-column) ?\ ))
+ (split (org-split-string size " *x *"))
+ (rows (string-to-number (nth 1 split)))
+ (columns (string-to-number (car split)))
+ (line (concat (apply 'concat indent "|" (make-list columns " |"))
+ "\n")))
+ (if (string-match "^[ \t]*$" (buffer-substring-no-properties
+ (point-at-bol) (point)))
+ (beginning-of-line 1)
+ (newline))
+ ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
+ (dotimes (i rows) (insert line))
+ (goto-char pos)
+ (if (> rows 1)
+ ;; Insert a hline after the first row.
+ (progn
+ (end-of-line 1)
+ (insert "\n|-")
+ (goto-char pos)))
+ (org-table-align)))
+
+(defun org-table-convert-region (beg0 end0 &optional separator)
+ "Convert region to a table.
+The region goes from BEG0 to END0, but these borders will be moved
+slightly, to make sure a beginning of line in the first line is included.
+
+SEPARATOR specifies the field separator in the lines. It can have the
+following values:
+
+'(4) Use the comma as a field separator
+'(16) Use a TAB as field separator
+integer When a number, use that many spaces as field separator
+nil When nil, the command tries to be smart and figure out the
+ separator in the following way:
+ - when each line contains a TAB, assume TAB-separated material
+ - when each line contains a comma, assume CSV material
+ - else, assume one or more SPACE characters as separator."
+ (interactive "rP")
+ (let* ((beg (min beg0 end0))
+ (end (max beg0 end0))
+ re)
+ (goto-char beg)
+ (beginning-of-line 1)
+ (setq beg (move-marker (make-marker) (point)))
+ (goto-char end)
+ (if (bolp) (backward-char 1) (end-of-line 1))
+ (setq end (move-marker (make-marker) (point)))
+ ;; Get the right field separator
+ (unless separator
+ (goto-char beg)
+ (setq separator
+ (cond
+ ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
+ ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
+ (t 1))))
+ (goto-char beg)
+ (if (equal separator '(4))
+ (while (< (point) end)
+ ;; parse the csv stuff
+ (cond
+ ((looking-at "^") (insert "| "))
+ ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
+ ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
+ (replace-match "\\1")
+ (if (looking-at "\"") (insert "\"")))
+ ((looking-at "[^,\n]+") (goto-char (match-end 0)))
+ ((looking-at "[ \t]*,") (replace-match " | "))
+ (t (beginning-of-line 2))))
+ (setq re (cond
+ ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
+ ((equal separator '(16)) "^\\|\t")
+ ((integerp separator)
+ (if (< separator 1)
+ (error "Number of spaces in separator must be >= 1")
+ (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
+ (t (error "This should not happen"))))
+ (while (re-search-forward re end t)
+ (replace-match "| " t t)))
+ (goto-char beg)
+ (org-table-align)))
+
+(defun org-table-import (file arg)
+ "Import FILE as a table.
+The file is assumed to be tab-separated. Such files can be produced by most
+spreadsheet and database applications. If no tabs (at least one per line)
+are found, lines will be split on whitespace into fields."
+ (interactive "f\nP")
+ (or (bolp) (newline))
+ (let ((beg (point))
+ (pm (point-max)))
+ (insert-file-contents file)
+ (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
+
+
+(defvar org-table-last-alignment)
+(defvar org-table-last-column-widths)
+(defun org-table-export (&optional file format)
+ "Export table to a file, with configurable format.
+Such a file can be imported into usual spreadsheet programs.
+
+FILE can be the output file name. If not given, it will be taken
+from a TABLE_EXPORT_FILE property in the current entry or higher
+up in the hierarchy, or the user will be prompted for a file
+name. FORMAT can be an export format, of the same kind as it
+used when `orgtbl-mode' sends a table in a different format.
+
+The command suggests a format depending on TABLE_EXPORT_FORMAT,
+whether it is set locally or up in the hierarchy, then on the
+extension of the given file name, and finally on the variable
+`org-table-export-default-format'."
+ (interactive)
+ (unless (org-at-table-p)
+ (error "No table at point"))
+ (require 'org-exp)
+ (org-table-align) ;; make sure we have everything we need
+ (let* ((beg (org-table-begin))
+ (end (org-table-end))
+ (txt (buffer-substring-no-properties beg end))
+ (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
+ (formats '("orgtbl-to-tsv" "orgtbl-to-csv"
+ "orgtbl-to-latex" "orgtbl-to-html"
+ "orgtbl-to-generic" "orgtbl-to-texinfo"
+ "orgtbl-to-orgtbl"))
+ (format (or format
+ (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
+ buf deffmt-readable fileext)
+ (unless file
+ (setq file (read-file-name "Export table to: "))
+ (unless (or (not (file-exists-p file))
+ (y-or-n-p (format "Overwrite file %s? " file)))
+ (error "Abort")))
+ (if (file-directory-p file)
+ (error "This is a directory path, not a file"))
+ (if (and (buffer-file-name)
+ (equal (file-truename file)
+ (file-truename (buffer-file-name))))
+ (error "Please specify a file name that is different from current"))
+ (setq fileext (concat (file-name-extension file) "$"))
+ (unless format
+ (setq deffmt-readable
+ (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats)))
+ org-table-export-default-format))
+ (while (string-match "\t" deffmt-readable)
+ (setq deffmt-readable (replace-match "\\t" t t deffmt-readable)))
+ (while (string-match "\n" deffmt-readable)
+ (setq deffmt-readable (replace-match "\\n" t t deffmt-readable)))
+ (setq format (org-completing-read "Format: " formats nil nil deffmt-readable)))
+ (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
+ (let* ((transform (intern (match-string 1 format)))
+ (params (if (match-end 2)
+ (read (concat "(" (match-string 2 format) ")"))))
+ (skip (plist-get params :skip))
+ (skipcols (plist-get params :skipcols))
+ (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))
+ (lines (org-table-clean-before-export lines))
+ (i0 (if org-table-clean-did-remove-column 2 1))
+ (table (mapcar
+ (lambda (x)
+ (if (string-match org-table-hline-regexp x)
+ 'hline
+ (org-remove-by-index
+ (org-split-string (org-trim x) "\\s-*|\\s-*")
+ skipcols i0)))
+ lines))
+ (fun (if (= i0 2) 'cdr 'identity))
+ (org-table-last-alignment
+ (org-remove-by-index (funcall fun org-table-last-alignment)
+ skipcols i0))
+ (org-table-last-column-widths
+ (org-remove-by-index (funcall fun org-table-last-column-widths)
+ skipcols i0)))
+
+ (unless (fboundp transform)
+ (error "No such transformation function %s" transform))
+ (setq txt (funcall transform table params))
+
+ (with-current-buffer (find-file-noselect file)
+ (setq buf (current-buffer))
+ (erase-buffer)
+ (fundamental-mode)
+ (insert txt "\n")
+ (save-buffer))
+ (kill-buffer buf)
+ (message "Export done."))
+ (error "TABLE_EXPORT_FORMAT invalid"))))
+
+(defvar org-table-aligned-begin-marker (make-marker)
+ "Marker at the beginning of the table last aligned.
+Used to check if cursor still is in that table, to minimize realignment.")
+(defvar org-table-aligned-end-marker (make-marker)
+ "Marker at the end of the table last aligned.
+Used to check if cursor still is in that table, to minimize realignment.")
+(defvar org-table-last-alignment nil
+ "List of flags for flushright alignment, from the last re-alignment.
+This is being used to correctly align a single field after TAB or RET.")
+(defvar org-table-last-column-widths nil
+ "List of max width of fields in each column.
+This is being used to correctly align a single field after TAB or RET.")
+(defvar org-table-formula-debug nil
+ "Non-nil means debug table formulas.
+When nil, simply write \"#ERROR\" in corrupted fields.")
+(make-variable-buffer-local 'org-table-formula-debug)
+(defvar org-table-overlay-coordinates nil
+ "Overlay coordinates after each align of a table.")
+(make-variable-buffer-local 'org-table-overlay-coordinates)
+
+(defvar org-last-recalc-line nil)
+(defvar org-table-do-narrow t) ; for dynamic scoping
+(defconst org-narrow-column-arrow "=>"
+ "Used as display property in narrowed table columns.")
+
+(defun org-table-align ()
+ "Align the table at point by aligning all vertical bars."
+ (interactive)
+ (let* (
+ ;; Limits of table
+ (beg (org-table-begin))
+ (end (org-table-end))
+ ;; Current cursor position
+ (linepos (org-current-line))
+ (colpos (org-table-current-column))
+ (winstart (window-start))
+ (winstartline (org-current-line (min winstart (1- (point-max)))))
+ lines (new "") lengths l typenums ty fields maxfields i
+ column
+ (indent "") cnt frac
+ rfmt hfmt
+ (spaces '(1 . 1))
+ (sp1 (car spaces))
+ (sp2 (cdr spaces))
+ (rfmt1 (concat
+ (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
+ (hfmt1 (concat
+ (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
+ emptystrings links dates emph raise narrow
+ falign falign1 fmax f1 len c e space)
+ (untabify beg end)
+ (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
+ ;; Check if we have links or dates
+ (goto-char beg)
+ (setq links (re-search-forward org-bracket-link-regexp end t))
+ (goto-char beg)
+ (setq emph (and org-hide-emphasis-markers
+ (re-search-forward org-emph-re end t)))
+ (goto-char beg)
+ (setq raise (and org-use-sub-superscripts
+ (re-search-forward org-match-substring-regexp end t)))
+ (goto-char beg)
+ (setq dates (and org-display-custom-times
+ (re-search-forward org-ts-regexp-both end t)))
+ ;; Make sure the link properties are right
+ (when links (goto-char beg) (while (org-activate-bracket-links end)))
+ ;; Make sure the date properties are right
+ (when dates (goto-char beg) (while (org-activate-dates end)))
+ (when emph (goto-char beg) (while (org-do-emphasis-faces end)))
+ (when raise (goto-char beg) (while (org-raise-scripts end)))
+
+ ;; Check if we are narrowing any columns
+ (goto-char beg)
+ (setq narrow (and org-table-do-narrow
+ org-format-transports-properties-p
+ (re-search-forward "<[lrc]?[0-9]+>" end t)))
+ (goto-char beg)
+ (setq falign (re-search-forward "<[lrc][0-9]*>" end t))
+ (goto-char beg)
+ ;; Get the rows
+ (setq lines (org-split-string
+ (buffer-substring beg end) "\n"))
+ ;; Store the indentation of the first line
+ (if (string-match "^ *" (car lines))
+ (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
+ ;; Mark the hlines by setting the corresponding element to nil
+ ;; At the same time, we remove trailing space.
+ (setq lines (mapcar (lambda (l)
+ (if (string-match "^ *|-" l)
+ nil
+ (if (string-match "[ \t]+$" l)
+ (substring l 0 (match-beginning 0))
+ l)))
+ lines))
+ ;; Get the data fields by splitting the lines.
+ (setq fields (mapcar
+ (lambda (l)
+ (org-split-string l " *| *"))
+ (delq nil (copy-sequence lines))))
+ ;; How many fields in the longest line?
+ (condition-case nil
+ (setq maxfields (apply 'max (mapcar 'length fields)))
+ (error
+ (kill-region beg end)
+ (org-table-create org-table-default-size)
+ (error "Empty table - created default table")))
+ ;; A list of empty strings to fill any short rows on output
+ (setq emptystrings (make-list maxfields ""))
+ ;; Check for special formatting.
+ (setq i -1)
+ (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
+ (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
+ ;; Check if there is an explicit width specified
+ (setq fmax nil)
+ (when (or narrow falign)
+ (setq c column fmax nil falign1 nil)
+ (while c
+ (setq e (pop c))
+ (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
+ (if (match-end 1) (setq falign1 (match-string 1 e)))
+ (if (and org-table-do-narrow (match-end 2))
+ (setq fmax (string-to-number (match-string 2 e)) c nil))))
+ ;; Find fields that are wider than fmax, and shorten them
+ (when fmax
+ (loop for xx in column do
+ (when (and (stringp xx)
+ (> (org-string-width xx) fmax))
+ (org-add-props xx nil
+ 'help-echo
+ (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
+ (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
+ (unless (> f1 1)
+ (error "Cannot narrow field starting with wide link \"%s\""
+ (match-string 0 xx)))
+ (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
+ (add-text-properties (- f1 2) f1
+ (list 'display org-narrow-column-arrow)
+ xx)))))
+ ;; Get the maximum width for each column
+ (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column))
+ lengths)
+ ;; Get the fraction of numbers, to decide about alignment of the column
+ (if falign1
+ (push (equal (downcase falign1) "r") typenums)
+ (setq cnt 0 frac 0.0)
+ (loop for x in column do
+ (if (equal x "")
+ nil
+ (setq frac ( / (+ (* frac cnt)
+ (if (string-match org-table-number-regexp x) 1 0))
+ (setq cnt (1+ cnt))))))
+ (push (>= frac org-table-number-fraction) typenums)))
+ (setq lengths (nreverse lengths) typenums (nreverse typenums))
+
+ ;; Store the alignment of this table, for later editing of single fields
+ (setq org-table-last-alignment typenums
+ org-table-last-column-widths lengths)
+
+ ;; With invisible characters, `format' does not get the field width right
+ ;; So we need to make these fields wide by hand.
+ (when (or links emph raise)
+ (loop for i from 0 upto (1- maxfields) do
+ (setq len (nth i lengths))
+ (loop for j from 0 upto (1- (length fields)) do
+ (setq c (nthcdr i (car (nthcdr j fields))))
+ (if (and (stringp (car c))
+ (or (text-property-any 0 (length (car c))
+ 'invisible 'org-link (car c))
+ (text-property-any 0 (length (car c))
+ 'org-dwidth t (car c)))
+ (< (org-string-width (car c)) len))
+ (progn
+ (setq space (make-string (- len (org-string-width (car c))) ?\ ))
+ (setcar c (if (nth i typenums)
+ (concat space (car c))
+ (concat (car c) space))))))))
+
+ ;; Compute the formats needed for output of the table
+ (setq rfmt (concat indent "|") hfmt (concat indent "|"))
+ (while (setq l (pop lengths))
+ (setq ty (if (pop typenums) "" "-")) ; number types flushright
+ (setq rfmt (concat rfmt (format rfmt1 ty l))
+ hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
+ (setq rfmt (concat rfmt "\n")
+ hfmt (concat (substring hfmt 0 -1) "|\n"))
+
+ (setq new (mapconcat
+ (lambda (l)
+ (if l (apply 'format rfmt
+ (append (pop fields) emptystrings))
+ hfmt))
+ lines ""))
+ (move-marker org-table-aligned-begin-marker (point))
+ (insert new)
+ ;; Replace the old one
+ (delete-region (point) end)
+ (move-marker end nil)
+ (move-marker org-table-aligned-end-marker (point))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
+ (goto-char org-table-aligned-begin-marker)
+ (while (org-hide-wide-columns org-table-aligned-end-marker)))
+ ;; Try to move to the old location
+ (org-goto-line winstartline)
+ (setq winstart (point-at-bol))
+ (org-goto-line linepos)
+ (set-window-start (selected-window) winstart 'noforce)
+ (org-table-goto-column colpos)
+ (and org-table-overlay-coordinates (org-table-overlay-coordinates))
+ (setq org-table-may-need-update nil)
+ ))
+
+(defun org-table-begin (&optional table-type)
+ "Find the beginning of the table and return its position.
+With argument TABLE-TYPE, go to the beginning of a table.el-type table."
+ (save-excursion
+ (if (not (re-search-backward
+ (if table-type org-table-any-border-regexp
+ org-table-border-regexp)
+ nil t))
+ (progn (goto-char (point-min)) (point))
+ (goto-char (match-beginning 0))
+ (beginning-of-line 2)
+ (point))))
+
+(defun org-table-end (&optional table-type)
+ "Find the end of the table and return its position.
+With argument TABLE-TYPE, go to the end of a table.el-type table."
+ (save-excursion
+ (if (not (re-search-forward
+ (if table-type org-table-any-border-regexp
+ org-table-border-regexp)
+ nil t))
+ (goto-char (point-max))
+ (goto-char (match-beginning 0)))
+ (point-marker)))
+
+(defun org-table-justify-field-maybe (&optional new)
+ "Justify the current field, text to left, number to right.
+Optional argument NEW may specify text to replace the current field content."
+ (cond
+ ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
+ ((org-at-table-hline-p))
+ ((and (not new)
+ (or (not (equal (marker-buffer org-table-aligned-begin-marker)
+ (current-buffer)))
+ (< (point) org-table-aligned-begin-marker)
+ (>= (point) org-table-aligned-end-marker)))
+ ;; This is not the same table, force a full re-align
+ (setq org-table-may-need-update t))
+ (t ;; realign the current field, based on previous full realign
+ (let* ((pos (point)) s
+ (col (org-table-current-column))
+ (num (if (> col 0) (nth (1- col) org-table-last-alignment)))
+ l f n o e)
+ (when (> col 0)
+ (skip-chars-backward "^|\n")
+ (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
+ (progn
+ (setq s (match-string 1)
+ o (match-string 0)
+ l (max 1 (- (match-end 0) (match-beginning 0) 3))
+ e (not (= (match-beginning 2) (match-end 2))))
+ (setq f (format (if num " %%%ds %s" " %%-%ds %s")
+ l (if e "|" (setq org-table-may-need-update t) ""))
+ n (format f s))
+ (if new
+ (if (<= (length new) l) ;; FIXME: length -> str-width?
+ (setq n (format f new))
+ (setq n (concat new "|") org-table-may-need-update t)))
+ (if (equal (string-to-char n) ?-) (setq n (concat " " n)))
+ (or (equal n o)
+ (let (org-table-may-need-update)
+ (replace-match n t t))))
+ (setq org-table-may-need-update t))
+ (goto-char pos))))))
+
+(defun org-table-next-field ()
+ "Go to the next field in the current table, creating new lines as needed.
+Before doing so, re-align the table if necessary."
+ (interactive)
+ (org-table-maybe-eval-formula)
+ (org-table-maybe-recalculate-line)
+ (if (and org-table-automatic-realign
+ org-table-may-need-update)
+ (org-table-align))
+ (let ((end (org-table-end)))
+ (if (org-at-table-hline-p)
+ (end-of-line 1))
+ (condition-case nil
+ (progn
+ (re-search-forward "|" end)
+ (if (looking-at "[ \t]*$")
+ (re-search-forward "|" end))
+ (if (and (looking-at "-")
+ org-table-tab-jumps-over-hlines
+ (re-search-forward "^[ \t]*|\\([^-]\\)" end t))
+ (goto-char (match-beginning 1)))
+ (if (looking-at "-")
+ (progn
+ (beginning-of-line 0)
+ (org-table-insert-row 'below))
+ (if (looking-at " ") (forward-char 1))))
+ (error
+ (org-table-insert-row 'below)))))
+
+(defun org-table-previous-field ()
+ "Go to the previous field in the table.
+Before doing so, re-align the table if necessary."
+ (interactive)
+ (org-table-justify-field-maybe)
+ (org-table-maybe-recalculate-line)
+ (if (and org-table-automatic-realign
+ org-table-may-need-update)
+ (org-table-align))
+ (if (org-at-table-hline-p)
+ (end-of-line 1))
+ (condition-case nil
+ (progn
+ (re-search-backward "|" (org-table-begin))
+ (re-search-backward "|" (org-table-begin)))
+ (error (error "Cannot move to previous table field")))
+ (while (looking-at "|\\(-\\|[ \t]*$\\)")
+ (re-search-backward "|" (org-table-begin)))
+ (if (looking-at "| ?")
+ (goto-char (match-end 0))))
+
+(defun org-table-beginning-of-field (&optional n)
+ "Move to the end of the current table field.
+If already at or after the end, move to the end of the next table field.
+With numeric argument N, move N-1 fields forward first."
+ (interactive "p")
+ (let ((pos (point)))
+ (while (> n 1)
+ (setq n (1- n))
+ (org-table-previous-field))
+ (if (not (re-search-backward "|" (point-at-bol 0) t))
+ (error "No more table fields before the current")
+ (goto-char (match-end 0))
+ (and (looking-at " ") (forward-char 1)))
+ (if (>= (point) pos) (org-table-beginning-of-field 2))))
+
+(defun org-table-end-of-field (&optional n)
+ "Move to the beginning of the current table field.
+If already at or before the beginning, move to the beginning of the
+previous field.
+With numeric argument N, move N-1 fields backward first."
+ (interactive "p")
+ (let ((pos (point)))
+ (while (> n 1)
+ (setq n (1- n))
+ (org-table-next-field))
+ (when (re-search-forward "|" (point-at-eol 1) t)
+ (backward-char 1)
+ (skip-chars-backward " ")
+ (if (and (equal (char-before (point)) ?|) (looking-at " "))
+ (forward-char 1)))
+ (if (<= (point) pos) (org-table-end-of-field 2))))
+
+(defun org-table-next-row ()
+ "Go to the next row (same column) in the current table.
+Before doing so, re-align the table if necessary."
+ (interactive)
+ (org-table-maybe-eval-formula)
+ (org-table-maybe-recalculate-line)
+ (if (or (looking-at "[ \t]*$")
+ (save-excursion (skip-chars-backward " \t") (bolp)))
+ (newline)
+ (if (and org-table-automatic-realign
+ org-table-may-need-update)
+ (org-table-align))
+ (let ((col (org-table-current-column)))
+ (beginning-of-line 2)
+ (if (or (not (org-at-table-p))
+ (org-at-table-hline-p))
+ (progn
+ (beginning-of-line 0)
+ (org-table-insert-row 'below)))
+ (org-table-goto-column col)
+ (skip-chars-backward "^|\n\r")
+ (if (looking-at " ") (forward-char 1)))))
+
+(defun org-table-copy-down (n)
+ "Copy a field down in the current column.
+If the field at the cursor is empty, copy into it the content of
+the nearest non-empty field above. With argument N, use the Nth
+non-empty field. If the current field is not empty, it is copied
+down to the next row, and the cursor is moved with it.
+Therefore, repeating this command causes the column to be filled
+row-by-row.
+If the variable `org-table-copy-increment' is non-nil and the
+field is an integer or a timestamp, it will be incremented while
+copying. In the case of a timestamp, increment by one day."
+ (interactive "p")
+ (let* ((colpos (org-table-current-column))
+ (col (current-column))
+ (field (org-table-get-field))
+ (non-empty (string-match "[^ \t]" field))
+ (beg (org-table-begin))
+ (orig-n n)
+ txt)
+ (org-table-check-inside-data-field)
+ (if non-empty
+ (progn
+ (setq txt (org-trim field))
+ (org-table-next-row)
+ (org-table-blank-field))
+ (save-excursion
+ (setq txt
+ (catch 'exit
+ (while (progn (beginning-of-line 1)
+ (re-search-backward org-table-dataline-regexp
+ beg t))
+ (org-table-goto-column colpos t)
+ (if (and (looking-at
+ "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
+ (<= (setq n (1- n)) 0))
+ (throw 'exit (match-string 1))))))))
+ (if txt
+ (progn
+ (if (and org-table-copy-increment
+ (not (equal orig-n 0))
+ (string-match "^[0-9]+$" txt)
+ (< (string-to-number txt) 100000000))
+ (setq txt (format "%d" (+ (string-to-number txt) 1))))
+ (insert txt)
+ (org-move-to-column col)
+ (if (and org-table-copy-increment (org-at-timestamp-p t))
+ (org-timestamp-up-day)
+ (org-table-maybe-recalculate-line))
+ (org-table-align)
+ (org-move-to-column col))
+ (error "No non-empty field found"))))
+
+(defun org-table-check-inside-data-field (&optional noerror)
+ "Is point inside a table data field?
+I.e. not on a hline or before the first or after the last column?
+This actually throws an error, so it aborts the current command."
+ (if (or (not (org-at-table-p))
+ (= (org-table-current-column) 0)
+ (org-at-table-hline-p)
+ (looking-at "[ \t]*$"))
+ (if noerror
+ nil
+ (error "Not in table data field"))
+ t))
+
+(defvar org-table-clip nil
+ "Clipboard for table regions.")
+
+(defun org-table-get (line column)
+ "Get the field in table line LINE, column COLUMN.
+If LINE is larger than the number of data lines in the table, the function
+returns nil. However, if COLUMN is too large, we will simply return an
+empty string.
+If LINE is nil, use the current line.
+If column is nil, use the current column."
+ (setq column (or column (org-table-current-column)))
+ (save-excursion
+ (and (or (not line) (org-table-goto-line line))
+ (org-trim (org-table-get-field column)))))
+
+(defun org-table-put (line column value &optional align)
+ "Put VALUE into line LINE, column COLUMN.
+When ALIGN is set, also realign the table."
+ (setq column (or column (org-table-current-column)))
+ (prog1 (save-excursion
+ (and (or (not line) (org-table-goto-line line))
+ (progn (org-table-goto-column column nil 'force) t)
+ (org-table-get-field column value)))
+ (and align (org-table-align))))
+
+(defun org-table-current-line ()
+ "Return the index of the current data line."
+ (let ((pos (point)) (end (org-table-end)) (cnt 0))
+ (save-excursion
+ (goto-char (org-table-begin))
+ (while (and (re-search-forward org-table-dataline-regexp end t)
+ (setq cnt (1+ cnt))
+ (< (point-at-eol) pos))))
+ cnt))
+
+(defun org-table-goto-line (N)
+ "Go to the Nth data line in the current table.
+Return t when the line exists, nil if it does not exist."
+ (goto-char (org-table-begin))
+ (let ((end (org-table-end)) (cnt 0))
+ (while (and (re-search-forward org-table-dataline-regexp end t)
+ (< (setq cnt (1+ cnt)) N)))
+ (= cnt N)))
+
+(defun org-table-blank-field ()
+ "Blank the current table field or active region."
+ (interactive)
+ (org-table-check-inside-data-field)
+ (if (and (org-called-interactively-p 'any) (org-region-active-p))
+ (let (org-table-clip)
+ (org-table-cut-region (region-beginning) (region-end)))
+ (skip-chars-backward "^|")
+ (backward-char 1)
+ (if (looking-at "|[^|\n]+")
+ (let* ((pos (match-beginning 0))
+ (match (match-string 0))
+ (len (org-string-width match)))
+ (replace-match (concat "|" (make-string (1- len) ?\ )))
+ (goto-char (+ 2 pos))
+ (substring match 1)))))
+
+(defun org-table-get-field (&optional n replace)
+ "Return the value of the field in column N of current row.
+N defaults to current field.
+If REPLACE is a string, replace field with this value. The return value
+is always the old value."
+ (and n (org-table-goto-column n))
+ (skip-chars-backward "^|\n")
+ (backward-char 1)
+ (if (looking-at "|[^|\r\n]*")
+ (let* ((pos (match-beginning 0))
+ (val (buffer-substring (1+ pos) (match-end 0))))
+ (if replace
+ (replace-match (concat "|" (if (equal replace "") " " replace))
+ t t))
+ (goto-char (min (point-at-eol) (+ 2 pos)))
+ val)
+ (forward-char 1) ""))
+
+(defun org-table-field-info (arg)
+ "Show info about the current field, and highlight any reference at point."
+ (interactive "P")
+ (org-table-get-specials)
+ (save-excursion
+ (let* ((pos (point))
+ (col (org-table-current-column))
+ (cname (car (rassoc (int-to-string col) org-table-column-names)))
+ (name (car (rassoc (list (org-current-line) col)
+ org-table-named-field-locations)))
+ (eql (org-table-expand-lhs-ranges
+ (mapcar
+ (lambda (e)
+ (cons (org-table-formula-handle-first/last-rc
+ (car e)) (cdr e)))
+ (org-table-get-stored-formulas))))
+ (dline (org-table-current-dline))
+ (ref (format "@%d$%d" dline col))
+ (ref1 (org-table-convert-refs-to-an ref))
+ (fequation (or (assoc name eql) (assoc ref eql)))
+ (cequation (assoc (int-to-string col) eql))
+ (eqn (or fequation cequation)))
+ (if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
+ (setq eqn (get-text-property 0 :orig-eqn (car eqn))))
+ (goto-char pos)
+ (condition-case nil
+ (org-table-show-reference 'local)
+ (error nil))
+ (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
+ dline col
+ (if cname (concat " or $" cname) "")
+ dline col ref1
+ (if name (concat " or $" name) "")
+ ;; FIXME: formula info not correct if special table line
+ (if eqn
+ (concat ", formula: "
+ (org-table-formula-to-user
+ (concat
+ (if (string-match "^[$@]"(car eqn)) "" "$")
+ (car eqn) "=" (cdr eqn))))
+ "")))))
+
+(defun org-table-current-column ()
+ "Find out which column we are in."
+ (interactive)
+ (if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
+ (save-excursion
+ (let ((cnt 0) (pos (point)))
+ (beginning-of-line 1)
+ (while (search-forward "|" pos t)
+ (setq cnt (1+ cnt)))
+ (when (org-called-interactively-p 'interactive)
+ (message "In table column %d" cnt))
+ cnt)))
+
+(defun org-table-current-dline ()
+ "Find out what table data line we are in.
+Only data lines count for this."
+ (interactive)
+ (when (org-called-interactively-p 'any)
+ (org-table-check-inside-data-field))
+ (save-excursion
+ (let ((cnt 0) (pos (point)))
+ (goto-char (org-table-begin))
+ (while (<= (point) pos)
+ (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
+ (beginning-of-line 2))
+ (when (org-called-interactively-p 'any)
+ (message "This is table line %d" cnt))
+ cnt)))
+
+(defun org-table-goto-column (n &optional on-delim force)
+ "Move the cursor to the Nth column in the current table line.
+With optional argument ON-DELIM, stop with point before the left delimiter
+of the field.
+If there are less than N fields, just go to after the last delimiter.
+However, when FORCE is non-nil, create new columns if necessary."
+ (interactive "p")
+ (beginning-of-line 1)
+ (when (> n 0)
+ (while (and (> (setq n (1- n)) -1)
+ (or (search-forward "|" (point-at-eol) t)
+ (and force
+ (progn (end-of-line 1)
+ (skip-chars-backward "^|")
+ (insert " | ")
+ t)))))
+ (when (and force (not (looking-at ".*|")))
+ (save-excursion (end-of-line 1) (insert " | ")))
+ (if on-delim
+ (backward-char 1)
+ (if (looking-at " ") (forward-char 1)))))
+
+(defun org-table-insert-column ()
+ "Insert a new column into the table."
+ (interactive)
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (org-table-find-dataline)
+ (let* ((col (max 1 (org-table-current-column)))
+ (beg (org-table-begin))
+ (end (org-table-end))
+ ;; Current cursor position
+ (linepos (org-current-line))
+ (colpos col))
+ (goto-char beg)
+ (while (< (point) end)
+ (if (org-at-table-hline-p)
+ nil
+ (org-table-goto-column col t)
+ (insert "| "))
+ (beginning-of-line 2))
+ (move-marker end nil)
+ (org-goto-line linepos)
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "$" nil (1- col) 1)
+ (org-table-fix-formulas "$LR" nil (1- col) 1))))
+
+(defun org-table-find-dataline ()
+ "Find a data line in the current table, which is needed for column commands."
+ (if (and (org-at-table-p)
+ (not (org-at-table-hline-p)))
+ t
+ (let ((col (current-column))
+ (end (org-table-end)))
+ (org-move-to-column col)
+ (while (and (< (point) end)
+ (or (not (= (current-column) col))
+ (org-at-table-hline-p)))
+ (beginning-of-line 2)
+ (org-move-to-column col))
+ (if (and (org-at-table-p)
+ (not (org-at-table-hline-p)))
+ t
+ (error
+ "Please position cursor in a data line for column operations")))))
+
+(defun org-table-line-to-dline (line &optional above)
+ "Turn a buffer line number into a data line number.
+If there is no data line in this line, return nil.
+If there is no matching dline (most likely te reference was a hline), the
+first dline below it is used. When ABOVE is non-nil, the one above is used."
+ (catch 'exit
+ (let ((ll (length org-table-dlines))
+ i)
+ (if above
+ (progn
+ (setq i (1- ll))
+ (while (> i 0)
+ (if (<= (aref org-table-dlines i) line)
+ (throw 'exit i))
+ (setq i (1- i))))
+ (setq i 1)
+ (while (< i ll)
+ (if (>= (aref org-table-dlines i) line)
+ (throw 'exit i))
+ (setq i (1+ i)))))
+ nil))
+
+(defun org-table-delete-column ()
+ "Delete a column from the table."
+ (interactive)
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (org-table-find-dataline)
+ (org-table-check-inside-data-field)
+ (let* ((col (org-table-current-column))
+ (beg (org-table-begin))
+ (end (org-table-end))
+ ;; Current cursor position
+ (linepos (org-current-line))
+ (colpos col))
+ (goto-char beg)
+ (while (< (point) end)
+ (if (org-at-table-hline-p)
+ nil
+ (org-table-goto-column col t)
+ (and (looking-at "|[^|\n]+|")
+ (replace-match "|")))
+ (beginning-of-line 2))
+ (move-marker end nil)
+ (org-goto-line linepos)
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID"))
+ col -1 col)
+ (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID"))
+ col -1 col))))
+
+(defun org-table-move-column-right ()
+ "Move column to the right."
+ (interactive)
+ (org-table-move-column nil))
+(defun org-table-move-column-left ()
+ "Move column to the left."
+ (interactive)
+ (org-table-move-column 'left))
+
+(defun org-table-move-column (&optional left)
+ "Move the current column to the right. With arg LEFT, move to the left."
+ (interactive "P")
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (org-table-find-dataline)
+ (org-table-check-inside-data-field)
+ (let* ((col (org-table-current-column))
+ (col1 (if left (1- col) col))
+ (beg (org-table-begin))
+ (end (org-table-end))
+ ;; Current cursor position
+ (linepos (org-current-line))
+ (colpos (if left (1- col) (1+ col))))
+ (if (and left (= col 1))
+ (error "Cannot move column further left"))
+ (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
+ (error "Cannot move column further right"))
+ (goto-char beg)
+ (while (< (point) end)
+ (if (org-at-table-hline-p)
+ nil
+ (org-table-goto-column col1 t)
+ (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
+ (replace-match "|\\2|\\1|")))
+ (beginning-of-line 2))
+ (move-marker end nil)
+ (org-goto-line linepos)
+ (org-table-goto-column colpos)
+ (org-table-align)
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas
+ "$" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col))))
+ (org-table-fix-formulas
+ "$LR" (list (cons (number-to-string col) (number-to-string colpos))
+ (cons (number-to-string colpos) (number-to-string col)))))))
+
+(defun org-table-move-row-down ()
+ "Move table row down."
+ (interactive)
+ (org-table-move-row nil))
+(defun org-table-move-row-up ()
+ "Move table row up."
+ (interactive)
+ (org-table-move-row 'up))
+
+(defun org-table-move-row (&optional up)
+ "Move the current table line down. With arg UP, move it up."
+ (interactive "P")
+ (let* ((col (current-column))
+ (pos (point))
+ (hline1p (save-excursion (beginning-of-line 1)
+ (looking-at org-table-hline-regexp)))
+ (dline1 (org-table-current-dline))
+ (dline2 (+ dline1 (if up -1 1)))
+ (tonew (if up 0 2))
+ txt hline2p)
+ (beginning-of-line tonew)
+ (unless (org-at-table-p)
+ (goto-char pos)
+ (error "Cannot move row further"))
+ (setq hline2p (looking-at org-table-hline-regexp))
+ (goto-char pos)
+ (beginning-of-line 1)
+ (setq pos (point))
+ (setq txt (buffer-substring (point) (1+ (point-at-eol))))
+ (delete-region (point) (1+ (point-at-eol)))
+ (beginning-of-line tonew)
+ (insert txt)
+ (beginning-of-line 0)
+ (org-move-to-column col)
+ (unless (or hline1p hline2p
+ (not (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
+ (org-table-fix-formulas
+ "@" (list (cons (number-to-string dline1) (number-to-string dline2))
+ (cons (number-to-string dline2) (number-to-string dline1)))))))
+
+(defun org-table-insert-row (&optional arg)
+ "Insert a new row above the current line into the table.
+With prefix ARG, insert below the current line."
+ (interactive "P")
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
+ (new (org-table-clean-line line)))
+ ;; Fix the first field if necessary
+ (if (string-match "^[ \t]*| *[#$] *|" line)
+ (setq new (replace-match (match-string 0 line) t t new)))
+ (beginning-of-line (if arg 2 1))
+ (let (org-table-may-need-update) (insert-before-markers new "\n"))
+ (beginning-of-line 0)
+ (re-search-forward "| ?" (point-at-eol) t)
+ (and (or org-table-may-need-update org-table-overlay-coordinates)
+ (org-table-align))
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
+
+(defun org-table-insert-hline (&optional above)
+ "Insert a horizontal-line below the current line into the table.
+With prefix ABOVE, insert above the current line."
+ (interactive "P")
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (when (eobp) (insert "\n") (backward-char 1))
+ (if (not (string-match "|[ \t]*$" (org-current-line-string)))
+ (org-table-align))
+ (let ((line (org-table-clean-line
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ (col (current-column)))
+ (while (string-match "|\\( +\\)|" line)
+ (setq line (replace-match
+ (concat "+" (make-string (- (match-end 1) (match-beginning 1))
+ ?-) "|") t t line)))
+ (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
+ (beginning-of-line (if above 1 2))
+ (insert line "\n")
+ (beginning-of-line (if above 1 -1))
+ (org-move-to-column col)
+ (and org-table-overlay-coordinates (org-table-align))))
+
+(defun org-table-hline-and-move (&optional same-column)
+ "Insert a hline and move to the row below that line."
+ (interactive "P")
+ (let ((col (org-table-current-column)))
+ (org-table-maybe-eval-formula)
+ (org-table-maybe-recalculate-line)
+ (org-table-insert-hline)
+ (end-of-line 2)
+ (if (looking-at "\n[ \t]*|-")
+ (progn (insert "\n|") (org-table-align))
+ (org-table-next-field))
+ (if same-column (org-table-goto-column col))))
+
+(defun org-table-clean-line (s)
+ "Convert a table line S into a string with only \"|\" and space.
+In particular, this does handle wide and invisible characters."
+ (if (string-match "^[ \t]*|-" s)
+ ;; It's a hline, just map the characters
+ (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
+ (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
+ (setq s (replace-match
+ (concat "|" (make-string (org-string-width (match-string 1 s))
+ ?\ ) "|")
+ t t s)))
+ s))
+
+(defun org-table-kill-row ()
+ "Delete the current row or horizontal line from the table."
+ (interactive)
+ (if (not (org-at-table-p))
+ (error "Not at a table"))
+ (let ((col (current-column))
+ (dline (org-table-current-dline)))
+ (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
+ (if (not (org-at-table-p)) (beginning-of-line 0))
+ (org-move-to-column col)
+ (when (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
+ dline -1 dline))))
+
+(defun org-table-sort-lines (with-case &optional sorting-type)
+ "Sort table lines according to the column at point.
+
+The position of point indicates the column to be used for
+sorting, and the range of lines is the range between the nearest
+horizontal separator lines, or the entire table of no such lines
+exist. If point is before the first column, you will be prompted
+for the sorting column. If there is an active region, the mark
+specifies the first line and the sorting column, while point
+should be in the last line to be included into the sorting.
+
+The command then prompts for the sorting type which can be
+alphabetically, numerically, or by time (as given in a time stamp
+in the field). Sorting in reverse order is also possible.
+
+With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
+
+If SORTING-TYPE is specified when this function is called from a Lisp
+program, no prompting will take place. SORTING-TYPE must be a character,
+any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
+should be done in reverse order."
+ (interactive "P")
+ (let* ((thisline (org-current-line))
+ (thiscol (org-table-current-column))
+ beg end bcol ecol tend tbeg column lns pos)
+ (when (equal thiscol 0)
+ (if (org-called-interactively-p 'any)
+ (setq thiscol
+ (string-to-number
+ (read-string "Use column N for sorting: ")))
+ (setq thiscol 1))
+ (org-table-goto-column thiscol))
+ (org-table-check-inside-data-field)
+ (if (org-region-active-p)
+ (progn
+ (setq beg (region-beginning) end (region-end))
+ (goto-char beg)
+ (setq column (org-table-current-column)
+ beg (point-at-bol))
+ (goto-char end)
+ (setq end (point-at-bol 2)))
+ (setq column (org-table-current-column)
+ pos (point)
+ tbeg (org-table-begin)
+ tend (org-table-end))
+ (if (re-search-backward org-table-hline-regexp tbeg t)
+ (setq beg (point-at-bol 2))
+ (goto-char tbeg)
+ (setq beg (point-at-bol 1)))
+ (goto-char pos)
+ (if (re-search-forward org-table-hline-regexp tend t)
+ (setq end (point-at-bol 1))
+ (goto-char tend)
+ (setq end (point-at-bol))))
+ (setq beg (move-marker (make-marker) beg)
+ end (move-marker (make-marker) end))
+ (untabify beg end)
+ (goto-char beg)
+ (org-table-goto-column column)
+ (skip-chars-backward "^|")
+ (setq bcol (current-column))
+ (org-table-goto-column (1+ column))
+ (skip-chars-backward "^|")
+ (setq ecol (1- (current-column)))
+ (org-table-goto-column column)
+ (setq lns (mapcar (lambda(x) (cons
+ (org-sort-remove-invisible
+ (nth (1- column)
+ (org-split-string x "[ \t]*|[ \t]*")))
+ x))
+ (org-split-string (buffer-substring beg end) "\n")))
+ (setq lns (org-do-sort lns "Table" with-case sorting-type))
+ (delete-region beg end)
+ (move-marker beg nil)
+ (move-marker end nil)
+ (insert (mapconcat 'cdr lns "\n") "\n")
+ (org-goto-line thisline)
+ (org-table-goto-column thiscol)
+ (message "%d lines sorted, based on column %d" (length lns) column)))
+
+
+(defun org-table-cut-region (beg end)
+ "Copy region in table to the clipboard and blank all relevant fields.
+If there is no active region, use just the field at point."
+ (interactive (list
+ (if (org-region-active-p) (region-beginning) (point))
+ (if (org-region-active-p) (region-end) (point))))
+ (org-table-copy-region beg end 'cut))
+
+(defun org-table-copy-region (beg end &optional cut)
+ "Copy rectangular region in table to clipboard.
+A special clipboard is used which can only be accessed
+with `org-table-paste-rectangle'."
+ (interactive (list
+ (if (org-region-active-p) (region-beginning) (point))
+ (if (org-region-active-p) (region-end) (point))
+ current-prefix-arg))
+ (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
+ region cols
+ (rpl (if cut " " nil)))
+ (goto-char beg)
+ (org-table-check-inside-data-field)
+ (setq l01 (org-current-line)
+ c01 (org-table-current-column))
+ (goto-char end)
+ (org-table-check-inside-data-field)
+ (setq l02 (org-current-line)
+ c02 (org-table-current-column))
+ (setq l1 (min l01 l02) l2 (max l01 l02)
+ c1 (min c01 c02) c2 (max c01 c02))
+ (catch 'exit
+ (while t
+ (catch 'nextline
+ (if (> l1 l2) (throw 'exit t))
+ (org-goto-line l1)
+ (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
+ (setq cols nil ic1 c1 ic2 c2)
+ (while (< ic1 (1+ ic2))
+ (push (org-table-get-field ic1 rpl) cols)
+ (setq ic1 (1+ ic1)))
+ (push (nreverse cols) region)
+ (setq l1 (1+ l1)))))
+ (setq org-table-clip (nreverse region))
+ (if cut (org-table-align))
+ org-table-clip))
+
+(defun org-table-paste-rectangle ()
+ "Paste a rectangular region into a table.
+The upper right corner ends up in the current field. All involved fields
+will be overwritten. If the rectangle does not fit into the present table,
+the table is enlarged as needed. The process ignores horizontal separator
+lines."
+ (interactive)
+ (unless (and org-table-clip (listp org-table-clip))
+ (error "First cut/copy a region to paste!"))
+ (org-table-check-inside-data-field)
+ (let* ((clip org-table-clip)
+ (line (org-current-line))
+ (col (org-table-current-column))
+ (org-enable-table-editor t)
+ (org-table-automatic-realign nil)
+ c cols field)
+ (while (setq cols (pop clip))
+ (while (org-at-table-hline-p) (beginning-of-line 2))
+ (if (not (org-at-table-p))
+ (progn (end-of-line 0) (org-table-next-field)))
+ (setq c col)
+ (while (setq field (pop cols))
+ (org-table-goto-column c nil 'force)
+ (org-table-get-field nil field)
+ (setq c (1+ c)))
+ (beginning-of-line 2))
+ (org-goto-line line)
+ (org-table-goto-column col)
+ (org-table-align)))
+
+(defun org-table-convert ()
+ "Convert from `org-mode' table to table.el and back.
+Obviously, this only works within limits. When an Org-mode table is
+converted to table.el, all horizontal separator lines get lost, because
+table.el uses these as cell boundaries and has no notion of horizontal lines.
+A table.el table can be converted to an Org-mode table only if it does not
+do row or column spanning. Multiline cells will become multiple cells.
+Beware, Org-mode does not test if the table can be successfully converted - it
+blindly applies a recipe that works for simple tables."
+ (interactive)
+ (require 'table)
+ (if (org-at-table.el-p)
+ ;; convert to Org-mode table
+ (let ((beg (move-marker (make-marker) (org-table-begin t)))
+ (end (move-marker (make-marker) (org-table-end t))))
+ (table-unrecognize-region beg end)
+ (goto-char beg)
+ (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
+ (replace-match ""))
+ (goto-char beg))
+ (if (org-at-table-p)
+ ;; convert to table.el table
+ (let ((beg (move-marker (make-marker) (org-table-begin)))
+ (end (move-marker (make-marker) (org-table-end))))
+ ;; first, get rid of all horizontal lines
+ (goto-char beg)
+ (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
+ (replace-match ""))
+ ;; insert a hline before first
+ (goto-char beg)
+ (org-table-insert-hline 'above)
+ (beginning-of-line -1)
+ ;; insert a hline after each line
+ (while (progn (beginning-of-line 3) (< (point) end))
+ (org-table-insert-hline))
+ (goto-char beg)
+ (setq end (move-marker end (org-table-end)))
+ ;; replace "+" at beginning and ending of hlines
+ (while (re-search-forward "^\\([ \t]*\\)|-" end t)
+ (replace-match "\\1+-"))
+ (goto-char beg)
+ (while (re-search-forward "-|[ \t]*$" end t)
+ (replace-match "-+"))
+ (goto-char beg)))))
+
+(defun org-table-transpose-table-at-point ()
+ "Transpose orgmode table at point and eliminate hlines.
+So a table like
+
+| 1 | 2 | 4 | 5 |
+|---+---+---+---|
+| a | b | c | d |
+| e | f | g | h |
+
+will be transposed as
+
+| 1 | a | e |
+| 2 | b | f |
+| 4 | c | g |
+| 5 | d | h |
+
+Note that horizontal lines disappeared."
+ (interactive)
+ (let ((contents
+ (apply #'mapcar* #'list
+ ;; remove 'hline from list
+ (delq nil (mapcar (lambda (x) (when (listp x) x))
+ (org-table-to-lisp))))))
+ (delete-region (org-table-begin) (org-table-end))
+ (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
+ contents ""))
+ (org-table-align)))
+
+(defun org-table-wrap-region (arg)
+ "Wrap several fields in a column like a paragraph.
+This is useful if you'd like to spread the contents of a field over several
+lines, in order to keep the table compact.
+
+If there is an active region, and both point and mark are in the same column,
+the text in the column is wrapped to minimum width for the given number of
+lines. Generally, this makes the table more compact. A prefix ARG may be
+used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]'
+formats the selected text to two lines. If the region was longer than two
+lines, the remaining lines remain empty. A negative prefix argument reduces
+the current number of lines by that amount. The wrapped text is pasted back
+into the table. If you formatted it to more lines than it was before, fields
+further down in the table get overwritten - so you might need to make space in
+the table first.
+
+If there is no region, the current field is split at the cursor position and
+the text fragment to the right of the cursor is prepended to the field one
+line down.
+
+If there is no region, but you specify a prefix ARG, the current field gets
+blank, and the content is appended to the field above."
+ (interactive "P")
+ (org-table-check-inside-data-field)
+ (if (org-region-active-p)
+ ;; There is a region: fill as a paragraph
+ (let* ((beg (region-beginning))
+ (cline (save-excursion (goto-char beg) (org-current-line)))
+ (ccol (save-excursion (goto-char beg) (org-table-current-column)))
+ nlines)
+ (org-table-cut-region (region-beginning) (region-end))
+ (if (> (length (car org-table-clip)) 1)
+ (error "Region must be limited to single column"))
+ (setq nlines (if arg
+ (if (< arg 1)
+ (+ (length org-table-clip) arg)
+ arg)
+ (length org-table-clip)))
+ (setq org-table-clip
+ (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
+ nil nlines)))
+ (org-goto-line cline)
+ (org-table-goto-column ccol)
+ (org-table-paste-rectangle))
+ ;; No region, split the current field at point
+ (unless (org-get-alist-option org-M-RET-may-split-line 'table)
+ (skip-chars-forward "^\r\n|"))
+ (if arg
+ ;; combine with field above
+ (let ((s (org-table-blank-field))
+ (col (org-table-current-column)))
+ (beginning-of-line 0)
+ (while (org-at-table-hline-p) (beginning-of-line 0))
+ (org-table-goto-column col)
+ (skip-chars-forward "^|")
+ (skip-chars-backward " ")
+ (insert " " (org-trim s))
+ (org-table-align))
+ ;; split field
+ (if (looking-at "\\([^|]+\\)+|")
+ (let ((s (match-string 1)))
+ (replace-match " |")
+ (goto-char (match-beginning 0))
+ (org-table-next-row)
+ (insert (org-trim s) " ")
+ (org-table-align))
+ (org-table-next-row)))))
+
+(defvar org-field-marker nil)
+
+(defun org-table-edit-field (arg)
+ "Edit table field in a different window.
+This is mainly useful for fields that contain hidden parts.
+When called with a \\[universal-argument] prefix, just make the full field visible so that
+it can be edited in place."
+ (interactive "P")
+ (cond
+ ((equal arg '(16))
+ (org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
+ (arg
+ (let ((b (save-excursion (skip-chars-backward "^|") (point)))
+ (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
+ (remove-text-properties b e '(org-cwidth t invisible t
+ display t intangible t))
+ (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-fontify-block))))
+ (t
+ (let ((pos (move-marker (make-marker) (point)))
+ (coord
+ (if (eq org-table-use-standard-references t)
+ (concat (org-number-to-letters (org-table-current-column))
+ (int-to-string (org-table-current-dline)))
+ (concat "@" (int-to-string (org-table-current-dline))
+ "$" (int-to-string (org-table-current-column)))))
+ (field (org-table-get-field))
+ (cw (current-window-configuration))
+ p)
+ (goto-char pos)
+ (org-switch-to-buffer-other-window "*Org Table Edit Field*")
+ (when (and (local-variable-p 'org-field-marker)
+ (markerp org-field-marker))
+ (move-marker org-field-marker nil))
+ (erase-buffer)
+ (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
+ (let ((org-inhibit-startup t)) (org-mode))
+ (auto-fill-mode -1)
+ (setq truncate-lines nil)
+ (setq word-wrap t)
+ (goto-char (setq p (point-max)))
+ (insert (org-trim field))
+ (remove-text-properties p (point-max)
+ '(invisible t org-cwidth t display t
+ intangible t))
+ (goto-char p)
+ (org-set-local 'org-finish-function 'org-table-finish-edit-field)
+ (org-set-local 'org-window-configuration cw)
+ (org-set-local 'org-field-marker pos)
+ (message "Edit and finish with C-c C-c")))))
+
+(defun org-table-finish-edit-field ()
+ "Finish editing a table data field.
+Remove all newline characters, insert the result into the table, realign
+the table and kill the editing buffer."
+ (let ((pos org-field-marker)
+ (cw org-window-configuration)
+ (cb (current-buffer))
+ text)
+ (goto-char (point-min))
+ (while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
+ (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
+ (replace-match " "))
+ (setq text (org-trim (buffer-string)))
+ (set-window-configuration cw)
+ (kill-buffer cb)
+ (select-window (get-buffer-window (marker-buffer pos)))
+ (goto-char pos)
+ (move-marker pos nil)
+ (org-table-check-inside-data-field)
+ (org-table-get-field nil text)
+ (org-table-align)
+ (message "New field value inserted")))
+
+(define-minor-mode org-table-follow-field-mode
+ "Minor mode to make the table field editor window follow the cursor.
+When this mode is active, the field editor window will always show the
+current field. The mode exits automatically when the cursor leaves the
+table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
+ nil " TblFollow" nil
+ (if org-table-follow-field-mode
+ (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor
+ 'append 'local)
+ (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
+ (let* ((buf (get-buffer "*Org Table Edit Field*"))
+ (win (and buf (get-buffer-window buf))))
+ (when win (delete-window win))
+ (when buf
+ (with-current-buffer buf
+ (move-marker org-field-marker nil))
+ (kill-buffer buf)))))
+
+(defun org-table-follow-fields-with-editor ()
+ (if (and org-table-exit-follow-field-mode-when-leaving-table
+ (not (org-at-table-p)))
+ ;; We have left the table, exit the follow mode
+ (org-table-follow-field-mode -1)
+ (when (org-table-check-inside-data-field 'noerror)
+ (let ((win (selected-window)))
+ (org-table-edit-field nil)
+ (org-fit-window-to-buffer)
+ (select-window win)))))
+
+(defvar org-timecnt) ; dynamically scoped parameter
+
+(defun org-table-sum (&optional beg end nlast)
+ "Sum numbers in region of current table column.
+The result will be displayed in the echo area, and will be available
+as kill to be inserted with \\[yank].
+
+If there is an active region, it is interpreted as a rectangle and all
+numbers in that rectangle will be summed. If there is no active
+region and point is located in a table column, sum all numbers in that
+column.
+
+If at least one number looks like a time HH:MM or HH:MM:SS, all other
+numbers are assumed to be times as well (in decimal hours) and the
+numbers are added as such.
+
+If NLAST is a number, only the NLAST fields will actually be summed."
+ (interactive)
+ (save-excursion
+ (let (col (org-timecnt 0) diff h m s org-table-clip)
+ (cond
+ ((and beg end)) ; beg and end given explicitly
+ ((org-region-active-p)
+ (setq beg (region-beginning) end (region-end)))
+ (t
+ (setq col (org-table-current-column))
+ (goto-char (org-table-begin))
+ (unless (re-search-forward "^[ \t]*|[^-]" nil t)
+ (error "No table data"))
+ (org-table-goto-column col)
+ (setq beg (point))
+ (goto-char (org-table-end))
+ (unless (re-search-backward "^[ \t]*|[^-]" nil t)
+ (error "No table data"))
+ (org-table-goto-column col)
+ (setq end (point))))
+ (let* ((items (apply 'append (org-table-copy-region beg end)))
+ (items1 (cond ((not nlast) items)
+ ((>= nlast (length items)) items)
+ (t (setq items (reverse items))
+ (setcdr (nthcdr (1- nlast) items) nil)
+ (nreverse items))))
+ (numbers (delq nil (mapcar 'org-table-get-number-for-summing
+ items1)))
+ (res (apply '+ numbers))
+ (sres (if (= org-timecnt 0)
+ (number-to-string res)
+ (setq diff (* 3600 res)
+ h (floor (/ diff 3600)) diff (mod diff 3600)
+ m (floor (/ diff 60)) diff (mod diff 60)
+ s diff)
+ (format "%d:%02d:%02d" h m s))))
+ (kill-new sres)
+ (if (org-called-interactively-p 'interactive)
+ (message "%s"
+ (substitute-command-keys
+ (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
+ (length numbers) sres))))
+ sres))))
+
+(defun org-table-get-number-for-summing (s)
+ (let (n)
+ (if (string-match "^ *|? *" s)
+ (setq s (replace-match "" nil nil s)))
+ (if (string-match " *|? *$" s)
+ (setq s (replace-match "" nil nil s)))
+ (setq n (string-to-number s))
+ (cond
+ ((and (string-match "0" s)
+ (string-match "\\`[-+ \t0.edED]+\\'" s)) 0)
+ ((string-match "\\`[ \t]+\\'" s) nil)
+ ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s)
+ (let ((h (string-to-number (or (match-string 1 s) "0")))
+ (m (string-to-number (or (match-string 2 s) "0")))
+ (s (string-to-number (or (match-string 4 s) "0"))))
+ (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt)))
+ (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
+ ((equal n 0) nil)
+ (t n))))
+
+(defun org-table-current-field-formula (&optional key noerror)
+ "Return the formula active for the current field.
+Assumes that specials are in place.
+If KEY is given, return the key to this formula.
+Otherwise return the formula preceded with \"=\" or \":=\"."
+ (let* ((name (car (rassoc (list (org-current-line)
+ (org-table-current-column))
+ org-table-named-field-locations)))
+ (col (org-table-current-column))
+ (scol (int-to-string col))
+ (ref (format "@%d$%d" (org-table-current-dline) col))
+ (stored-list (org-table-get-stored-formulas noerror))
+ (ass (or (assoc name stored-list)
+ (assoc ref stored-list)
+ (assoc scol stored-list))))
+ (if key
+ (car ass)
+ (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
+ (cdr ass))))))
+
+(defun org-table-get-formula (&optional equation named)
+ "Read a formula from the minibuffer, offer stored formula as default.
+When NAMED is non-nil, look for a named equation."
+ (let* ((stored-list (org-table-get-stored-formulas))
+ (name (car (rassoc (list (org-current-line)
+ (org-table-current-column))
+ org-table-named-field-locations)))
+ (ref (format "@%d$%d" (org-table-current-dline)
+ (org-table-current-column)))
+ (refass (assoc ref stored-list))
+ (nameass (assoc name stored-list))
+ (scol (if named
+ (if (and name (not (string-match "^LR[0-9]+$" name)))
+ name
+ ref)
+ (int-to-string (org-table-current-column))))
+ (dummy (and (or nameass refass) (not named)
+ (not (y-or-n-p "Replace existing field formula with column formula? " ))
+ (error "Abort")))
+ (name (or name ref))
+ (org-table-may-need-update nil)
+ (stored (cdr (assoc scol stored-list)))
+ (eq (cond
+ ((and stored equation (string-match "^ *=? *$" equation))
+ stored)
+ ((stringp equation)
+ equation)
+ (t (org-table-formula-from-user
+ (read-string
+ (org-table-formula-to-user
+ (format "%s formula %s%s="
+ (if named "Field" "Column")
+ (if (member (string-to-char scol) '(?$ ?@)) "" "$")
+ scol))
+ (if stored (org-table-formula-to-user stored) "")
+ 'org-table-formula-history
+ )))))
+ mustsave)
+ (when (not (string-match "\\S-" eq))
+ ;; remove formula
+ (setq stored-list (delq (assoc scol stored-list) stored-list))
+ (org-table-store-formulas stored-list)
+ (error "Formula removed"))
+ (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
+ (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
+ (if (and name (not named))
+ ;; We set the column equation, delete the named one.
+ (setq stored-list (delq (assoc name stored-list) stored-list)
+ mustsave t))
+ (if stored
+ (setcdr (assoc scol stored-list) eq)
+ (setq stored-list (cons (cons scol eq) stored-list)))
+ (if (or mustsave (not (equal stored eq)))
+ (org-table-store-formulas stored-list))
+ eq))
+
+(defun org-table-store-formulas (alist)
+ "Store the list of formulas below the current table."
+ (setq alist (sort alist 'org-table-formula-less-p))
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (org-table-end))
+ (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)")
+ (progn
+ ;; don't overwrite TBLFM, we might use text properties to store stuff
+ (goto-char (match-beginning 3))
+ (delete-region (match-beginning 3) (match-end 0)))
+ (org-indent-line)
+ (insert (or (match-string 2) "#+TBLFM:")))
+ (insert " "
+ (mapconcat (lambda (x)
+ (concat
+ (if (equal (string-to-char (car x)) ?@) "" "$")
+ (car x) "=" (cdr x)))
+ alist "::")
+ "\n"))))
+
+(defsubst org-table-formula-make-cmp-string (a)
+ (when (string-match "\\`$[<>]" a)
+ (let ((arrow (string-to-char (substring a 1))))
+ ;; Fake a high number to make sure this is sorted at the end.
+ (setq a (org-table-formula-handle-first/last-rc a))
+ (setq a (format "$%d" (+ 10000
+ (if (= arrow ?<) -1000 0)
+ (string-to-number (substring a 1)))))))
+ (when (string-match
+ "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?"
+ a)
+ (concat
+ (if (match-end 2)
+ (format "@%05d" (string-to-number (match-string 2 a))) "")
+ (if (match-end 4)
+ (format "$%05d" (string-to-number (match-string 4 a))) "")
+ (if (match-end 5)
+ (concat "@@" (match-string 5 a))))))
+
+(defun org-table-formula-less-p (a b)
+ "Compare two formulas for sorting."
+ (let ((as (org-table-formula-make-cmp-string (car a)))
+ (bs (org-table-formula-make-cmp-string (car b))))
+ (and as bs (string< as bs))))
+
+(defun org-table-get-stored-formulas (&optional noerror)
+ "Return an alist with the stored formulas directly after current table."
+ (interactive)
+ (let ((case-fold-search t) scol eq eq-alist strings string seen)
+ (save-excursion
+ (goto-char (org-table-end))
+ (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)")
+ (setq strings (org-split-string (org-match-string-no-properties 2)
+ " *:: *"))
+ (while (setq string (pop strings))
+ (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
+ (setq scol (if (match-end 2)
+ (match-string 2 string)
+ (match-string 1 string))
+ scol (if (member (string-to-char scol) '(?< ?>))
+ (concat "$" scol) scol)
+ eq (match-string 3 string)
+ eq-alist (cons (cons scol eq) eq-alist))
+ (if (member scol seen)
+ (if noerror
+ (progn
+ (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
+ (ding)
+ (sit-for 2))
+ (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
+ (push scol seen))))))
+ (nreverse eq-alist)))
+
+(defun org-table-fix-formulas (key replace &optional limit delta remove)
+ "Modify the equations after the table structure has been edited.
+KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace.
+For all numbers larger than LIMIT, shift them by DELTA."
+ (save-excursion
+ (goto-char (org-table-end))
+ (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
+ (let ((msg "The formulas in #+TBLFM have been updated")
+ (re (concat key "\\([0-9]+\\)"))
+ (re2
+ (when remove
+ (if (or (equal key "$") (equal key "$LR"))
+ (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)"
+ (regexp-quote key) remove)
+ (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove))))
+ s n a)
+ (when remove
+ (while (re-search-forward re2 (point-at-eol) t)
+ (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
+ (if (equal (char-before (match-beginning 0)) ?.)
+ (error "Change makes TBLFM term %s invalid, use undo to recover"
+ (match-string 0))
+ (replace-match "")))))
+ (while (re-search-forward re (point-at-eol) t)
+ (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
+ (setq s (match-string 1) n (string-to-number s))
+ (cond
+ ((setq a (assoc s replace))
+ (replace-match (concat key (cdr a)) t t)
+ (message msg))
+ ((and limit (> n limit))
+ (replace-match (concat key (int-to-string (+ n delta))) t t)
+ (message msg)))))))))
+
+(defun org-table-get-specials ()
+ "Get the column names and local parameters for this table."
+ (save-excursion
+ (let ((beg (org-table-begin)) (end (org-table-end))
+ names name fields fields1 field cnt
+ c v l line col types dlines hlines last-dline)
+ (setq org-table-column-names nil
+ org-table-local-parameters nil
+ org-table-named-field-locations nil
+ org-table-current-begin-line nil
+ org-table-current-begin-pos nil
+ org-table-current-line-types nil
+ org-table-current-ncol 0)
+ (goto-char beg)
+ (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
+ (setq names (org-split-string (match-string 1) " *| *")
+ cnt 1)
+ (while (setq name (pop names))
+ (setq cnt (1+ cnt))
+ (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name)
+ (push (cons name (int-to-string cnt)) org-table-column-names))))
+ (setq org-table-column-names (nreverse org-table-column-names))
+ (setq org-table-column-name-regexp
+ (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
+ (setq fields (org-split-string (match-string 1) " *| *"))
+ (while (setq field (pop fields))
+ (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
+ (push (cons (match-string 1 field) (match-string 2 field))
+ org-table-local-parameters))))
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
+ (setq c (match-string 1)
+ fields (org-split-string (match-string 2) " *| *"))
+ (save-excursion
+ (beginning-of-line (if (equal c "_") 2 0))
+ (setq line (org-current-line) col 1)
+ (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
+ (setq fields1 (org-split-string (match-string 1) " *| *"))))
+ (while (and fields1 (setq field (pop fields)))
+ (setq v (pop fields1) col (1+ col))
+ (when (and (stringp field) (stringp v)
+ (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
+ (push (cons field v) org-table-local-parameters)
+ (push (list field line col) org-table-named-field-locations))))
+ ;; Analyse the line types
+ (goto-char beg)
+ (setq org-table-current-begin-line (org-current-line)
+ org-table-current-begin-pos (point)
+ l org-table-current-begin-line)
+ (while (looking-at "[ \t]*|\\(-\\)?")
+ (push (if (match-end 1) 'hline 'dline) types)
+ (if (match-end 1) (push l hlines) (push l dlines))
+ (beginning-of-line 2)
+ (setq l (1+ l)))
+ (push 'hline types) ;; add an imaginary extra hline to the end
+ (setq org-table-current-line-types (apply 'vector (nreverse types))
+ last-dline (car dlines)
+ org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
+ org-table-hlines (apply 'vector (cons nil (nreverse hlines))))
+ (org-goto-line last-dline)
+ (let* ((l last-dline)
+ (fields (org-split-string
+ (buffer-substring (point-at-bol) (point-at-eol))
+ "[ \t]*|[ \t]*"))
+ (nfields (length fields))
+ al al2)
+ (setq org-table-current-ncol nfields)
+ (loop for i from 1 to nfields do
+ (push (list (format "LR%d" i) l i) al)
+ (push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
+ (setq org-table-named-field-locations
+ (append org-table-named-field-locations al))
+ (setq org-table-local-parameters
+ (append org-table-local-parameters al2))))))
+
+(defun org-table-maybe-eval-formula ()
+ "Check if the current field starts with \"=\" or \":=\".
+If yes, store the formula and apply it."
+ ;; We already know we are in a table. Get field will only return a formula
+ ;; when appropriate. It might return a separator line, but no problem.
+ (when org-table-formula-evaluate-inline
+ (let* ((field (org-trim (or (org-table-get-field) "")))
+ named eq)
+ (when (string-match "^:?=\\(.*[^=]\\)$" field)
+ (setq named (equal (string-to-char field) ?:)
+ eq (match-string 1 field))
+ (if (or (fboundp 'calc-eval)
+ (equal (substring eq 0 (min 2 (length eq))) "'("))
+ (org-table-eval-formula (if named '(4) nil)
+ (org-table-formula-from-user eq))
+ (error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
+
+(defvar org-recalc-commands nil
+ "List of commands triggering the recalculation of a line.
+Will be filled automatically during use.")
+
+(defvar org-recalc-marks
+ '((" " . "Unmarked: no special line, no automatic recalculation")
+ ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
+ ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
+ ("!" . "Column name definition line. Reference in formula as $name.")
+ ("$" . "Parameter definition line name=value. Reference in formula as $name.")
+ ("_" . "Names for values in row below this one.")
+ ("^" . "Names for values in row above this one.")))
+
+(defun org-table-rotate-recalc-marks (&optional newchar)
+ "Rotate the recalculation mark in the first column.
+If in any row, the first field is not consistent with a mark,
+insert a new column for the markers.
+When there is an active region, change all the lines in the region,
+after prompting for the marking character.
+After each change, a message will be displayed indicating the meaning
+of the new mark."
+ (interactive)
+ (unless (org-at-table-p) (error "Not at a table"))
+ (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
+ (beg (org-table-begin))
+ (end (org-table-end))
+ (l (org-current-line))
+ (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
+ (l2 (if (org-region-active-p) (org-current-line (region-end))))
+ (have-col
+ (save-excursion
+ (goto-char beg)
+ (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t))))
+ (col (org-table-current-column))
+ (forcenew (car (assoc newchar org-recalc-marks)))
+ epos new)
+ (when l1
+ (message "Change region to what mark? Type # * ! $ or SPC: ")
+ (setq newchar (char-to-string (read-char-exclusive))
+ forcenew (car (assoc newchar org-recalc-marks))))
+ (if (and newchar (not forcenew))
+ (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
+ newchar))
+ (if l1 (org-goto-line l1))
+ (save-excursion
+ (beginning-of-line 1)
+ (unless (looking-at org-table-dataline-regexp)
+ (error "Not at a table data line")))
+ (unless have-col
+ (org-table-goto-column 1)
+ (org-table-insert-column)
+ (org-table-goto-column (1+ col)))
+ (setq epos (point-at-eol))
+ (save-excursion
+ (beginning-of-line 1)
+ (org-table-get-field
+ 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")
+ (concat " "
+ (setq new (or forcenew
+ (cadr (member (match-string 1) marks))))
+ " ")
+ " # ")))
+ (if (and l1 l2)
+ (progn
+ (org-goto-line l1)
+ (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
+ (and (looking-at org-table-dataline-regexp)
+ (org-table-get-field 1 (concat " " new " "))))
+ (org-goto-line l1)))
+ (if (not (= epos (point-at-eol))) (org-table-align))
+ (org-goto-line l)
+ (and (org-called-interactively-p 'interactive)
+ (message "%s" (cdr (assoc new org-recalc-marks))))))
+
+(defun org-table-maybe-recalculate-line ()
+ "Recompute the current line if marked for it, and if we haven't just done it."
+ (interactive)
+ (and org-table-allow-automatic-line-recalculation
+ (not (and (memq last-command org-recalc-commands)
+ (equal org-last-recalc-line (org-current-line))))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-table-auto-recalculate-regexp))
+ (org-table-recalculate) t))
+
+(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula'
+(defsubst org-set-calc-mode (var &optional value)
+ (if (stringp var)
+ (setq var (assoc var '(("D" calc-angle-mode deg)
+ ("R" calc-angle-mode rad)
+ ("F" calc-prefer-frac t)
+ ("S" calc-symbolic-mode t)))
+ value (nth 2 var) var (nth 1 var)))
+ (if (memq var org-tbl-calc-modes)
+ (setcar (cdr (memq var org-tbl-calc-modes)) value)
+ (cons var (cons value org-tbl-calc-modes)))
+ org-tbl-calc-modes)
+
+(defun org-table-eval-formula (&optional arg equation
+ suppress-align suppress-const
+ suppress-store suppress-analysis)
+ "Replace the table field value at the cursor by the result of a calculation.
+
+This function makes use of Dave Gillespie's Calc package, in my view the
+most exciting program ever written for GNU Emacs. So you need to have Calc
+installed in order to use this function.
+
+In a table, this command replaces the value in the current field with the
+result of a formula. It also installs the formula as the \"current\" column
+formula, by storing it in a special line below the table. When called
+with a `C-u' prefix, the current field must be a named field, and the
+formula is installed as valid in only this specific field.
+
+When called with two `C-u' prefixes, insert the active equation
+for the field back into the current field, so that it can be
+edited there. This is useful in order to use \\[org-table-show-reference]
+to check the referenced fields.
+
+When called, the command first prompts for a formula, which is read in
+the minibuffer. Previously entered formulas are available through the
+history list, and the last used formula is offered as a default.
+These stored formulas are adapted correctly when moving, inserting, or
+deleting columns with the corresponding commands.
+
+The formula can be any algebraic expression understood by the Calc package.
+For details, see the Org-mode manual.
+
+This function can also be called from Lisp programs and offers
+additional arguments: EQUATION can be the formula to apply. If this
+argument is given, the user will not be prompted. SUPPRESS-ALIGN is
+used to speed-up recursive calls by by-passing unnecessary aligns.
+SUPPRESS-CONST suppresses the interpretation of constants in the
+formula, assuming that this has been done already outside the function.
+SUPPRESS-STORE means the formula should not be stored, either because
+it is already stored, or because it is a modified equation that should
+not overwrite the stored one."
+ (interactive "P")
+ (org-table-check-inside-data-field)
+ (or suppress-analysis (org-table-get-specials))
+ (if (equal arg '(16))
+ (let ((eq (org-table-current-field-formula)))
+ (or eq (error "No equation active for current field"))
+ (org-table-get-field nil eq)
+ (org-table-align)
+ (setq org-table-may-need-update t))
+ (let* (fields
+ (ndown (if (integerp arg) arg 1))
+ (org-table-automatic-realign nil)
+ (case-fold-search nil)
+ (down (> ndown 1))
+ (formula (if (and equation suppress-store)
+ equation
+ (org-table-get-formula equation (equal arg '(4)))))
+ (n0 (org-table-current-column))
+ (org-tbl-calc-modes (copy-sequence org-calc-default-modes))
+ (numbers nil) ; was a variable, now fixed default
+ (keep-empty nil)
+ n form form0 formrpl formrg bw fmt x ev orig c lispp literal
+ duration duration-output-format)
+ ;; Parse the format string. Since we have a lot of modes, this is
+ ;; a lot of work. However, I think calc still uses most of the time.
+ (if (string-match ";" formula)
+ (let ((tmp (org-split-string formula ";")))
+ (setq formula (car tmp)
+ fmt (concat (cdr (assoc "%" org-table-local-parameters))
+ (nth 1 tmp)))
+ (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
+ (setq c (string-to-char (match-string 1 fmt))
+ n (string-to-number (match-string 2 fmt)))
+ (if (= c ?p)
+ (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n))
+ (setq org-tbl-calc-modes
+ (org-set-calc-mode
+ 'calc-float-format
+ (list (cdr (assoc c '((?n . float) (?f . fix)
+ (?s . sci) (?e . eng))))
+ n))))
+ (setq fmt (replace-match "" t t fmt)))
+ (if (string-match "T" fmt)
+ (setq duration t numbers t
+ duration-output-format nil
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "t" fmt)
+ (setq duration t
+ duration-output-format org-table-duration-custom-format
+ numbers t
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "N" fmt)
+ (setq numbers t
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "L" fmt)
+ (setq literal t
+ fmt (replace-match "" t t fmt)))
+ (if (string-match "E" fmt)
+ (setq keep-empty t
+ fmt (replace-match "" t t fmt)))
+ (while (string-match "[DRFS]" fmt)
+ (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt)))
+ (setq fmt (replace-match "" t t fmt)))
+ (unless (string-match "\\S-" fmt)
+ (setq fmt nil))))
+ (if (and (not suppress-const) org-table-formula-use-constants)
+ (setq formula (org-table-formula-substitute-names formula)))
+ (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
+ (while (> ndown 0)
+ (setq fields (org-split-string
+ (buffer-substring-no-properties (point-at-bol) (point-at-eol))
+ " *| *"))
+ ;; replace fields with duration values if relevant
+ (if duration
+ (setq fields
+ (mapcar (lambda (x) (org-table-time-string-to-seconds x))
+ fields)))
+ (if (eq numbers t)
+ (setq fields (mapcar
+ (lambda (x) (number-to-string (string-to-number x)))
+ fields)))
+ (setq ndown (1- ndown))
+ (setq form (copy-sequence formula)
+ lispp (and (> (length form) 2) (equal (substring form 0 2) "'(")))
+ (if (and lispp literal) (setq lispp 'literal))
+
+ ;; Insert row and column number of formula result field
+ (while (string-match "[@$]#" form)
+ (setq form
+ (replace-match
+ (format "%d"
+ (save-match-data
+ (if (equal (substring form (match-beginning 0)
+ (1+ (match-beginning 0)))
+ "@")
+ (org-table-current-dline)
+ (org-table-current-column))))
+ t t form)))
+
+ ;; Check for old vertical references
+ (setq form (org-table-rewrite-old-row-references form))
+ ;; Insert remote references
+ (while (string-match "\\<remote([ \t]*\\([-_a-zA-Z0-9]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
+ (setq form
+ (replace-match
+ (save-match-data
+ (org-table-make-reference
+ (let ((rmtrng (org-table-get-remote-range
+ (match-string 1 form) (match-string 2 form))))
+ (if duration
+ (if (listp rmtrng)
+ (mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng)
+ (org-table-time-string-to-seconds rmtrng))
+ rmtrng))
+ keep-empty numbers lispp))
+ t t form)))
+ ;; Insert complex ranges
+ (while (and (string-match org-table-range-regexp form)
+ (> (length (match-string 0 form)) 1))
+ (setq formrg (save-match-data
+ (org-table-get-range (match-string 0 form) nil n0)))
+ (setq formrpl
+ (save-match-data
+ (org-table-make-reference
+ ;; possibly handle durations
+ (if duration
+ (if (listp formrg)
+ (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
+ (org-table-time-string-to-seconds formrg))
+ formrg)
+ keep-empty numbers lispp)))
+ (if (not (save-match-data
+ (string-match (regexp-quote form) formrpl)))
+ (setq form (replace-match formrpl t t form))
+ (error "Spreadsheet error: invalid reference \"%s\"" form)))
+ ;; Insert simple ranges
+ (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
+ (setq form
+ (replace-match
+ (save-match-data
+ (org-table-make-reference
+ (org-sublist
+ fields (string-to-number (match-string 1 form))
+ (string-to-number (match-string 2 form)))
+ keep-empty numbers lispp))
+ t t form)))
+ (setq form0 form)
+ ;; Insert the references to fields in same row
+ (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
+ (setq n (+ (string-to-number (match-string 1 form))
+ (if (match-end 2) n0 0))
+ x (nth (1- (if (= n 0) n0 (max n 1))) fields))
+ (unless x (error "Invalid field specifier \"%s\""
+ (match-string 0 form)))
+ (setq form (replace-match
+ (save-match-data
+ (org-table-make-reference x nil numbers lispp))
+ t t form)))
+
+ (if lispp
+ (setq ev (condition-case nil
+ (eval (eval (read form)))
+ (error "#ERROR"))
+ ev (if (numberp ev) (number-to-string ev) ev)
+ ev (if duration (org-table-time-seconds-to-string
+ (string-to-number ev)
+ duration-output-format) ev))
+ (or (fboundp 'calc-eval)
+ (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
+ ;; "Inactivate" time-stamps so that Calc can handle them
+ (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
+ form
+ (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)))
+ ev (if duration (org-table-time-seconds-to-string
+ (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
+ (string-to-number (org-table-time-string-to-seconds ev))
+ (string-to-number ev))
+ duration-output-format)
+ ev)))
+
+ (when org-table-formula-debug
+ (with-output-to-temp-buffer "*Substitution History*"
+ (princ (format "Substitution history of formula
+Orig: %s
+$xyz-> %s
+@r$c-> %s
+$1-> %s\n" orig formula form0 form))
+ (if (listp ev)
+ (princ (format " %s^\nError: %s"
+ (make-string (car ev) ?\-) (nth 1 ev)))
+ (princ (format "Result: %s\nFormat: %s\nFinal: %s"
+ ev (or fmt "NONE")
+ (if fmt (format fmt (string-to-number ev)) ev)))))
+ (setq bw (get-buffer-window "*Substitution History*"))
+ (org-fit-window-to-buffer bw)
+ (unless (and (org-called-interactively-p 'any) (not ndown))
+ (unless (let (inhibit-redisplay)
+ (y-or-n-p "Debugging Formula. Continue to next? "))
+ (org-table-align)
+ (error "Abort"))
+ (delete-window bw)
+ (message "")))
+ (if (listp ev) (setq fmt nil ev "#ERROR"))
+ (org-table-justify-field-maybe
+ (format org-table-formula-field-format
+ (if fmt (format fmt (string-to-number ev)) ev)))
+ (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
+ (call-interactively 'org-return)
+ (setq ndown 0)))
+ (and down (org-table-maybe-recalculate-line))
+ (or suppress-align (and org-table-may-need-update
+ (org-table-align))))))
+
+(defun org-table-put-field-property (prop value)
+ (save-excursion
+ (put-text-property (progn (skip-chars-backward "^|") (point))
+ (progn (skip-chars-forward "^|") (point))
+ prop value)))
+
+(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
+ "Get a calc vector from a column, according to descriptor DESC.
+Optional arguments TBEG and COL can give the beginning of the table and
+the current column, to avoid unnecessary parsing.
+
+HIGHLIGHT means just highlight the range.
+
+When CORNERS-ONLY is set, only return the corners of the range as
+a list (line1 column1 line2 column2) where line1 and line2 are line numbers
+in the buffer and column1 and column2 are table column numbers."
+ (if (not (equal (string-to-char desc) ?@))
+ (setq desc (concat "@" desc)))
+ (save-excursion
+ (or tbeg (setq tbeg (org-table-begin)))
+ (or col (setq col (org-table-current-column)))
+ (let ((thisline (org-current-line))
+ beg end c1 c2 r1 r2 rangep tmp)
+ (unless (string-match org-table-range-regexp desc)
+ (error "Invalid table range specifier `%s'" desc))
+ (setq rangep (match-end 3)
+ r1 (and (match-end 1) (match-string 1 desc))
+ r2 (and (match-end 4) (match-string 4 desc))
+ c1 (and (match-end 2) (substring (match-string 2 desc) 1))
+ c2 (and (match-end 5) (substring (match-string 5 desc) 1)))
+
+ (and c1 (setq c1 (+ (string-to-number c1)
+ (if (memq (string-to-char c1) '(?- ?+)) col 0))))
+ (and c2 (setq c2 (+ (string-to-number c2)
+ (if (memq (string-to-char c2) '(?- ?+)) col 0))))
+ (if (equal r1 "") (setq r1 nil))
+ (if (equal r2 "") (setq r2 nil))
+ (if r1 (setq r1 (org-table-get-descriptor-line r1)))
+ (if r2 (setq r2 (org-table-get-descriptor-line r2)))
+ ; (setq r2 (or r2 r1) c2 (or c2 c1))
+ (if (not r1) (setq r1 thisline))
+ (if (not r2) (setq r2 thisline))
+ (if (or (not c1) (= 0 c1)) (setq c1 col))
+ (if (or (not c2) (= 0 c2)) (setq c2 col))
+ (if (and (not corners-only)
+ (or (not rangep) (and (= r1 r2) (= c1 c2))))
+ ;; just one field
+ (progn
+ (org-goto-line r1)
+ (while (not (looking-at org-table-dataline-regexp))
+ (beginning-of-line 2))
+ (prog1 (org-trim (org-table-get-field c1))
+ (if highlight (org-table-highlight-rectangle (point) (point)))))
+ ;; A range, return a vector
+ ;; First sort the numbers to get a regular rectangle
+ (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
+ (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
+ (if corners-only
+ ;; Only return the corners of the range
+ (list r1 c1 r2 c2)
+ ;; Copy the range values into a list
+ (org-goto-line r1)
+ (while (not (looking-at org-table-dataline-regexp))
+ (beginning-of-line 2))
+ (org-table-goto-column c1)
+ (setq beg (point))
+ (org-goto-line r2)
+ (while (not (looking-at org-table-dataline-regexp))
+ (beginning-of-line 0))
+ (org-table-goto-column c2)
+ (setq end (point))
+ (if highlight
+ (org-table-highlight-rectangle
+ beg (progn (skip-chars-forward "^|\n") (point))))
+ ;; return string representation of calc vector
+ (mapcar 'org-trim
+ (apply 'append (org-table-copy-region beg end))))))))
+
+(defun org-table-get-descriptor-line (desc &optional cline bline table)
+ "Analyze descriptor DESC and retrieve the corresponding line number.
+The cursor is currently in line CLINE, the table begins in line BLINE,
+and TABLE is a vector with line types."
+ (if (string-match "^[0-9]+$" desc)
+ (aref org-table-dlines (string-to-number desc))
+ (setq cline (or cline (org-current-line))
+ bline (or bline org-table-current-begin-line)
+ table (or table org-table-current-line-types))
+ (if (or
+ (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc))
+ ;; 1 2 3 4 5 6
+ (and (not (match-end 3)) (not (match-end 6)))
+ (and (match-end 3) (match-end 6) (not (match-end 5))))
+ (error "Invalid row descriptor `%s'" desc))
+ (let* ((hdir (and (match-end 2) (match-string 2 desc)))
+ (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
+ (odir (and (match-end 5) (match-string 5 desc)))
+ (on (if (match-end 6) (string-to-number (match-string 6 desc))))
+ (i (- cline bline))
+ (rel (and (match-end 6)
+ (or (and (match-end 1) (not (match-end 3)))
+ (match-end 5)))))
+ (if (and hn (not hdir))
+ (progn
+ (setq i 0 hdir "+")
+ (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
+ (if (and (not hn) on (not odir))
+ (error "Should never happen");;(aref org-table-dlines on)
+ (if (and hn (> hn 0))
+ (setq i (org-table-find-row-type table i 'hline (equal hdir "-")
+ nil hn cline desc)))
+ (if on
+ (setq i (org-table-find-row-type table i 'dline (equal odir "-")
+ rel on cline desc)))
+ (+ bline i)))))
+
+(defun org-table-find-row-type (table i type backwards relative n cline desc)
+ "FIXME: Needs more documentation."
+ (let ((l (length table)))
+ (while (> n 0)
+ (while (and (setq i (+ i (if backwards -1 1)))
+ (>= i 0) (< i l)
+ (not (eq (aref table i) type))
+ (if (and relative (eq (aref table i) 'hline))
+ (cond
+ ((eq org-table-relative-ref-may-cross-hline t) t)
+ ((eq org-table-relative-ref-may-cross-hline 'error)
+ (error "Row descriptor %s used in line %d crosses hline" desc cline))
+ (t (setq i (- i (if backwards -1 1))
+ n 1)
+ nil))
+ t)))
+ (setq n (1- n)))
+ (if (or (< i 0) (>= i l))
+ (error "Row descriptor %s used in line %d leads outside table"
+ desc cline)
+ i)))
+
+(defun org-table-rewrite-old-row-references (s)
+ (if (string-match "&[-+0-9I]" s)
+ (error "Formula contains old &row reference, please rewrite using @-syntax")
+ s))
+
+(defun org-table-make-reference (elements keep-empty numbers lispp)
+ "Convert list ELEMENTS to something appropriate to insert into formula.
+KEEP-EMPTY indicated to keep empty fields, default is to skip them.
+NUMBERS indicates that everything should be converted to numbers.
+LISPP means to return something appropriate for a Lisp list."
+ (if (stringp elements) ; just a single val
+ (if lispp
+ (if (eq lispp 'literal)
+ elements
+ (prin1-to-string (if numbers (string-to-number elements) elements)))
+ (if (equal elements "") (setq elements "0"))
+ (if numbers (setq elements (number-to-string (string-to-number elements))))
+ (concat "(" elements ")"))
+ (unless keep-empty
+ (setq elements
+ (delq nil
+ (mapcar (lambda (x) (if (string-match "\\S-" x) x nil))
+ elements))))
+ (setq elements (or elements '("0")))
+ (if lispp
+ (mapconcat
+ (lambda (x)
+ (if (eq lispp 'literal)
+ x
+ (prin1-to-string (if numbers (string-to-number x) x))))
+ elements " ")
+ (concat "[" (mapconcat
+ (lambda (x)
+ (if numbers (number-to-string (string-to-number x)) x))
+ elements
+ ",") "]"))))
+
+(defun org-table-recalculate (&optional all noalign)
+ "Recalculate the current table line by applying all stored formulas.
+With prefix arg ALL, do this for all lines in the table.
+With the prefix argument ALL is `(16)' \
+\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if
+it is the symbol `iterate', recompute the table until it no longer changes.
+If NOALIGN is not nil, do not re-align the table after the computations
+are done. This is typically used internally to save time, if it is
+known that the table will be realigned a little later anyway."
+ (interactive "P")
+ (or (memq this-command org-recalc-commands)
+ (setq org-recalc-commands (cons this-command org-recalc-commands)))
+ (unless (org-at-table-p) (error "Not at a table"))
+ (if (or (eq all 'iterate) (equal all '(16)))
+ (org-table-iterate)
+ (org-table-get-specials)
+ (let* ((eqlist (sort (org-table-get-stored-formulas)
+ (lambda (a b) (string< (car a) (car b)))))
+ (eqlist1 (copy-sequence eqlist))
+ (inhibit-redisplay (not debug-on-error))
+ (line-re org-table-dataline-regexp)
+ (thisline (org-current-line))
+ (thiscol (org-table-current-column))
+ seen-fields lhs1
+ beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
+ ;; Insert constants in all formulas
+ (setq eqlist
+ (mapcar (lambda (x)
+ (when (string-match "\\`$[<>]" (car x))
+ (setq lhs1 (car x))
+ (setq x (cons (substring
+ (org-table-formula-handle-first/last-rc
+ (car x)) 1)
+ (cdr x)))
+ (if (assoc (car x) eqlist1)
+ (error "\"%s=\" formula tries to overwrite existing formula for column %s"
+ lhs1 (car x))))
+ (cons
+ (org-table-formula-handle-first/last-rc (car x))
+ (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc (cdr x)))))
+ eqlist))
+ ;; Split the equation list
+ (while (setq eq (pop eqlist))
+ (if (<= (string-to-char (car eq)) ?9)
+ (push eq eqlnum)
+ (push eq eqlname)))
+ (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
+ ;; Expand ranges in lhs of formulas
+ (setq eqlname (org-table-expand-lhs-ranges eqlname))
+
+ ;; Get the correct line range to process
+ (if all
+ (progn
+ (setq end (move-marker (make-marker) (1+ (org-table-end))))
+ (goto-char (setq beg (org-table-begin)))
+ (if (re-search-forward org-table-calculate-mark-regexp end t)
+ ;; This is a table with marked lines, compute selected lines
+ (setq line-re org-table-recalculate-regexp)
+ ;; Move forward to the first non-header line
+ (if (and (re-search-forward org-table-dataline-regexp end t)
+ (re-search-forward org-table-hline-regexp end t)
+ (re-search-forward org-table-dataline-regexp end t))
+ (setq beg (match-beginning 0))
+ nil))) ;; just leave beg where it is
+ (setq beg (point-at-bol)
+ end (move-marker (make-marker) (1+ (point-at-eol)))))
+ (goto-char beg)
+ (and all (message "Re-applying formulas to full table..."))
+
+ ;; First find the named fields, and mark them untouchable.
+ ;; Also check if several field/range formulas try to set the same field.
+ (remove-text-properties beg end '(org-untouchable t))
+ (while (setq eq (pop eqlname))
+ (setq name (car eq)
+ a (assoc name org-table-named-field-locations))
+ (setq name1 name)
+ (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
+ (nth 2 a))))
+ (when (member name1 seen-fields)
+ (error "Several field/range formulas try to set %s" name1))
+ (push name1 seen-fields)
+
+ (and (not a)
+ (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
+ (setq a (list name
+ (condition-case nil
+ (aref org-table-dlines
+ (string-to-number (match-string 1 name)))
+ (error (error "Invalid row number in %s"
+ name)))
+ (string-to-number (match-string 2 name)))))
+ (when (and a (or all (equal (nth 1 a) thisline)))
+ (message "Re-applying formula to field: %s" name)
+ (org-goto-line (nth 1 a))
+ (org-table-goto-column (nth 2 a))
+ (push (append a (list (cdr eq))) eqlname1)
+ (org-table-put-field-property :org-untouchable t)))
+ (setq eqlname1 (nreverse eqlname1))
+
+ ;; Now evaluate the column formulas, but skip fields covered by
+ ;; field formulas
+ (goto-char beg)
+ (while (re-search-forward line-re end t)
+ (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
+ ;; Unprotected line, recalculate
+ (and all (message "Re-applying formulas to full table...(line %d)"
+ (setq cnt (1+ cnt))))
+ (setq org-last-recalc-line (org-current-line))
+ (setq eql eqlnum)
+ (while (setq entry (pop eql))
+ (org-goto-line org-last-recalc-line)
+ (org-table-goto-column (string-to-number (car entry)) nil 'force)
+ (unless (get-text-property (point) :org-untouchable)
+ (org-table-eval-formula nil (cdr entry)
+ 'noalign 'nocst 'nostore 'noanalysis)))))
+
+ ;; Now evaluate the field formulas
+ (while (setq eq (pop eqlname1))
+ (message "Re-applying formula to field: %s" (car eq))
+ (org-goto-line (nth 1 eq))
+ (org-table-goto-column (nth 2 eq))
+ (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
+ 'nostore 'noanalysis))
+
+ (org-goto-line thisline)
+ (org-table-goto-column thiscol)
+ (remove-text-properties (point-min) (point-max) '(org-untouchable t))
+ (or noalign (and org-table-may-need-update (org-table-align))
+ (and all (message "Re-applying formulas to %d lines...done" cnt)))
+
+ ;; back to initial position
+ (message "Re-applying formulas...done")
+ (org-goto-line thisline)
+ (org-table-goto-column thiscol)
+ (or noalign (and org-table-may-need-update (org-table-align))
+ (and all (message "Re-applying formulas...done"))))))
+
+(defun org-table-iterate (&optional arg)
+ "Recalculate the table until it does not change anymore.
+The maximum number of iterations is 10, but you can choose a different value
+with the prefix ARG."
+ (interactive "P")
+ (let ((imax (if arg (prefix-numeric-value arg) 10))
+ (i 0)
+ (lasttbl (buffer-substring (org-table-begin) (org-table-end)))
+ thistbl)
+ (catch 'exit
+ (while (< i imax)
+ (setq i (1+ i))
+ (org-table-recalculate 'all)
+ (setq thistbl (buffer-substring (org-table-begin) (org-table-end)))
+ (if (not (string= lasttbl thistbl))
+ (setq lasttbl thistbl)
+ (if (> i 1)
+ (message "Convergence after %d iterations" i)
+ (message "Table was already stable"))
+ (throw 'exit t)))
+ (error "No convergence after %d iterations" i))))
+
+;;;###autoload
+(defun org-table-recalculate-buffer-tables ()
+ "Recalculate all tables in the current buffer."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (org-table-map-tables (lambda () (org-table-recalculate t)) t))))
+
+;;;###autoload
+(defun org-table-iterate-buffer-tables ()
+ "Iterate all tables in the buffer, to converge inter-table dependencies."
+ (interactive)
+ (let* ((imax 10)
+ (checksum (md5 (buffer-string)))
+
+ c1
+ (i imax))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'exit
+ (while (> i 0)
+ (setq i (1- i))
+ (org-table-map-tables (lambda () (org-table-recalculate t)) t)
+ (if (equal checksum (setq c1 (md5 (buffer-string))))
+ (progn
+ (message "Convergence after %d iterations" (- imax i))
+ (throw 'exit t))
+ (setq checksum c1)))
+ (error "No convergence after %d iterations" imax))))))
+
+(defun org-table-expand-lhs-ranges (equations)
+ "Expand list of formulas.
+If some of the RHS in the formulas are ranges or a row reference, expand
+them to individual field equations for each field."
+ (let (e res lhs rhs range r1 r2 c1 c2)
+ (while (setq e (pop equations))
+ (setq lhs (car e) rhs (cdr e))
+ (cond
+ ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs)
+ ;; This just refers to one fixed field
+ (push e res))
+ ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs)
+ ;; This just refers to one fixed named field
+ (push e res))
+ ((string-match "^@[0-9]+$" lhs)
+ (loop for ic from 1 to org-table-current-ncol do
+ (push (cons (format "%s$%d" lhs ic) rhs) res)
+ (put-text-property 0 (length (caar res))
+ :orig-eqn e (caar res))))
+ (t
+ (setq range (org-table-get-range lhs org-table-current-begin-pos
+ 1 nil 'corners))
+ (setq r1 (nth 0 range) c1 (nth 1 range)
+ r2 (nth 2 range) c2 (nth 3 range))
+ (setq r1 (org-table-line-to-dline r1))
+ (setq r2 (org-table-line-to-dline r2 'above))
+ (loop for ir from r1 to r2 do
+ (loop for ic from c1 to c2 do
+ (push (cons (format "@%d$%d" ir ic) rhs) res)
+ (put-text-property 0 (length (caar res))
+ :orig-eqn e (caar res)))))))
+ (nreverse res)))
+
+(defun org-table-formula-handle-first/last-rc (s)
+ "Replace @<, @>, $<, $> with first/last row/column of the table.
+So @< and $< will always be replaced with @1 and $1, respectively.
+The advantage of these special markers are that structure editing of
+the table will not change them, while @1 and $1 will be modified
+when a line/row is swapped out of that privileged position. So for
+formulas that use a range of rows or columns, it may often be better
+to anchor the formula with \"I\" row markers, or to offset from the
+borders of the table using the @< @> $< $> makers."
+ (let (n nmax len char (start 0))
+ (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)"
+ s start)
+ (if (match-end 3)
+ (setq start (match-end 3))
+ (setq nmax (if (equal (match-string 1 s) "@")
+ (1- (length org-table-dlines))
+ org-table-current-ncol)
+ len (- (match-end 2) (match-beginning 2))
+ char (string-to-char (match-string 2 s))
+ n (if (= char ?<)
+ len
+ (- nmax len -1)))
+ (if (or (< n 1) (> n nmax))
+ (error "Reference \"%s\" in expression \"%s\" points outside table"
+ (match-string 0 s) s))
+ (setq start (match-beginning 0))
+ (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
+ s)
+
+(defun org-table-formula-substitute-names (f)
+ "Replace $const with values in string F."
+ (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
+ ;; First, check for column names
+ (while (setq start (string-match org-table-column-name-regexp f start))
+ (setq start (1+ start))
+ (setq a (assoc (match-string 1 f) org-table-column-names))
+ (setq f (replace-match (concat "$" (cdr a)) t t f)))
+ ;; Parameters and constants
+ (setq start 0)
+ (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start))
+ (if (match-end 2)
+ (setq start (match-end 2))
+ (setq start (1+ start))
+ (if (setq a (save-match-data
+ (org-table-get-constant (match-string 1 f))))
+ (setq f (replace-match
+ (concat (if pp "(") a (if pp ")")) t t f)))))
+ (if org-table-formula-debug
+ (put-text-property 0 (length f) :orig-formula f1 f))
+ f))
+
+(defun org-table-get-constant (const)
+ "Find the value for a parameter or constant in a formula.
+Parameters get priority."
+ (or (cdr (assoc const org-table-local-parameters))
+ (cdr (assoc const org-table-formula-constants-local))
+ (cdr (assoc const org-table-formula-constants))
+ (and (fboundp 'constants-get) (constants-get const))
+ (and (string= (substring const 0 (min 5 (length const))) "PROP_")
+ (org-entry-get nil (substring const 5) 'inherit))
+ "#UNDEFINED_NAME"))
+
+(defvar org-table-fedit-map
+ (let ((map (make-sparse-keymap)))
+ (org-defkey map "\C-x\C-s" 'org-table-fedit-finish)
+ (org-defkey map "\C-c\C-s" 'org-table-fedit-finish)
+ (org-defkey map "\C-c\C-c" 'org-table-fedit-finish)
+ (org-defkey map "\C-c'" 'org-table-fedit-finish)
+ (org-defkey map "\C-c\C-q" 'org-table-fedit-abort)
+ (org-defkey map "\C-c?" 'org-table-show-reference)
+ (org-defkey map [(meta shift up)] 'org-table-fedit-line-up)
+ (org-defkey map [(meta shift down)] 'org-table-fedit-line-down)
+ (org-defkey map [(shift up)] 'org-table-fedit-ref-up)
+ (org-defkey map [(shift down)] 'org-table-fedit-ref-down)
+ (org-defkey map [(shift left)] 'org-table-fedit-ref-left)
+ (org-defkey map [(shift right)] 'org-table-fedit-ref-right)
+ (org-defkey map [(meta up)] 'org-table-fedit-scroll-down)
+ (org-defkey map [(meta down)] 'org-table-fedit-scroll)
+ (org-defkey map [(meta tab)] 'lisp-complete-symbol)
+ (org-defkey map "\M-\C-i" 'lisp-complete-symbol)
+ (org-defkey map [(tab)] 'org-table-fedit-lisp-indent)
+ (org-defkey map "\C-i" 'org-table-fedit-lisp-indent)
+ (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
+ (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates)
+ map))
+
+(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
+ '("Edit-Formulas"
+ ["Finish and Install" org-table-fedit-finish t]
+ ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
+ ["Abort" org-table-fedit-abort t]
+ "--"
+ ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
+ ["Complete Lisp Symbol" lisp-complete-symbol t]
+ "--"
+ "Shift Reference at Point"
+ ["Up" org-table-fedit-ref-up t]
+ ["Down" org-table-fedit-ref-down t]
+ ["Left" org-table-fedit-ref-left t]
+ ["Right" org-table-fedit-ref-right t]
+ "-"
+ "Change Test Row for Column Formulas"
+ ["Up" org-table-fedit-line-up t]
+ ["Down" org-table-fedit-line-down t]
+ "--"
+ ["Scroll Table Window" org-table-fedit-scroll t]
+ ["Scroll Table Window down" org-table-fedit-scroll-down t]
+ ["Show Table Grid" org-table-fedit-toggle-coordinates
+ :style toggle :selected (with-current-buffer (marker-buffer org-pos)
+ org-table-overlay-coordinates)]
+ "--"
+ ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
+ :style toggle :selected org-table-buffer-is-an]))
+
+(defvar org-pos)
+
+(defun org-table-edit-formulas ()
+ "Edit the formulas of the current table in a separate buffer."
+ (interactive)
+ (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
+ (beginning-of-line 0))
+ (unless (org-at-table-p) (error "Not at a table"))
+ (org-table-get-specials)
+ (let ((key (org-table-current-field-formula 'key 'noerror))
+ (eql (sort (org-table-get-stored-formulas 'noerror)
+ 'org-table-formula-less-p))
+ (pos (move-marker (make-marker) (point)))
+ (startline 1)
+ (wc (current-window-configuration))
+ (sel-win (selected-window))
+ (titles '((column . "# Column Formulas\n")
+ (field . "# Field and Range Formulas\n")
+ (named . "# Named Field Formulas\n")))
+ entry s type title)
+ (org-switch-to-buffer-other-window "*Edit Formulas*")
+ (erase-buffer)
+ ;; Keep global-font-lock-mode from turning on font-lock-mode
+ (let ((font-lock-global-modes '(not fundamental-mode)))
+ (fundamental-mode))
+ (org-set-local 'font-lock-global-modes (list 'not major-mode))
+ (org-set-local 'org-pos pos)
+ (org-set-local 'org-window-configuration wc)
+ (org-set-local 'org-selected-window sel-win)
+ (use-local-map org-table-fedit-map)
+ (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t)
+ (easy-menu-add org-table-fedit-menu)
+ (setq startline (org-current-line))
+ (while (setq entry (pop eql))
+ (setq type (cond
+ ((string-match "\\`$[<>]" (car entry)) 'column)
+ ((equal (string-to-char (car entry)) ?@) 'field)
+ ((string-match "^[0-9]" (car entry)) 'column)
+ (t 'named)))
+ (when (setq title (assq type titles))
+ (or (bobp) (insert "\n"))
+ (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
+ (setq titles (remove title titles)))
+ (if (equal key (car entry)) (setq startline (org-current-line)))
+ (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
+ (car entry) " = " (cdr entry) "\n"))
+ (remove-text-properties 0 (length s) '(face nil) s)
+ (insert s))
+ (if (eq org-table-use-standard-references t)
+ (org-table-fedit-toggle-ref-type))
+ (org-goto-line startline)
+ (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands.")))
+
+(defun org-table-fedit-post-command ()
+ (when (not (memq this-command '(lisp-complete-symbol)))
+ (let ((win (selected-window)))
+ (save-excursion
+ (condition-case nil
+ (org-table-show-reference)
+ (error nil))
+ (select-window win)))))
+
+(defun org-table-formula-to-user (s)
+ "Convert a formula from internal to user representation."
+ (if (eq org-table-use-standard-references t)
+ (org-table-convert-refs-to-an s)
+ s))
+
+(defun org-table-formula-from-user (s)
+ "Convert a formula from user to internal representation."
+ (if org-table-use-standard-references
+ (org-table-convert-refs-to-rc s)
+ s))
+
+(defun org-table-convert-refs-to-rc (s)
+ "Convert spreadsheet references from A7 to @7$28.
+Works for single references, but also for entire formulas and even the
+full TBLFM line."
+ (let ((start 0))
+ (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start)
+ (cond
+ ((match-end 3)
+ ;; format match, just advance
+ (setq start (match-end 0)))
+ ((and (> (match-beginning 0) 0)
+ (equal ?. (aref s (max (1- (match-beginning 0)) 0)))
+ (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0)))))
+ ;; 3.e5 or something like this.
+ (setq start (match-end 0)))
+ ((or (> (- (match-end 1) (match-beginning 1)) 2)
+ ;; (member (match-string 1 s)
+ ;; '("arctan" "exp" "expm" "lnp" "log" "stir"))
+ )
+ ;; function name, just advance
+ (setq start (match-end 0)))
+ (t
+ (setq start (match-beginning 0)
+ s (replace-match
+ (if (equal (match-string 2 s) "&")
+ (format "$%d" (org-letters-to-number (match-string 1 s)))
+ (format "@%d$%d"
+ (string-to-number (match-string 2 s))
+ (org-letters-to-number (match-string 1 s))))
+ t t s)))))
+ s))
+
+(defun org-table-convert-refs-to-an (s)
+ "Convert spreadsheet references from to @7$28 to AB7.
+Works for single references, but also for entire formulas and even the
+full TBLFM line."
+ (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s)
+ (setq s (replace-match
+ (format "%s%d"
+ (org-number-to-letters
+ (string-to-number (match-string 2 s)))
+ (string-to-number (match-string 1 s)))
+ t t s)))
+ (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s)
+ (setq s (replace-match (concat "\\1"
+ (org-number-to-letters
+ (string-to-number (match-string 2 s))) "&")
+ t nil s)))
+ s)
+
+(defun org-letters-to-number (s)
+ "Convert a base 26 number represented by letters into an integer.
+For example: AB -> 28."
+ (let ((n 0))
+ (setq s (upcase s))
+ (while (> (length s) 0)
+ (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
+ s (substring s 1)))
+ n))
+
+(defun org-number-to-letters (n)
+ "Convert an integer into a base 26 number represented by letters.
+For example: 28 -> AB."
+ (let ((s ""))
+ (while (> n 0)
+ (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s)
+ n (/ (1- n) 26)))
+ s))
+
+(defun org-table-time-string-to-seconds (s)
+ "Convert a time string into numerical duration in seconds.
+S can be a string matching either -?HH:MM:SS or -?HH:MM.
+If S is a string representing a number, keep this number."
+ (if (equal s "")
+ s
+ (let (hour minus min sec res)
+ (cond
+ ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s))
+ sec (string-to-number (match-string 4 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60) sec)))
+ (setq res (+ (* hour 3600) (* min 60) sec))))
+ ((and (not (string-match org-ts-regexp-both s))
+ (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
+ (setq minus (< 0 (length (match-string 1 s)))
+ hour (string-to-number (match-string 2 s))
+ min (string-to-number (match-string 3 s)))
+ (if minus
+ (setq res (- (+ (* hour 3600) (* min 60))))
+ (setq res (+ (* hour 3600) (* min 60)))))
+ (t (setq res (string-to-number s))))
+ (number-to-string res))))
+
+(defun org-table-time-seconds-to-string (secs &optional output-format)
+ "Convert a number of seconds to a time string.
+If OUTPUT-FORMAT is non-nil, return a number of days, hours,
+minutes or seconds."
+ (let* ((secs0 (abs secs))
+ (res
+ (cond ((eq output-format 'days)
+ (format "%.3f" (/ (float secs0) 86400)))
+ ((eq output-format 'hours)
+ (format "%.2f" (/ (float secs0) 3600)))
+ ((eq output-format 'minutes)
+ (format "%.1f" (/ (float secs0) 60)))
+ ((eq output-format 'seconds)
+ (format "%d" secs0))
+ (t (org-format-seconds "%.2h:%.2m:%.2s" secs0)))))
+ (if (< secs 0) (concat "-" res) res)))
+
+(defun org-table-fedit-convert-buffer (function)
+ "Convert all references in this buffer, using FUNCTION."
+ (let ((line (org-current-line)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert (funcall function (buffer-substring (point) (point-at-eol))))
+ (delete-region (point) (point-at-eol))
+ (or (eobp) (forward-char 1)))
+ (org-goto-line line)))
+
+(defun org-table-fedit-toggle-ref-type ()
+ "Convert all references in the buffer from B3 to @3$2 and back."
+ (interactive)
+ (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an))
+ (org-table-fedit-convert-buffer
+ (if org-table-buffer-is-an
+ 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
+ (message "Reference type switched to %s"
+ (if org-table-buffer-is-an "A1 etc" "@row$column")))
+
+(defun org-table-fedit-ref-up ()
+ "Shift the reference at point one row/hline up."
+ (interactive)
+ (org-table-fedit-shift-reference 'up))
+(defun org-table-fedit-ref-down ()
+ "Shift the reference at point one row/hline down."
+ (interactive)
+ (org-table-fedit-shift-reference 'down))
+(defun org-table-fedit-ref-left ()
+ "Shift the reference at point one field to the left."
+ (interactive)
+ (org-table-fedit-shift-reference 'left))
+(defun org-table-fedit-ref-right ()
+ "Shift the reference at point one field to the right."
+ (interactive)
+ (org-table-fedit-shift-reference 'right))
+
+(defun org-table-fedit-shift-reference (dir)
+ (cond
+ ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&")
+ (if (memq dir '(left right))
+ (org-rematch-and-replace 1 (eq dir 'left))
+ (error "Cannot shift reference in this direction")))
+ ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
+ ;; A B3-like reference
+ (if (memq dir '(up down))
+ (org-rematch-and-replace 2 (eq dir 'up))
+ (org-rematch-and-replace 1 (eq dir 'left))))
+ ((org-at-regexp-p
+ "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
+ ;; An internal reference
+ (if (memq dir '(up down))
+ (org-rematch-and-replace 2 (eq dir 'up) (match-end 3))
+ (org-rematch-and-replace 5 (eq dir 'left))))))
+
+(defun org-rematch-and-replace (n &optional decr hline)
+ "Re-match the group N, and replace it with the shifted reference."
+ (or (match-end n) (error "Cannot shift reference in this direction"))
+ (goto-char (match-beginning n))
+ (and (looking-at (regexp-quote (match-string n)))
+ (replace-match (org-table-shift-refpart (match-string 0) decr hline)
+ t t)))
+
+(defun org-table-shift-refpart (ref &optional decr hline)
+ "Shift a reference part REF.
+If DECR is set, decrease the references row/column, else increase.
+If HLINE is set, this may be a hline reference, it certainly is not
+a translation reference."
+ (save-match-data
+ (let* ((sign (string-match "^[-+]" ref)) n)
+
+ (if sign (setq sign (substring ref 0 1) ref (substring ref 1)))
+ (cond
+ ((and hline (string-match "^I+" ref))
+ (setq n (string-to-number (concat sign (number-to-string (length ref)))))
+ (setq n (+ n (if decr -1 1)))
+ (if (= n 0) (setq n (+ n (if decr -1 1))))
+ (if sign
+ (setq sign (if (< n 0) "-" "+") n (abs n))
+ (setq n (max 1 n)))
+ (concat sign (make-string n ?I)))
+
+ ((string-match "^[0-9]+" ref)
+ (setq n (string-to-number (concat sign ref)))
+ (setq n (+ n (if decr -1 1)))
+ (if sign
+ (concat (if (< n 0) "-" "+") (number-to-string (abs n)))
+ (number-to-string (max 1 n))))
+
+ ((string-match "^[a-zA-Z]+" ref)
+ (org-number-to-letters
+ (max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
+
+ (t (error "Cannot shift reference"))))))
+
+(defun org-table-fedit-toggle-coordinates ()
+ "Toggle the display of coordinates in the referenced table."
+ (interactive)
+ (let ((pos (marker-position org-pos)))
+ (with-current-buffer (marker-buffer org-pos)
+ (save-excursion
+ (goto-char pos)
+ (org-table-toggle-coordinate-overlays)))))
+
+(defun org-table-fedit-finish (&optional arg)
+ "Parse the buffer for formula definitions and install them.
+With prefix ARG, apply the new formulas to the table."
+ (interactive "P")
+ (org-table-remove-rectangle-highlight)
+ (if org-table-use-standard-references
+ (progn
+ (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
+ (setq org-table-buffer-is-an nil)))
+ (let ((pos org-pos) (sel-win org-selected-window) eql var form)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
+ nil t)
+ (setq var (if (match-end 2) (match-string 2) (match-string 1))
+ form (match-string 3))
+ (setq form (org-trim form))
+ (when (not (equal form ""))
+ (while (string-match "[ \t]*\n[ \t]*" form)
+ (setq form (replace-match " " t t form)))
+ (when (assoc var eql)
+ (error "Double formulas for %s" var))
+ (push (cons var form) eql)))
+ (setq org-pos nil)
+ (set-window-configuration org-window-configuration)
+ (select-window sel-win)
+ (goto-char pos)
+ (unless (org-at-table-p)
+ (error "Lost table position - cannot install formulas"))
+ (org-table-store-formulas eql)
+ (move-marker pos nil)
+ (kill-buffer "*Edit Formulas*")
+ (if arg
+ (org-table-recalculate 'all)
+ (message "New formulas installed - press C-u C-c C-c to apply."))))
+
+(defun org-table-fedit-abort ()
+ "Abort editing formulas, without installing the changes."
+ (interactive)
+ (org-table-remove-rectangle-highlight)
+ (let ((pos org-pos) (sel-win org-selected-window))
+ (set-window-configuration org-window-configuration)
+ (select-window sel-win)
+ (goto-char pos)
+ (move-marker pos nil)
+ (message "Formula editing aborted without installing changes")))
+
+(defun org-table-fedit-lisp-indent ()
+ "Pretty-print and re-indent Lisp expressions in the Formula Editor."
+ (interactive)
+ (let ((pos (point)) beg end ind)
+ (beginning-of-line 1)
+ (cond
+ ((looking-at "[ \t]")
+ (goto-char pos)
+ (call-interactively 'lisp-indent-line))
+ ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
+ ((not (fboundp 'pp-buffer))
+ (error "Cannot pretty-print. Command `pp-buffer' is not available"))
+ ((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
+ (goto-char (- (match-end 0) 2))
+ (setq beg (point))
+ (setq ind (make-string (current-column) ?\ ))
+ (condition-case nil (forward-sexp 1)
+ (error
+ (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
+ (setq end (point))
+ (save-restriction
+ (narrow-to-region beg end)
+ (if (eq last-command this-command)
+ (progn
+ (goto-char (point-min))
+ (setq this-command nil)
+ (while (re-search-forward "[ \t]*\n[ \t]*" nil t)
+ (replace-match " ")))
+ (pp-buffer)
+ (untabify (point-min) (point-max))
+ (goto-char (1+ (point-min)))
+ (while (re-search-forward "^." nil t)
+ (beginning-of-line 1)
+ (insert ind))
+ (goto-char (point-max))
+ (backward-delete-char 1)))
+ (goto-char beg))
+ (t nil))))
+
+(defvar org-show-positions nil)
+
+(defun org-table-show-reference (&optional local)
+ "Show the location/value of the $ expression at point."
+ (interactive)
+ (org-table-remove-rectangle-highlight)
+ (catch 'exit
+ (let ((pos (if local (point) org-pos))
+ (face2 'highlight)
+ (org-inhibit-highlight-removal t)
+ (win (selected-window))
+ (org-show-positions nil)
+ var name e what match dest)
+ (if local (org-table-get-specials))
+ (setq what (cond
+ ((org-at-regexp-p "^@[0-9]+[ \t=]")
+ (setq match (concat (substring (match-string 0) 0 -1)
+ "$1.."
+ (substring (match-string 0) 0 -1)
+ "$100"))
+ 'range)
+ ((or (org-at-regexp-p org-table-range-regexp2)
+ (org-at-regexp-p org-table-translate-regexp)
+ (org-at-regexp-p org-table-range-regexp))
+ (setq match
+ (save-match-data
+ (org-table-convert-refs-to-rc (match-string 0))))
+ 'range)
+ ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
+ ((org-at-regexp-p "\\$[0-9]+") 'column)
+ ((not local) nil)
+ (t (error "No reference at point")))
+ match (and what (or match (match-string 0))))
+ (when (and match (not (equal (match-beginning 0) (point-at-bol))))
+ (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
+ 'secondary-selection))
+ (org-add-hook 'before-change-functions
+ 'org-table-remove-rectangle-highlight)
+ (if (eq what 'name) (setq var (substring match 1)))
+ (when (eq what 'range)
+ (or (equal (string-to-char match) ?@) (setq match (concat "@" match)))
+ (setq match (org-table-formula-substitute-names match)))
+ (unless local
+ (save-excursion
+ (end-of-line 1)
+ (re-search-backward "^\\S-" nil t)
+ (beginning-of-line 1)
+ (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=")
+ (setq dest
+ (save-match-data
+ (org-table-convert-refs-to-rc (match-string 1))))
+ (org-table-add-rectangle-overlay
+ (match-beginning 1) (match-end 1) face2))))
+ (if (and (markerp pos) (marker-buffer pos))
+ (if (get-buffer-window (marker-buffer pos))
+ (select-window (get-buffer-window (marker-buffer pos)))
+ (org-switch-to-buffer-other-window (get-buffer-window
+ (marker-buffer pos)))))
+ (goto-char pos)
+ (org-table-force-dataline)
+ (when dest
+ (setq name (substring dest 1))
+ (cond
+ ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest)
+ (setq e (assoc name org-table-named-field-locations))
+ (org-goto-line (nth 1 e))
+ (org-table-goto-column (nth 2 e)))
+ ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest)
+ (let ((l (string-to-number (match-string 1 dest)))
+ (c (string-to-number (match-string 2 dest))))
+ (org-goto-line (aref org-table-dlines l))
+ (org-table-goto-column c)))
+ (t (org-table-goto-column (string-to-number name))))
+ (move-marker pos (point))
+ (org-table-highlight-rectangle nil nil face2))
+ (cond
+ ((equal dest match))
+ ((not match))
+ ((eq what 'range)
+ (condition-case nil
+ (save-excursion
+ (org-table-get-range match nil nil 'highlight))
+ (error nil)))
+ ((setq e (assoc var org-table-named-field-locations))
+ (org-goto-line (nth 1 e))
+ (org-table-goto-column (nth 2 e))
+ (org-table-highlight-rectangle (point) (point))
+ (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
+ ((setq e (assoc var org-table-column-names))
+ (org-table-goto-column (string-to-number (cdr e)))
+ (org-table-highlight-rectangle (point) (point))
+ (goto-char (org-table-begin))
+ (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
+ (org-table-end) t)
+ (progn
+ (goto-char (match-beginning 1))
+ (org-table-highlight-rectangle)
+ (message "Named column (column %s)" (cdr e)))
+ (error "Column name not found")))
+ ((eq what 'column)
+ ;; column number
+ (org-table-goto-column (string-to-number (substring match 1)))
+ (org-table-highlight-rectangle (point) (point))
+ (message "Column %s" (substring match 1)))
+ ((setq e (assoc var org-table-local-parameters))
+ (goto-char (org-table-begin))
+ (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
+ (progn
+ (goto-char (match-beginning 1))
+ (org-table-highlight-rectangle)
+ (message "Local parameter."))
+ (error "Parameter not found")))
+ (t
+ (cond
+ ((not var) (error "No reference at point"))
+ ((setq e (assoc var org-table-formula-constants-local))
+ (message "Local Constant: $%s=%s in #+CONSTANTS line."
+ var (cdr e)))
+ ((setq e (assoc var org-table-formula-constants))
+ (message "Constant: $%s=%s in `org-table-formula-constants'."
+ var (cdr e)))
+ ((setq e (and (fboundp 'constants-get) (constants-get var)))
+ (message "Constant: $%s=%s, from `constants.el'%s."
+ var e (format " (%s units)" constants-unit-system)))
+ (t (error "Undefined name $%s" var)))))
+ (goto-char pos)
+ (when (and org-show-positions
+ (not (memq this-command '(org-table-fedit-scroll
+ org-table-fedit-scroll-down))))
+ (push pos org-show-positions)
+ (push org-table-current-begin-pos org-show-positions)
+ (let ((min (apply 'min org-show-positions))
+ (max (apply 'max org-show-positions)))
+ (goto-char min) (recenter 0)
+ (goto-char max)
+ (or (pos-visible-in-window-p max) (recenter -1))))
+ (select-window win))))
+
+(defun org-table-force-dataline ()
+ "Make sure the cursor is in a dataline in a table."
+ (unless (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-table-dataline-regexp))
+ (let* ((re org-table-dataline-regexp)
+ (p1 (save-excursion (re-search-forward re nil 'move)))
+ (p2 (save-excursion (re-search-backward re nil 'move))))
+ (cond ((and p1 p2)
+ (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
+ p1 p2)))
+ ((or p1 p2) (goto-char (or p1 p2)))
+ (t (error "No table dataline around here"))))))
+
+(defun org-table-fedit-line-up ()
+ "Move cursor one line up in the window showing the table."
+ (interactive)
+ (org-table-fedit-move 'previous-line))
+
+(defun org-table-fedit-line-down ()
+ "Move cursor one line down in the window showing the table."
+ (interactive)
+ (org-table-fedit-move 'next-line))
+
+(defun org-table-fedit-move (command)
+ "Move the cursor in the window showing the table.
+Use COMMAND to do the motion, repeat if necessary to end up in a data line."
+ (let ((org-table-allow-automatic-line-recalculation nil)
+ (pos org-pos) (win (selected-window)) p)
+ (select-window (get-buffer-window (marker-buffer org-pos)))
+ (setq p (point))
+ (call-interactively command)
+ (while (and (org-at-table-p)
+ (org-at-table-hline-p))
+ (call-interactively command))
+ (or (org-at-table-p) (goto-char p))
+ (move-marker pos (point))
+ (select-window win)))
+
+(defun org-table-fedit-scroll (N)
+ (interactive "p")
+ (let ((other-window-scroll-buffer (marker-buffer org-pos)))
+ (scroll-other-window N)))
+
+(defun org-table-fedit-scroll-down (N)
+ (interactive "p")
+ (org-table-fedit-scroll (- N)))
+
+(defvar org-table-rectangle-overlays nil)
+
+(defun org-table-add-rectangle-overlay (beg end &optional face)
+ "Add a new overlay."
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face (or face 'secondary-selection))
+ (push ov org-table-rectangle-overlays)))
+
+(defun org-table-highlight-rectangle (&optional beg end face)
+ "Highlight rectangular region in a table."
+ (setq beg (or beg (point)) end (or end (point)))
+ (let ((b (min beg end))
+ (e (max beg end))
+ l1 c1 l2 c2 tmp)
+ (and (boundp 'org-show-positions)
+ (setq org-show-positions (cons b (cons e org-show-positions))))
+ (goto-char (min beg end))
+ (setq l1 (org-current-line)
+ c1 (org-table-current-column))
+ (goto-char (max beg end))
+ (setq l2 (org-current-line)
+ c2 (org-table-current-column))
+ (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp))
+ (org-goto-line l1)
+ (beginning-of-line 1)
+ (loop for line from l1 to l2 do
+ (when (looking-at org-table-dataline-regexp)
+ (org-table-goto-column c1)
+ (skip-chars-backward "^|\n") (setq beg (point))
+ (org-table-goto-column c2)
+ (skip-chars-forward "^|\n") (setq end (point))
+ (org-table-add-rectangle-overlay beg end face))
+ (beginning-of-line 2))
+ (goto-char b))
+ (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight))
+
+(defun org-table-remove-rectangle-highlight (&rest ignore)
+ "Remove the rectangle overlays."
+ (unless org-inhibit-highlight-removal
+ (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
+ (mapc 'delete-overlay org-table-rectangle-overlays)
+ (setq org-table-rectangle-overlays nil)))
+
+(defvar org-table-coordinate-overlays nil
+ "Collects the coordinate grid overlays, so that they can be removed.")
+(make-variable-buffer-local 'org-table-coordinate-overlays)
+
+(defun org-table-overlay-coordinates ()
+ "Add overlays to the table at point, to show row/column coordinates."
+ (interactive)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil)
+ (save-excursion
+ (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
+ (goto-char (org-table-begin))
+ (while (org-at-table-p)
+ (setq eol (point-at-eol))
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol))))
+ (push ov org-table-coordinate-overlays)
+ (setq hline (looking-at org-table-hline-regexp))
+ (setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
+ (format "%4d" (setq id (1+ id)))))
+ (org-overlay-before-string ov str 'org-special-keyword 'evaporate)
+ (when hline
+ (setq ic 0)
+ (while (re-search-forward "[+|]\\(-+\\)" eol t)
+ (setq beg (1+ (match-beginning 0))
+ ic (1+ ic)
+ s1 (concat "$" (int-to-string ic))
+ s2 (org-number-to-letters ic)
+ str (if (eq org-table-use-standard-references t) s2 s1))
+ (setq ov (make-overlay beg (+ beg (length str))))
+ (push ov org-table-coordinate-overlays)
+ (org-overlay-display ov str 'org-special-keyword 'evaporate)))
+ (beginning-of-line 2)))))
+
+(defun org-table-toggle-coordinate-overlays ()
+ "Toggle the display of Row/Column numbers in tables."
+ (interactive)
+ (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
+ (message "Tables Row/Column numbers display turned %s"
+ (if org-table-overlay-coordinates "on" "off"))
+ (if (and (org-at-table-p) org-table-overlay-coordinates)
+ (org-table-align))
+ (unless org-table-overlay-coordinates
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil)))
+
+(defun org-table-toggle-formula-debugger ()
+ "Toggle the formula debugger in tables."
+ (interactive)
+ (setq org-table-formula-debug (not org-table-formula-debug))
+ (message "Formula debugging has been turned %s"
+ (if org-table-formula-debug "on" "off")))
+
+;;; The orgtbl minor mode
+
+;; Define a minor mode which can be used in other modes in order to
+;; integrate the org-mode table editor.
+
+;; This is really a hack, because the org-mode table editor uses several
+;; keys which normally belong to the major mode, for example the TAB and
+;; RET keys. Here is how it works: The minor mode defines all the keys
+;; necessary to operate the table editor, but wraps the commands into a
+;; function which tests if the cursor is currently inside a table. If that
+;; is the case, the table editor command is executed. However, when any of
+;; those keys is used outside a table, the function uses `key-binding' to
+;; look up if the key has an associated command in another currently active
+;; keymap (minor modes, major mode, global), and executes that command.
+;; There might be problems if any of the keys used by the table editor is
+;; otherwise used as a prefix key.
+
+;; Another challenge is that the key binding for TAB can be tab or \C-i,
+;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
+;; addresses this by checking explicitly for both bindings.
+
+;; The optimized version (see variable `orgtbl-optimized') takes over
+;; all keys which are bound to `self-insert-command' in the *global map*.
+;; Some modes bind other commands to simple characters, for example
+;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
+;; active, this binding is ignored inside tables and replaced with a
+;; modified self-insert.
+
+
+(defvar orgtbl-mode-map (make-keymap)
+ "Keymap for `orgtbl-mode'.")
+
+;;;###autoload
+(defun turn-on-orgtbl ()
+ "Unconditionally turn on `orgtbl-mode'."
+ (orgtbl-mode 1))
+
+(defvar org-old-auto-fill-inhibit-regexp nil
+ "Local variable used by `orgtbl-mode'.")
+
+(defconst orgtbl-line-start-regexp
+ "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)"
+ "Matches a line belonging to an orgtbl.")
+
+(defconst orgtbl-extra-font-lock-keywords
+ (list (list (concat "^" orgtbl-line-start-regexp ".*")
+ 0 (quote 'org-table) 'prepend))
+ "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.")
+
+;; Install it as a minor mode.
+(put 'orgtbl-mode :included t)
+(put 'orgtbl-mode :menu-tag "Org Table Mode")
+
+;;;###autoload
+(define-minor-mode orgtbl-mode
+ "The `org-mode' table editor as a minor mode for use in other modes."
+ :lighter " OrgTbl" :keymap orgtbl-mode-map
+ (org-load-modules-maybe)
+ (cond
+ ((derived-mode-p 'org-mode)
+ ;; Exit without error, in case some hook functions calls this
+ ;; by accident in org-mode.
+ (message "Orgtbl-mode is not useful in org-mode, command ignored"))
+ (orgtbl-mode
+ (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?!
+ ;; Make sure we are first in minor-mode-map-alist
+ (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
+ ;; FIXME: maybe it should use emulation-mode-map-alists?
+ (and c (setq minor-mode-map-alist
+ (cons c (delq c minor-mode-map-alist)))))
+ (org-set-local (quote org-table-may-need-update) t)
+ (org-add-hook 'before-change-functions 'org-before-change-function
+ nil 'local)
+ (org-set-local 'org-old-auto-fill-inhibit-regexp
+ auto-fill-inhibit-regexp)
+ (org-set-local 'auto-fill-inhibit-regexp
+ (if auto-fill-inhibit-regexp
+ (concat orgtbl-line-start-regexp "\\|"
+ auto-fill-inhibit-regexp)
+ orgtbl-line-start-regexp))
+ (add-to-invisibility-spec '(org-cwidth))
+ (when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock))
+ (easy-menu-add orgtbl-mode-menu))
+ (t
+ (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
+ (org-table-cleanup-narrow-column-properties)
+ (org-remove-from-invisibility-spec '(org-cwidth))
+ (remove-hook 'before-change-functions 'org-before-change-function t)
+ (when (fboundp 'font-lock-remove-keywords)
+ (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
+ (org-restart-font-lock))
+ (easy-menu-remove orgtbl-mode-menu)
+ (force-mode-line-update 'all))))
+
+(defun org-table-cleanup-narrow-column-properties ()
+ "Remove all properties related to narrow-column invisibility."
+ (let ((s (point-min)))
+ (while (setq s (text-property-any s (point-max)
+ 'display org-narrow-column-arrow))
+ (remove-text-properties s (1+ s) '(display t)))
+ (setq s (point-min))
+ (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
+ (remove-text-properties s (1+ s) '(org-cwidth t)))
+ (setq s (point-min))
+ (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
+ (remove-text-properties s (1+ s) '(invisible t)))))
+
+(defun orgtbl-make-binding (fun n &rest keys)
+ "Create a function for binding in the table minor mode.
+FUN is the command to call inside a table. N is used to create a unique
+command name. KEYS are keys that should be checked in for a command
+to execute outside of tables."
+ (eval
+ (list 'defun
+ (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
+ '(arg)
+ (concat "In tables, run `" (symbol-name fun) "'.\n"
+ "Outside of tables, run the binding of `"
+ (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
+ "'.")
+ '(interactive "p")
+ (list 'if
+ '(org-at-table-p)
+ (list 'call-interactively (list 'quote fun))
+ (list 'let '(orgtbl-mode)
+ (list 'call-interactively
+ (append '(or)
+ (mapcar (lambda (k)
+ (list 'key-binding k))
+ keys)
+ '('orgtbl-error))))))))
+
+(defun orgtbl-error ()
+ "Error when there is no default binding for a table key."
+ (interactive)
+ (error "This key has no function outside tables"))
+
+(defun orgtbl-setup ()
+ "Setup orgtbl keymaps."
+ (let ((nfunc 0)
+ (bindings
+ '(([(meta shift left)] org-table-delete-column)
+ ([(meta left)] org-table-move-column-left)
+ ([(meta right)] org-table-move-column-right)
+ ([(meta shift right)] org-table-insert-column)
+ ([(meta shift up)] org-table-kill-row)
+ ([(meta shift down)] org-table-insert-row)
+ ([(meta up)] org-table-move-row-up)
+ ([(meta down)] org-table-move-row-down)
+ ("\C-c\C-w" org-table-cut-region)
+ ("\C-c\M-w" org-table-copy-region)
+ ("\C-c\C-y" org-table-paste-rectangle)
+ ("\C-c\C-w" org-table-wrap-region)
+ ("\C-c-" org-table-insert-hline)
+ ("\C-c}" org-table-toggle-coordinate-overlays)
+ ("\C-c{" org-table-toggle-formula-debugger)
+ ("\C-m" org-table-next-row)
+ ([(shift return)] org-table-copy-down)
+ ("\C-c?" org-table-field-info)
+ ("\C-c " org-table-blank-field)
+ ("\C-c+" org-table-sum)
+ ("\C-c=" org-table-eval-formula)
+ ("\C-c'" org-table-edit-formulas)
+ ("\C-c`" org-table-edit-field)
+ ("\C-c*" org-table-recalculate)
+ ("\C-c^" org-table-sort-lines)
+ ("\M-a" org-table-beginning-of-field)
+ ("\M-e" org-table-end-of-field)
+ ([(control ?#)] org-table-rotate-recalc-marks)))
+ elt key fun cmd)
+ (while (setq elt (pop bindings))
+ (setq nfunc (1+ nfunc))
+ (setq key (org-key (car elt))
+ fun (nth 1 elt)
+ cmd (orgtbl-make-binding fun nfunc key))
+ (org-defkey orgtbl-mode-map key cmd))
+
+ ;; Special treatment needed for TAB and RET
+ (org-defkey orgtbl-mode-map [(return)]
+ (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
+ (org-defkey orgtbl-mode-map "\C-m"
+ (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
+
+ (org-defkey orgtbl-mode-map [(tab)]
+ (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
+ (org-defkey orgtbl-mode-map "\C-i"
+ (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
+
+ (org-defkey orgtbl-mode-map [(shift tab)]
+ (orgtbl-make-binding 'org-table-previous-field 104
+ [(shift tab)] [(tab)] "\C-i"))
+
+
+ (unless (featurep 'xemacs)
+ (org-defkey orgtbl-mode-map [S-iso-lefttab]
+ (orgtbl-make-binding 'org-table-previous-field 107
+ [S-iso-lefttab] [backtab] [(shift tab)]
+ [(tab)] "\C-i")))
+
+ (org-defkey orgtbl-mode-map [backtab]
+ (orgtbl-make-binding 'org-table-previous-field 108
+ [backtab] [S-iso-lefttab] [(shift tab)]
+ [(tab)] "\C-i"))
+
+ (org-defkey orgtbl-mode-map "\M-\C-m"
+ (orgtbl-make-binding 'org-table-wrap-region 105
+ "\M-\C-m" [(meta return)]))
+ (org-defkey orgtbl-mode-map [(meta return)]
+ (orgtbl-make-binding 'org-table-wrap-region 106
+ [(meta return)] "\M-\C-m"))
+
+ (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
+ (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region)
+
+ (when orgtbl-optimized
+ ;; If the user wants maximum table support, we need to hijack
+ ;; some standard editing functions
+ (org-remap orgtbl-mode-map
+ 'self-insert-command 'orgtbl-self-insert-command
+ 'delete-char 'org-delete-char
+ 'delete-backward-char 'org-delete-backward-char)
+ (org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
+ (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
+ '("OrgTbl"
+ ["Create or convert" org-table-create-or-convert-from-region
+ :active (not (org-at-table-p)) :keys "C-c |" ]
+ "--"
+ ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
+ ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
+ ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
+ ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
+ "--"
+ ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
+ ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
+ ["Copy Field from Above"
+ org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
+ ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
+ ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
+ ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
+ ("Row"
+ ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
+ ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
+ ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
+ ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
+ ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"]
+ "--"
+ ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
+ ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
+ ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
+ ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
+ "--"
+ ("Radio tables"
+ ["Insert table template" orgtbl-insert-radio-table
+ (assq major-mode orgtbl-radio-table-templates)]
+ ["Comment/uncomment table" orgtbl-toggle-comment t])
+ "--"
+ ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
+ ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
+ ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
+ ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
+ ["Sum Column/Rectangle" org-table-sum
+ :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
+ ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
+ ["Debug Formulas"
+ org-table-toggle-formula-debugger :active (org-at-table-p)
+ :keys "C-c {"
+ :style toggle :selected org-table-formula-debug]
+ ["Show Col/Row Numbers"
+ org-table-toggle-coordinate-overlays :active (org-at-table-p)
+ :keys "C-c }"
+ :style toggle :selected org-table-overlay-coordinates]
+ ))
+ t))
+
+(defun orgtbl-ctrl-c-ctrl-c (arg)
+ "If the cursor is inside a table, realign the table.
+If it is a table to be sent away to a receiver, do it.
+With prefix arg, also recompute table."
+ (interactive "P")
+ (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str)
+ (save-excursion
+ (beginning-of-line 1)
+ (setq action (cond
+ ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
+ ((looking-at "[ \t]*|") pos)
+ ((looking-at "[ \t]*#\\+tblfm:") 'recalc))))
+ (cond
+ ((integerp action)
+ (goto-char action)
+ (org-table-maybe-eval-formula)
+ (if arg
+ (call-interactively 'org-table-recalculate)
+ (org-table-maybe-recalculate-line))
+ (call-interactively 'org-table-align)
+ (when (orgtbl-send-table 'maybe)
+ (run-hooks 'orgtbl-after-send-table-hook)))
+ ((eq action 'recalc)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
+ (setq const-str (substring-no-properties (match-string 1)))
+ (setq consts (append consts (org-split-string const-str "[ \t]+")))
+ (when consts
+ (let (e)
+ (while (setq e (pop consts))
+ (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
+ (push (cons (match-string 1 e) (match-string 2 e)) cst)))
+ (setq org-table-formula-constants-local cst)))))
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-backward " \r\n\t")
+ (if (org-at-table-p)
+ (org-call-with-arg 'org-table-recalculate t))))
+ (t (let (orgtbl-mode)
+ (call-interactively (key-binding "\C-c\C-c")))))))
+
+(defun orgtbl-create-or-convert-from-region (arg)
+ "Create table or convert region to table, if no conflicting binding.
+This installs the table binding `C-c |', but only if there is no
+conflicting binding to this key outside orgtbl-mode."
+ (interactive "P")
+ (let* (orgtbl-mode (cmd (key-binding "\C-c|")))
+ (if cmd
+ (call-interactively cmd)
+ (call-interactively 'org-table-create-or-convert-from-region))))
+
+(defun orgtbl-tab (arg)
+ "Justification and field motion for `orgtbl-mode'."
+ (interactive "P")
+ (if arg (org-table-edit-field t)
+ (org-table-justify-field-maybe)
+ (org-table-next-field)))
+
+(defun orgtbl-ret ()
+ "Justification and field motion for `orgtbl-mode'."
+ (interactive)
+ (if (bobp)
+ (newline)
+ (org-table-justify-field-maybe)
+ (org-table-next-row)))
+
+(defun orgtbl-self-insert-command (N)
+ "Like `self-insert-command', use overwrite-mode for whitespace in tables.
+If the cursor is in a table looking at whitespace, the whitespace is
+overwritten, and the table is not marked as requiring realignment."
+ (interactive "p")
+ (if (and (org-at-table-p)
+ (or
+ (and org-table-auto-blank-field
+ (member last-command
+ '(orgtbl-hijacker-command-100
+ orgtbl-hijacker-command-101
+ orgtbl-hijacker-command-102
+ orgtbl-hijacker-command-103
+ orgtbl-hijacker-command-104
+ orgtbl-hijacker-command-105
+ yas/expand))
+ (org-table-blank-field))
+ t)
+ (eq N 1)
+ (looking-at "[^|\n]* +|"))
+ (let (org-table-may-need-update)
+ (goto-char (1- (match-end 0)))
+ (backward-delete-char 1)
+ (goto-char (match-beginning 0))
+ (self-insert-command N))
+ (setq org-table-may-need-update t)
+ (let* (orgtbl-mode
+ a
+ (cmd (or (key-binding
+ (or (and (listp function-key-map)
+ (setq a (assoc last-input-event function-key-map))
+ (cdr a))
+ (vector last-input-event)))
+ 'self-insert-command)))
+ (call-interactively cmd)
+ (if (and org-self-insert-cluster-for-undo
+ (eq cmd 'self-insert-command))
+ (if (not (eq last-command 'orgtbl-self-insert-command))
+ (setq org-self-insert-command-undo-counter 1)
+ (if (>= org-self-insert-command-undo-counter 20)
+ (setq org-self-insert-command-undo-counter 1)
+ (and (> org-self-insert-command-undo-counter 0)
+ buffer-undo-list
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq org-self-insert-command-undo-counter
+ (1+ org-self-insert-command-undo-counter))))))))
+
+(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
+ "Regular expression matching exponentials as produced by calc.")
+
+(defun orgtbl-export (table target)
+ (require 'org-exp)
+ (let ((func (intern (concat "orgtbl-to-" (symbol-name target))))
+ (lines (org-split-string table "[ \t]*\n[ \t]*"))
+ org-table-last-alignment org-table-last-column-widths
+ maxcol column)
+ (if (not (fboundp func))
+ (error "Cannot export orgtbl table to %s" target))
+ (setq lines (org-table-clean-before-export lines))
+ (setq table
+ (mapcar
+ (lambda (x)
+ (if (string-match org-table-hline-regexp x)
+ 'hline
+ (org-split-string (org-trim x) "\\s-*|\\s-*")))
+ lines))
+ (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0))
+ table)))
+ (loop for i from (1- maxcol) downto 0 do
+ (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table))
+ (setq column (delq nil column))
+ (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths)
+ (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment))
+ (funcall func table nil)))
+
+(defun orgtbl-gather-send-defs ()
+ "Gather a plist of :name, :transform, :params for each destination before
+a radio table."
+ (save-excursion
+ (goto-char (org-table-begin))
+ (let (rtn)
+ (beginning-of-line 0)
+ (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
+ (let ((name (org-no-properties (match-string 1)))
+ (transform (intern (match-string 2)))
+ (params (if (match-end 3)
+ (read (concat "(" (match-string 3) ")")))))
+ (push (list :name name :transform transform :params params)
+ rtn)
+ (beginning-of-line 0)))
+ rtn)))
+
+(defun orgtbl-send-replace-tbl (name txt)
+ "Find and replace table NAME with TXT."
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
+ (error "Don't know where to insert translated table"))
+ (goto-char (match-beginning 0))
+ (beginning-of-line 2)
+ (save-excursion
+ (let ((beg (point)))
+ (unless (re-search-forward
+ (concat "END RECEIVE ORGTBL +" name) nil t)
+ (error "Cannot find end of insertion region"))
+ (beginning-of-line 1)
+ (delete-region beg (point))))
+ (insert txt "\n")))
+
+;;;###autoload
+(defun org-table-to-lisp (&optional txt)
+ "Convert the table at point to a Lisp structure.
+The structure will be a list. Each item is either the symbol `hline'
+for a horizontal separator line, or a list of field values as strings.
+The table is taken from the parameter TXT, or from the buffer at point."
+ (unless txt
+ (unless (org-at-table-p)
+ (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
+ (org-split-string (org-trim x) "\\s-*|\\s-*")))
+ lines)))
+
+(defun orgtbl-send-table (&optional maybe)
+ "Send a transformed version of this table to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined for
+this table."
+ (interactive)
+ (catch 'exit
+ (unless (org-at-table-p) (error "Not at a table"))
+ ;; when non-interactive, we assume align has just happened.
+ (when (org-called-interactively-p 'any) (org-table-align))
+ (let ((dests (orgtbl-gather-send-defs))
+ (txt (buffer-substring-no-properties (org-table-begin)
+ (org-table-end)))
+ (ntbl 0))
+ (unless dests (if maybe (throw 'exit nil)
+ (error "Don't know how to transform this table")))
+ (dolist (dest dests)
+ (let* ((name (plist-get dest :name))
+ (transform (plist-get dest :transform))
+ (params (plist-get dest :params))
+ (skip (plist-get params :skip))
+ (skipcols (plist-get params :skipcols))
+ (no-escape (plist-get params :no-escape))
+ beg
+ (lines (org-table-clean-before-export
+ (nthcdr (or skip 0)
+ (org-split-string txt "[ \t]*\n[ \t]*"))))
+ (i0 (if org-table-clean-did-remove-column 2 1))
+ (lines (if no-escape lines
+ (mapcar (lambda(l) (replace-regexp-in-string
+ "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines)))
+ (table (mapcar
+ (lambda (x)
+ (if (string-match org-table-hline-regexp x)
+ 'hline
+ (org-remove-by-index
+ (org-split-string (org-trim x) "\\s-*|\\s-*")
+ skipcols i0)))
+ lines))
+ (fun (if (= i0 2) 'cdr 'identity))
+ (org-table-last-alignment
+ (org-remove-by-index (funcall fun org-table-last-alignment)
+ skipcols i0))
+ (org-table-last-column-widths
+ (org-remove-by-index (funcall fun org-table-last-column-widths)
+ skipcols i0))
+ (txt (if (fboundp transform)
+ (funcall transform table params)
+ (error "No such transformation function %s" transform))))
+ (orgtbl-send-replace-tbl name txt))
+ (setq ntbl (1+ ntbl)))
+ (message "Table converted and installed at %d receiver location%s"
+ ntbl (if (> ntbl 1) "s" ""))
+ (if (> ntbl 0)
+ ntbl
+ nil))))
+
+(defun org-remove-by-index (list indices &optional i0)
+ "Remove the elements in LIST with indices in INDICES.
+First element has index 0, or I0 if given."
+ (if (not indices)
+ list
+ (if (integerp indices) (setq indices (list indices)))
+ (setq i0 (1- (or i0 0)))
+ (delq :rm (mapcar (lambda (x)
+ (setq i0 (1+ i0))
+ (if (memq i0 indices) :rm x))
+ list))))
+
+(defun orgtbl-toggle-comment ()
+ "Comment or uncomment the orgtbl at point."
+ (interactive)
+ (let* ((case-fold-search t)
+ (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
+ (re2 (concat "^" orgtbl-line-start-regexp))
+ (commented (save-excursion (beginning-of-line 1)
+ (cond ((looking-at re1) t)
+ ((looking-at re2) nil)
+ (t (error "Not at an org table")))))
+ (re (if commented re1 re2))
+ beg end)
+ (save-excursion
+ (beginning-of-line 1)
+ (while (looking-at re) (beginning-of-line 0))
+ (beginning-of-line 2)
+ (setq beg (point))
+ (while (looking-at re) (beginning-of-line 2))
+ (setq end (point)))
+ (comment-region beg end (if commented '(4) nil))))
+
+(defun orgtbl-insert-radio-table ()
+ "Insert a radio table template appropriate for this major mode."
+ (interactive)
+ (let* ((e (assq major-mode orgtbl-radio-table-templates))
+ (txt (nth 1 e))
+ name pos)
+ (unless e (error "No radio table setup defined for %s" major-mode))
+ (setq name (read-string "Table name: "))
+ (while (string-match "%n" txt)
+ (setq txt (replace-match name t t txt)))
+ (or (bolp) (insert "\n"))
+ (setq pos (point))
+ (insert txt)
+ (goto-char pos)))
+
+;; Dynamically bound input and output for table formatting.
+(defvar *orgtbl-table* nil
+ "Carries the current table through formatting routines.")
+(defvar *orgtbl-rtn* nil
+ "Formatting routines push the output lines here.")
+;; Formatting parameters for the current table section.
+(defvar *orgtbl-hline* nil "Text used for horizontal lines.")
+(defvar *orgtbl-sep* nil "Text used as a column separator.")
+(defvar *orgtbl-default-fmt* nil "Default format for each entry.")
+(defvar *orgtbl-fmt* nil "Format for each entry.")
+(defvar *orgtbl-efmt* nil "Format for numbers.")
+(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.")
+(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.")
+(defvar *orgtbl-lstart* nil "Text starting a row.")
+(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.")
+(defvar *orgtbl-lend* nil "Text ending a row.")
+(defvar *orgtbl-llend* nil "Specializes lend for the last row.")
+
+(defsubst orgtbl-get-fmt (fmt i)
+ "Retrieve the format from FMT corresponding to the Ith column."
+ (if (and (not (functionp fmt)) (consp fmt))
+ (plist-get fmt i)
+ fmt))
+
+(defsubst orgtbl-apply-fmt (fmt &rest args)
+ "Apply format FMT to the arguments. NIL FMTs return the first argument."
+ (cond ((functionp fmt) (apply fmt args))
+ (fmt (apply 'format fmt args))
+ (args (car args))
+ (t args)))
+
+(defsubst orgtbl-eval-str (str)
+ "If STR is a function, evaluate it with no arguments."
+ (if (functionp str)
+ (funcall str)
+ str))
+
+(defun orgtbl-format-line (line)
+ "Format LINE as a table row."
+ (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*))
+ (let* ((i 0)
+ (line
+ (mapcar
+ (lambda (f)
+ (setq i (1+ i))
+ (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i))
+ (f (if (and efmt (string-match orgtbl-exp-regexp f))
+ (orgtbl-apply-fmt efmt (match-string 1 f)
+ (match-string 2 f))
+ f)))
+ (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i)
+ *orgtbl-default-fmt*)
+ f)))
+ line)))
+ (push (if *orgtbl-lfmt*
+ (orgtbl-apply-fmt *orgtbl-lfmt* line)
+ (concat (orgtbl-eval-str *orgtbl-lstart*)
+ (mapconcat 'identity line *orgtbl-sep*)
+ (orgtbl-eval-str *orgtbl-lend*)))
+ *orgtbl-rtn*))))
+
+(defun orgtbl-format-section (section-stopper)
+ "Format lines until the first occurrence of SECTION-STOPPER."
+ (let (prevline)
+ (progn
+ (while (not (eq (car *orgtbl-table*) section-stopper))
+ (if prevline (orgtbl-format-line prevline))
+ (setq prevline (pop *orgtbl-table*)))
+ (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*)
+ (*orgtbl-lend* *orgtbl-llend*)
+ (*orgtbl-lfmt* *orgtbl-llfmt*))
+ (orgtbl-format-line prevline))))))
+
+(defun orgtbl-to-generic (table params)
+ "Convert the orgtbl-mode TABLE to some other format.
+This generic routine can be used for many standard cases.
+TABLE is a list, each entry either the symbol `hline' for a horizontal
+separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the conversion.
+For the generic converter, some parameters are obligatory: you need to
+specify either :lfmt, or all of (:lstart :lend :sep).
+
+Valid parameters are:
+
+:splice When set to t, return only table body lines, don't wrap
+ them into :tstart and :tend. Default is nil. When :splice
+ is non-nil, this also means that the exporter should not look
+ for and interpret header and footer sections.
+
+:hline String to be inserted on horizontal separation lines.
+ May be nil to ignore hlines.
+
+:sep Separator between two fields
+:remove-nil-lines Do not include lines that evaluate to nil.
+
+Each in the following group may be either a string or a function
+of no arguments returning a string:
+
+:tstart String to start the table. Ignored when :splice is t.
+:tend String to end the table. Ignored when :splice is t.
+:lstart String to start a new table line.
+:llstart String to start the last table line, defaults to :lstart.
+:lend String to end a table line
+:llend String to end the last table line, defaults to :lend.
+
+Each in the following group may be a string, a function of one
+argument (the field or line) returning a string, or a plist
+mapping columns to either of the above:
+
+:lfmt Format for entire line, with enough %s to capture all fields.
+ If this is present, :lstart, :lend, and :sep are ignored.
+:llfmt Format for the entire last line, defaults to :lfmt.
+:fmt A format to be used to wrap the field, should contain
+ %s for the original field value. For example, to wrap
+ everything in dollars, you could use :fmt \"$%s$\".
+ This may also be a property list with column numbers and
+ formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
+:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
+ Same as above, specific for the header lines in the table.
+ All lines before the first hline are treated as header.
+ If any of these is not present, the data line value is used.
+
+This may be either a string or a function of two arguments:
+
+:efmt Use this format to print numbers with exponentials.
+ The format should have %s twice for inserting mantissa
+ and exponent, for example \"%s\\\\times10^{%s}\". This
+ may also be a property list with column numbers and
+ formats. :fmt will still be applied after :efmt.
+
+In addition to this, the parameters :skip and :skipcols are always handled
+directly by `orgtbl-send-table'. See manual."
+ (let* ((splicep (plist-get params :splice))
+ (hline (plist-get params :hline))
+ (skipheadrule (plist-get params :skipheadrule))
+ (remove-nil-linesp (plist-get params :remove-nil-lines))
+ (remove-newlines (plist-get params :remove-newlines))
+ (*orgtbl-hline* hline)
+ (*orgtbl-table* table)
+ (*orgtbl-sep* (plist-get params :sep))
+ (*orgtbl-efmt* (plist-get params :efmt))
+ (*orgtbl-lstart* (plist-get params :lstart))
+ (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*))
+ (*orgtbl-lend* (plist-get params :lend))
+ (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*))
+ (*orgtbl-lfmt* (plist-get params :lfmt))
+ (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
+ (*orgtbl-fmt* (plist-get params :fmt))
+ *orgtbl-rtn*)
+
+ ;; Put header
+ (unless splicep
+ (when (plist-member params :tstart)
+ (let ((tstart (orgtbl-eval-str (plist-get params :tstart))))
+ (if tstart (push tstart *orgtbl-rtn*)))))
+
+ ;; Do we have a heading section? If so, format it and handle the
+ ;; trailing hline.
+ (if (and (not splicep)
+ (or (consp (car *orgtbl-table*))
+ (consp (nth 1 *orgtbl-table*)))
+ (memq 'hline (cdr *orgtbl-table*)))
+ (progn
+ (when (eq 'hline (car *orgtbl-table*))
+ ;; there is a hline before the first data line
+ (and hline (push hline *orgtbl-rtn*))
+ (pop *orgtbl-table*))
+ (let* ((*orgtbl-lstart* (or (plist-get params :hlstart)
+ *orgtbl-lstart*))
+ (*orgtbl-llstart* (or (plist-get params :hllstart)
+ *orgtbl-llstart*))
+ (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*))
+ (*orgtbl-llend* (or (plist-get params :hllend)
+ (plist-get params :hlend) *orgtbl-llend*))
+ (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*))
+ (*orgtbl-llfmt* (or (plist-get params :hllfmt)
+ (plist-get params :hlfmt) *orgtbl-llfmt*))
+ (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*))
+ (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*)))
+ (orgtbl-format-section 'hline))
+ (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
+ (pop *orgtbl-table*)))
+
+ ;; Now format the main section.
+ (orgtbl-format-section nil)
+
+ (unless splicep
+ (when (plist-member params :tend)
+ (let ((tend (orgtbl-eval-str (plist-get params :tend))))
+ (if tend (push tend *orgtbl-rtn*)))))
+
+ (mapconcat (if remove-newlines
+ (lambda (tend)
+ (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
+ 'identity)
+ (nreverse (if remove-nil-linesp
+ (remq nil *orgtbl-rtn*)
+ *orgtbl-rtn*)) "\n")))
+
+(defun orgtbl-to-tsv (table params)
+ "Convert the orgtbl-mode table to TAB separated material."
+ (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
+(defun orgtbl-to-csv (table params)
+ "Convert the orgtbl-mode table to CSV material.
+This does take care of the proper quoting of fields with comma or quotes."
+ (orgtbl-to-generic table (org-combine-plists
+ '(:sep "," :fmt org-quote-csv-field)
+ params)))
+
+(defun orgtbl-to-latex (table params)
+ "Convert the orgtbl-mode TABLE to LaTeX.
+TABLE is a list, each entry either the symbol `hline' for a horizontal
+separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the conversion.
+Supports all parameters from `orgtbl-to-generic'. Most important for
+LaTeX are:
+
+:splice When set to t, return only table body lines, don't wrap
+ them into a tabular environment. Default is nil.
+
+:fmt A format to be used to wrap the field, should contain %s for the
+ original field value. For example, to wrap everything in dollars,
+ use :fmt \"$%s$\". This may also be a property list with column
+ numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
+ The format may also be a function that formats its one argument.
+
+:efmt Format for transforming numbers with exponentials. The format
+ should have %s twice for inserting mantissa and exponent, for
+ example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\".
+ This may also be a property list with column numbers and formats.
+ The format may also be a function that formats its two arguments.
+
+:llend If you find too much space below the last line of a table,
+ pass a value of \"\" for :llend to suppress the final \\\\.
+
+The general parameters :skip and :skipcols have already been applied when
+this function is called."
+ (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
+ org-table-last-alignment ""))
+ (params2
+ (list
+ :tstart (concat "\\begin{tabular}{" alignment "}")
+ :tend "\\end{tabular}"
+ :lstart "" :lend " \\\\" :sep " & "
+ :efmt "%s\\,(%s)" :hline "\\hline")))
+ (orgtbl-to-generic table (org-combine-plists params2 params))))
+
+(defun orgtbl-to-html (table params)
+ "Convert the orgtbl-mode TABLE to HTML.
+TABLE is a list, each entry either the symbol `hline' for a horizontal
+separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the conversion.
+Currently this function recognizes the following parameters:
+
+:splice When set to t, return only table body lines, don't wrap
+ them into a <table> environment. Default is nil.
+
+The general parameters :skip and :skipcols have already been applied when
+this function is called. The function does *not* use `orgtbl-to-generic',
+so you cannot specify parameters for it."
+ (let* ((splicep (plist-get params :splice))
+ (html-table-tag org-export-html-table-tag)
+ html)
+ ;; Just call the formatter we already have
+ ;; We need to make text lines for it, so put the fields back together.
+ (setq html (org-format-org-table-html
+ (mapcar
+ (lambda (x)
+ (if (eq x 'hline)
+ "|----+----|"
+ (concat "| " (mapconcat 'org-html-expand x " | ") " |")))
+ table)
+ splicep))
+ (if (string-match "\n+\\'" html)
+ (setq html (replace-match "" t t html)))
+ html))
+
+(defun orgtbl-to-texinfo (table params)
+ "Convert the orgtbl-mode TABLE to TeXInfo.
+TABLE is a list, each entry either the symbol `hline' for a horizontal
+separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the conversion.
+Supports all parameters from `orgtbl-to-generic'. Most important for
+TeXInfo are:
+
+:splice nil/t When set to t, return only table body lines, don't wrap
+ them into a multitable environment. Default is nil.
+
+:fmt fmt A format to be used to wrap the field, should contain
+ %s for the original field value. For example, to wrap
+ everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
+ This may also be a property list with column numbers and
+ formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
+ Each format also may be a function that formats its one
+ argument.
+
+:cf \"f1 f2..\" The column fractions for the table. By default these
+ are computed automatically from the width of the columns
+ under org-mode.
+
+The general parameters :skip and :skipcols have already been applied when
+this function is called."
+ (let* ((total (float (apply '+ org-table-last-column-widths)))
+ (colfrac (or (plist-get params :cf)
+ (mapconcat
+ (lambda (x) (format "%.3f" (/ (float x) total)))
+ org-table-last-column-widths " ")))
+ (params2
+ (list
+ :tstart (concat "@multitable @columnfractions " colfrac)
+ :tend "@end multitable"
+ :lstart "@item " :lend "" :sep " @tab "
+ :hlstart "@headitem ")))
+ (orgtbl-to-generic table (org-combine-plists params2 params))))
+
+(defun orgtbl-to-orgtbl (table params)
+ "Convert the orgtbl-mode TABLE into another orgtbl-mode table.
+Useful when slicing one table into many. The :hline, :sep,
+:lstart, and :lend provide orgtbl framing. The default nil :tstart
+and :tend suppress strings without splicing; they can be set to
+provide ORGTBL directives for the generated table."
+ (let* ((params2
+ (list
+ :remove-newlines t
+ :tstart nil :tend nil
+ :hline "|---"
+ :sep " | "
+ :lstart "| "
+ :lend " |"))
+ (params (org-combine-plists params2 params)))
+ (with-temp-buffer
+ (insert (orgtbl-to-generic table params))
+ (goto-char (point-min))
+ (while (re-search-forward org-table-hline-regexp nil t)
+ (org-table-align))
+ (buffer-substring 1 (buffer-size)))))
+
+(defun orgtbl-to-table.el (table params)
+ "Convert the orgtbl-mode TABLE into a table.el table."
+ (with-temp-buffer
+ (insert (orgtbl-to-orgtbl table params))
+ (org-table-align)
+ (replace-regexp-in-string
+ "-|" "-+"
+ (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size))))))
+
+(defun orgtbl-to-unicode (table params)
+ "Convert the orgtbl-mode TABLE into a table with unicode characters.
+You need the ascii-art-to-unicode.el package for this. You can download
+it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
+ (with-temp-buffer
+ (insert (orgtbl-to-table.el table params))
+ (goto-char (point-min))
+ (if (or (featurep 'ascii-art-to-unicode)
+ (require 'ascii-art-to-unicode nil t))
+ (aa2u)
+ (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links))
+ (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el"
+ "Link to ascii-art-to-unicode.el") org-stored-links))
+ (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
+ (buffer-string)))
+
+(defun org-table-get-remote-range (name-or-id form)
+ "Get a field value or a list of values in a range from table at ID.
+
+NAME-OR-ID may be the name of a table in the current file as set by
+a \"#+TBLNAME:\" directive. The first table following this line
+will then be used. Alternatively, it may be an ID referring to
+any entry, also in a different file. In this case, the first table
+in that entry will be referenced.
+FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
+\"@I$2..@II$2\". All the references must be absolute, not relative.
+
+The return value is either a single string for a single field, or a
+list of the fields in the rectangle ."
+ (save-match-data
+ (let ((case-fold-search t) (id-loc nil)
+ ;; Protect a bunch of variables from being overwritten
+ ;; by the context of the remote table
+ org-table-column-names org-table-column-name-regexp
+ org-table-local-parameters org-table-named-field-locations
+ org-table-current-line-types org-table-current-begin-line
+ org-table-current-begin-pos org-table-dlines
+ org-table-current-ncol
+ org-table-hlines org-table-last-alignment
+ org-table-last-column-widths org-table-last-alignment
+ org-table-last-column-widths tbeg
+ buffer loc)
+ (setq form (org-table-convert-refs-to-rc form))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
+ nil t)
+ (setq buffer (current-buffer) loc (match-beginning 0))
+ (setq id-loc (org-id-find name-or-id 'marker))
+ (unless (and id-loc (markerp id-loc))
+ (error "Can't find remote table \"%s\"" name-or-id))
+ (setq buffer (marker-buffer id-loc)
+ loc (marker-position id-loc))
+ (move-marker id-loc nil)))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char loc)
+ (forward-char 1)
+ (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
+ (not (match-beginning 1)))
+ (error "Cannot find a table at NAME or ID %s" name-or-id))
+ (setq tbeg (point-at-bol))
+ (org-table-get-specials)
+ (setq form (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc form)))
+ (if (and (string-match org-table-range-regexp form)
+ (> (length (match-string 0 form)) 1))
+ (save-match-data
+ (org-table-get-range (match-string 0 form) tbeg 1))
+ form)))))))))
+
+(provide 'org-table)
+
+;;; org-table.el ends here
diff --git a/lisp/org-taskjuggler.el b/lisp/org-taskjuggler.el
new file mode 100644
index 0000000..aa645d2
--- /dev/null
+++ b/lisp/org-taskjuggler.el
@@ -0,0 +1,695 @@
+;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode
+;;
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;;
+;; Emacs Lisp Archive Entry
+;; Filename: org-taskjuggler.el
+;; Author: Christian Egli
+;; Maintainer: Christian Egli
+;; Keywords: org, taskjuggler, project planning
+;; Description: Converts an org-mode buffer into a taskjuggler project plan
+;; URL:
+
+;; 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 library implements a TaskJuggler exporter for org-mode.
+;; TaskJuggler uses a text format to define projects, tasks and
+;; resources, so it is a natural fit for org-mode. It can produce all
+;; sorts of reports for tasks or resources in either HTML, CSV or PDF.
+;; The current version of TaskJuggler requires KDE but the next
+;; version is implemented in Ruby and should therefore run on any
+;; platform.
+;;
+;; The exporter is a bit different from other exporters, such as the
+;; HTML and LaTeX exporters for example, in that it does not export
+;; all the nodes of a document or strictly follow the order of the
+;; nodes in the document.
+;;
+;; Instead the TaskJuggler exporter looks for a tree that defines the
+;; tasks and a optionally tree that defines the resources for this
+;; project. It then creates a TaskJuggler file based on these trees
+;; and the attributes defined in all the nodes.
+;;
+;; * Installation
+;;
+;; Put this file into your load-path and the following line into your
+;; ~/.emacs:
+;;
+;; (require 'org-taskjuggler)
+;;
+;; The interactive functions are similar to those of the HTML and LaTeX
+;; exporters:
+;;
+;; M-x `org-export-as-taskjuggler'
+;; M-x `org-export-as-taskjuggler-and-open'
+;;
+;; * Tasks
+;;
+;; Let's illustrate the usage with a small example. Create your tasks
+;; as you usually do with org-mode. Assign efforts to each task using
+;; properties (it's easiest to do this in the column view). You should
+;; end up with something similar to the example by Peter Jones in
+;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
+;; Now mark the top node of your tasks with a tag named
+;; "taskjuggler_project" (or whatever you customized
+;; `org-export-taskjuggler-project-tag' to). You are now ready to
+;; export the project plan with `org-export-as-taskjuggler-and-open'
+;; which will export the project plan and open a Gantt chart in
+;; TaskJugglerUI.
+;;
+;; * Resources
+;;
+;; Next you can define resources and assign those to work on specific
+;; tasks. You can group your resources hierarchically. Tag the top
+;; node of the resources with "taskjuggler_resource" (or whatever you
+;; customized `org-export-taskjuggler-resource-tag' to). You can
+;; optionally assign an identifier (named "resource_id") to the
+;; resources (using the standard org properties commands) or you can
+;; let the exporter generate identifiers automatically (the exporter
+;; picks the first word of the headline as the identifier as long as
+;; it is unique, see the documentation of
+;; `org-taskjuggler-get-unique-id'). Using that identifier you can
+;; then allocate resources to tasks. This is again done with the
+;; "allocate" property on the tasks. Do this in column view or when on
+;; the task type
+;;
+;; C-c C-x p allocate RET <resource_id> RET
+;;
+;; Once the allocations are done you can again export to TaskJuggler
+;; and check in the Resource Allocation Graph which person is working
+;; on what task at what time.
+;;
+;; * Export of properties
+;;
+;; The exporter also takes TODO state information into consideration,
+;; i.e. if a task is marked as done it will have the corresponding
+;; attribute in TaskJuggler ("complete 100"). Also it will export any
+;; property on a task resource or resource node which is known to
+;; TaskJuggler, such as limits, vacation, shift, booking, efficiency,
+;; journalentry, rate for resources or account, start, note, duration,
+;; end, journalentry, milestone, reference, responsible, scheduling,
+;; etc for tasks.
+;;
+;; * Dependencies
+;;
+;; The exporter will handle dependencies that are defined in the tasks
+;; either with the ORDERED attribute (see TODO dependencies in the Org
+;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
+;; alternatively with a depends attribute. Both the BLOCKER and the
+;; depends attribute can be either "previous-sibling" or a reference
+;; to an identifier (named "task_id") which is defined for another
+;; task in the project. BLOCKER and the depends attribute can define
+;; multiple dependencies separated by either space or comma. You can
+;; also specify optional attributes on the dependency by simply
+;; appending it. The following examples should illustrate this:
+;;
+;; * Training material
+;; :PROPERTIES:
+;; :task_id: training_material
+;; :ORDERED: t
+;; :END:
+;; ** Markup Guidelines
+;; :PROPERTIES:
+;; :Effort: 2d
+;; :END:
+;; ** Workflow Guidelines
+;; :PROPERTIES:
+;; :Effort: 2d
+;; :END:
+;; * Presentation
+;; :PROPERTIES:
+;; :Effort: 2d
+;; :BLOCKER: training_material { gapduration 1d } some_other_task
+;; :END:
+;;
+;;;; * TODO
+;; - Use SCHEDULED and DEADLINE information (not just start and end
+;; properties).
+;; - Look at org-file-properties, org-global-properties and
+;; org-global-properties-fixed
+;; - What about property inheritance and org-property-inherit-p?
+;; - Use TYPE_TODO as an way to assign resources
+;; - Make sure multiple dependency definitions (i.e. BLOCKER on
+;; previous-sibling and on a specific task_id) in multiple
+;; attributes are properly exported.
+;;
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'org)
+(require 'org-exp)
+
+;;; User variables:
+
+(defgroup org-export-taskjuggler nil
+ "Options for exporting Org-mode files to TaskJuggler."
+ :tag "Org Export TaskJuggler"
+ :group 'org-export)
+
+(defcustom org-export-taskjuggler-extension ".tjp"
+ "Extension of TaskJuggler files."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-taskjuggler-project-tag "taskjuggler_project"
+ "Tag, property or todo used to find the tree containing all
+the tasks for the project."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource"
+ "Tag, property or todo used to find the tree containing all the
+resources for the project."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-taskjuggler-target-version 2.4
+ "Which version of TaskJuggler the exporter is targeting."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'number)
+
+(defcustom org-export-taskjuggler-default-project-version "1.0"
+ "Default version string for the project."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'string)
+
+(defcustom org-export-taskjuggler-default-project-duration 280
+ "Default project duration if no start and end date have been defined
+in the root node of the task tree, i.e. the tree that has been marked
+with `org-export-taskjuggler-project-tag'"
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type 'integer)
+
+(defcustom org-export-taskjuggler-default-reports
+ '("taskreport \"Gantt Chart\" {
+ headline \"Project Gantt Chart\"
+ columns hierarchindex, name, start, end, effort, duration, completed, chart
+ timeformat \"%Y-%m-%d\"
+ hideresource 1
+ loadunit shortauto
+}"
+ "resourcereport \"Resource Graph\" {
+ headline \"Resource Allocation Graph\"
+ columns no, name, utilization, freeload, chart
+ loadunit shortauto
+ sorttasks startup
+ hidetask ~isleaf()
+}")
+ "Default reports for the project."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type '(repeat (string :tag "Report")))
+
+(defcustom org-export-taskjuggler-default-global-properties
+ "shift s40 \"Part time shift\" {
+ workinghours wed, thu, fri off
+}
+"
+ "Default global properties for the project. Here you typically
+define global properties such as shifts, accounts, rates,
+vacation, macros and flags. Any property that is allowed within
+the TaskJuggler file can be inserted. You could for example
+include another TaskJuggler file.
+
+The global properties are inserted after the project declaration
+but before any resource and task declarations."
+ :group 'org-export-taskjuggler
+ :version "24.1"
+ :type '(string :tag "Preamble"))
+
+;;; Hooks
+
+(defvar org-export-taskjuggler-final-hook nil
+ "Hook run at the end of TaskJuggler export, in the new buffer.")
+
+;;; Autoload functions:
+
+;; avoid compiler warning about free variable
+(defvar org-export-taskjuggler-old-level)
+
+;;;###autoload
+(defun org-export-as-taskjuggler ()
+ "Export parts of the current buffer as a TaskJuggler file.
+The exporter looks for a tree with tag, property or todo that
+matches `org-export-taskjuggler-project-tag' and takes this as
+the tasks for this project. The first node of this tree defines
+the project properties such as project name and project period.
+If there is a tree with tag, property or todo that matches
+`org-export-taskjuggler-resource-tag' this three is taken as
+resources for the project. If no resources are specified, a
+default resource is created and allocated to the project. Also
+the taskjuggler project will be created with default reports as
+defined in `org-export-taskjuggler-default-reports'."
+ (interactive)
+
+ (message "Exporting...")
+ (setq-default org-done-keywords org-done-keywords)
+ (let* ((tasks
+ (org-taskjuggler-resolve-dependencies
+ (org-taskjuggler-assign-task-ids
+ (org-taskjuggler-compute-task-leafiness
+ (org-map-entries
+ 'org-taskjuggler-components
+ org-export-taskjuggler-project-tag nil 'archive 'comment)))))
+ (resources
+ (org-taskjuggler-assign-resource-ids
+ (org-map-entries
+ 'org-taskjuggler-components
+ org-export-taskjuggler-resource-tag nil 'archive 'comment)))
+ (filename (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ org-export-taskjuggler-extension)))
+ (buffer (find-file-noselect filename))
+ (old-buffer (current-buffer))
+ (org-export-taskjuggler-old-level 0)
+ task resource)
+ (unless tasks
+ (error "No tasks specified"))
+ ;; add a default resource
+ (unless resources
+ (setq resources
+ `((("resource_id" . ,(user-login-name))
+ ("headline" . ,user-full-name)
+ ("level" . 1)))))
+ ;; add a default allocation to the first task if none was given
+ (unless (assoc "allocate" (car tasks))
+ (let ((task (car tasks))
+ (resource-id (cdr (assoc "resource_id" (car resources)))))
+ (setcar tasks (push (cons "allocate" resource-id) task))))
+ ;; add a default start date to the first task if none was given
+ (unless (assoc "start" (car tasks))
+ (let ((task (car tasks))
+ (time-string (format-time-string "%Y-%m-%d")))
+ (setcar tasks (push (cons "start" time-string) task))))
+ ;; add a default version if none was given
+ (unless (assoc "version" (car tasks))
+ (let ((task (car tasks))
+ (version org-export-taskjuggler-default-project-version))
+ (setcar tasks (push (cons "version" version) task))))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (org-clone-local-variables old-buffer "^org-")
+ (org-taskjuggler-open-project (car tasks))
+ (insert org-export-taskjuggler-default-global-properties)
+ (insert "\n")
+ (dolist (resource resources)
+ (let ((level (cdr (assoc "level" resource))))
+ (org-taskjuggler-close-maybe level)
+ (org-taskjuggler-open-resource resource)
+ (setq org-export-taskjuggler-old-level level)))
+ (org-taskjuggler-close-maybe 1)
+ (setq org-export-taskjuggler-old-level 0)
+ (dolist (task tasks)
+ (let ((level (cdr (assoc "level" task))))
+ (org-taskjuggler-close-maybe level)
+ (org-taskjuggler-open-task task)
+ (setq org-export-taskjuggler-old-level level)))
+ (org-taskjuggler-close-maybe 1)
+ (org-taskjuggler-insert-reports)
+ (save-buffer)
+ (or (org-export-push-to-kill-ring "TaskJuggler")
+ (message "Exporting... done"))
+ (current-buffer))))
+
+;;;###autoload
+(defun org-export-as-taskjuggler-and-open ()
+ "Export the current buffer as a TaskJuggler file and open it
+with the TaskJuggler GUI."
+ (interactive)
+ (let* ((file-name (buffer-file-name (org-export-as-taskjuggler)))
+ (process-name "TaskJugglerUI")
+ (command (concat process-name " " file-name)))
+ (start-process-shell-command process-name nil command)))
+
+(defun org-taskjuggler-targeting-tj3-p ()
+ "Return true if we are targeting TaskJuggler III."
+ (>= org-export-taskjuggler-target-version 3.0))
+
+(defun org-taskjuggler-parent-is-ordered-p ()
+ "Return true if the parent of the current node has a property
+\"ORDERED\". Return nil otherwise."
+ (save-excursion
+ (and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
+
+(defun org-taskjuggler-components ()
+ "Return an alist containing all the pertinent information for
+the current node such as the headline, the level, todo state
+information, all the properties, etc."
+ (let* ((props (org-entry-properties))
+ (components (org-heading-components))
+ (level (nth 1 components))
+ (headline
+ (replace-regexp-in-string
+ "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines
+ (parent-ordered (org-taskjuggler-parent-is-ordered-p)))
+ (push (cons "level" level) props)
+ (push (cons "headline" headline) props)
+ (push (cons "parent-ordered" parent-ordered) props)))
+
+(defun org-taskjuggler-assign-task-ids (tasks)
+ "Given a list of tasks return the same list assigning a unique id
+and the full path to each task. Taskjuggler takes hierarchical ids.
+For that reason we have to make ids locally unique and we have to keep
+a path to the current task."
+ (let ((previous-level 0)
+ unique-ids unique-id
+ path
+ task resolved-tasks tmp)
+ (dolist (task tasks resolved-tasks)
+ (let ((level (cdr (assoc "level" task))))
+ (cond
+ ((< previous-level level)
+ (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
+ (dotimes (tmp (- level previous-level))
+ (push (list unique-id) unique-ids)
+ (push unique-id path)))
+ ((= previous-level level)
+ (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
+ (push unique-id (car unique-ids))
+ (setcar path unique-id))
+ ((> previous-level level)
+ (dotimes (tmp (- previous-level level))
+ (pop unique-ids)
+ (pop path))
+ (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
+ (push unique-id (car unique-ids))
+ (setcar path unique-id)))
+ (push (cons "unique-id" unique-id) task)
+ (push (cons "path" (mapconcat 'identity (reverse path) ".")) task)
+ (setq previous-level level)
+ (setq resolved-tasks (append resolved-tasks (list task)))))))
+
+(defun org-taskjuggler-compute-task-leafiness (tasks)
+ "Figure out if each task is a leaf by looking at it's level,
+and the level of its successor. If the successor is higher (ie
+deeper), then it's not a leaf."
+ (let (new-list)
+ (while (car tasks)
+ (let ((task (car tasks))
+ (successor (car (cdr tasks))))
+ (cond
+ ;; if a task has no successors it is a leaf
+ ((null successor)
+ (push (cons (cons "leaf-node" t) task) new-list))
+ ;; if the successor has a lower level than task it is a leaf
+ ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task)))
+ (push (cons (cons "leaf-node" t) task) new-list))
+ ;; otherwise examine the rest of the tasks
+ (t (push task new-list))))
+ (setq tasks (cdr tasks)))
+ (nreverse new-list)))
+
+(defun org-taskjuggler-assign-resource-ids (resources)
+ "Given a list of resources return the same list, assigning a
+unique id to each resource."
+ (let (unique-ids new-list)
+ (dolist (resource resources new-list)
+ (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
+ (push (cons "unique-id" unique-id) resource)
+ (push unique-id unique-ids)
+ (push resource new-list)))
+ (nreverse new-list)))
+
+(defun org-taskjuggler-resolve-dependencies (tasks)
+ (let ((previous-level 0)
+ siblings
+ task resolved-tasks)
+ (dolist (task tasks resolved-tasks)
+ (let* ((level (cdr (assoc "level" task)))
+ (depends (cdr (assoc "depends" task)))
+ (parent-ordered (cdr (assoc "parent-ordered" task)))
+ (blocker (cdr (assoc "BLOCKER" task)))
+ (blocked-on-previous
+ (and blocker (string-match "previous-sibling" blocker)))
+ (dependencies
+ (org-taskjuggler-resolve-explicit-dependencies
+ (append
+ (and depends (org-taskjuggler-tokenize-dependencies depends))
+ (and blocker (org-taskjuggler-tokenize-dependencies blocker)))
+ tasks))
+ previous-sibling)
+ ; update previous sibling info
+ (cond
+ ((< previous-level level)
+ (dotimes (tmp (- level previous-level))
+ (push task siblings)))
+ ((= previous-level level)
+ (setq previous-sibling (car siblings))
+ (setcar siblings task))
+ ((> previous-level level)
+ (dotimes (tmp (- previous-level level))
+ (pop siblings))
+ (setq previous-sibling (car siblings))
+ (setcar siblings task)))
+ ; insert a dependency on previous sibling if the parent is
+ ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
+ (when (or (and previous-sibling parent-ordered) blocked-on-previous)
+ (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
+ ; store dependency information
+ (when dependencies
+ (push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
+ (setq previous-level level)
+ (setq resolved-tasks (append resolved-tasks (list task)))))))
+
+(defun org-taskjuggler-tokenize-dependencies (dependencies)
+ "Split a dependency property value DEPENDENCIES into the
+individual dependencies and return them as a list while keeping
+the optional arguments (such as gapduration) for the
+dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
+ (cond
+ ((string-match "^ *$" dependencies) nil)
+ ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
+ (cons
+ (substring dependencies (match-beginning 1) (match-end 1))
+ (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0)))))
+ (t (error (format "invalid dependency id %s" dependencies)))))
+
+(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks)
+ "For each dependency in DEPENDENCIES try to find a
+corresponding task with a matching property \"task_id\" in TASKS.
+Return a list containing the resolved links for all DEPENDENCIES
+where a matching tasks was found. If the dependency is
+\"previous-sibling\" it is ignored (as this is dealt with in
+`org-taskjuggler-resolve-dependencies'). If there is no matching
+task the dependency is ignored and a warning is displayed ."
+ (unless (null dependencies)
+ (let*
+ ;; the dependency might have optional attributes such as "{
+ ;; gapduration 5d }", so only use the first string as id for the
+ ;; dependency
+ ((dependency (car dependencies))
+ (id (car (split-string dependency)))
+ (optional-attributes
+ (mapconcat 'identity (cdr (split-string dependency)) " "))
+ (path (org-taskjuggler-find-task-with-id id tasks)))
+ (cond
+ ;; ignore previous sibling dependencies
+ ((equal (car dependencies) "previous-sibling")
+ (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))
+ ;; if the id is found in another task use its path
+ ((not (null path))
+ (cons (mapconcat 'identity (list path optional-attributes) " ")
+ (org-taskjuggler-resolve-explicit-dependencies
+ (cdr dependencies) tasks)))
+ ;; warn about dangling dependency but otherwise ignore it
+ (t (display-warning
+ 'org-export-taskjuggler
+ (format "No task with matching property \"task_id\" found for id %s" id))
+ (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
+
+(defun org-taskjuggler-find-task-with-id (id tasks)
+ "Find ID in tasks. If found return the path of task. Otherwise
+return nil."
+ (let ((task-id (cdr (assoc "task_id" (car tasks))))
+ (path (cdr (assoc "path" (car tasks)))))
+ (cond
+ ((null tasks) nil)
+ ((equal task-id id) path)
+ (t (org-taskjuggler-find-task-with-id id (cdr tasks))))))
+
+(defun org-taskjuggler-get-unique-id (item unique-ids)
+ "Return a unique id for an ITEM which can be a task or a resource.
+The id is derived from the headline and made unique against
+UNIQUE-IDS. If the (downcased) first token of the headline is not
+unique try to add more (downcased) tokens of the headline or
+finally add more underscore characters (\"_\")."
+ (let* ((headline (cdr (assoc "headline" item)))
+ (parts (split-string headline))
+ (id (org-taskjuggler-clean-id (downcase (pop parts)))))
+ ; try to add more parts of the headline to make it unique
+ (while (and (member id unique-ids) (car parts))
+ (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
+ ; if its still not unique add "_"
+ (while (member id unique-ids)
+ (setq id (concat id "_")))
+ id))
+
+(defun org-taskjuggler-clean-id (id)
+ "Clean and return ID to make it acceptable for taskjuggler."
+ (and id
+ ;; replace non-ascii by _
+ (replace-regexp-in-string
+ "[^a-zA-Z0-9_]" "_"
+ ;; make sure id doesn't start with a number
+ (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))))
+
+(defun org-taskjuggler-open-project (project)
+ "Insert the beginning of a project declaration. All valid
+attributes from the PROJECT alist are inserted. If no end date is
+specified it is calculated
+`org-export-taskjuggler-default-project-duration' days from now."
+ (let* ((unique-id (cdr (assoc "unique-id" project)))
+ (headline (cdr (assoc "headline" project)))
+ (version (cdr (assoc "version" project)))
+ (start (cdr (assoc "start" project)))
+ (end (cdr (assoc "end" project))))
+ (insert
+ (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n"
+ unique-id headline version start
+ org-export-taskjuggler-default-project-duration))))
+
+(defun org-taskjuggler-filter-and-join (items)
+ "Filter all nil elements from ITEMS and join the remaining ones
+with separator \"\n\"."
+ (let ((filtered-items (remq nil items)))
+ (and filtered-items (mapconcat 'identity filtered-items "\n"))))
+
+(defun org-taskjuggler-get-attributes (item attributes)
+ "Return all attribute as a single formatted string. ITEM is an
+alist representing either a resource or a task. ATTRIBUTES is a
+list of symbols. Only entries from ITEM are considered that are
+listed in ATTRIBUTES."
+ (org-taskjuggler-filter-and-join
+ (mapcar
+ (lambda (attribute)
+ (org-taskjuggler-filter-and-join
+ (org-taskjuggler-get-attribute item attribute)))
+ attributes)))
+
+(defun org-taskjuggler-get-attribute (item attribute)
+ "Return a list of strings containing the properly formatted
+taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist).
+If the ATTRIBUTE is not in ITEM return nil."
+ (cond
+ ((null item) nil)
+ ((equal (symbol-name attribute) (car (car item)))
+ (cons (format "%s %s" (symbol-name attribute) (cdr (car item)))
+ (org-taskjuggler-get-attribute (cdr item) attribute)))
+ (t (org-taskjuggler-get-attribute (cdr item) attribute))))
+
+(defun org-taskjuggler-open-resource (resource)
+ "Insert the beginning of a resource declaration. All valid
+attributes from the RESOURCE alist are inserted. If the RESOURCE
+defines a property \"resource_id\" it will be used as the id for
+this resource. Otherwise it will use the ID property. If neither
+is defined it will calculate a unique id for the resource using
+`org-taskjuggler-get-unique-id'."
+ (let ((id (org-taskjuggler-clean-id
+ (or (cdr (assoc "resource_id" resource))
+ (cdr (assoc "ID" resource))
+ (cdr (assoc "unique-id" resource)))))
+ (headline (cdr (assoc "headline" resource)))
+ (attributes '(limits vacation shift booking efficiency journalentry rate)))
+ (insert
+ (concat
+ "resource " id " \"" headline "\" {\n "
+ (org-taskjuggler-get-attributes resource attributes) "\n"))))
+
+(defun org-taskjuggler-clean-effort (effort)
+ "Translate effort strings into a format acceptable to taskjuggler,
+i.e. REAL UNIT. A valid effort string can be anything that is
+accepted by `org-duration-string-to-minutes´."
+ (cond
+ ((null effort) effort)
+ (t (let* ((minutes (org-duration-string-to-minutes effort))
+ (hours (/ minutes 60.0)))
+ (format "%.1fh" hours)))))
+
+(defun org-taskjuggler-get-priority (priority)
+ "Return a priority between 1 and 1000 based on PRIORITY, an
+org-mode priority string."
+ (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority)))
+ (- org-lowest-priority org-highest-priority))))
+
+(defun org-taskjuggler-open-task (task)
+ (let* ((unique-id (cdr (assoc "unique-id" task)))
+ (headline (cdr (assoc "headline" task)))
+ (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
+ (depends (cdr (assoc "depends" task)))
+ (allocate (cdr (assoc "allocate" task)))
+ (priority-raw (cdr (assoc "PRIORITY" task)))
+ (priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
+ (state (cdr (assoc "TODO" task)))
+ (complete (or (and (member state org-done-keywords) "100")
+ (cdr (assoc "complete" task))))
+ (parent-ordered (cdr (assoc "parent-ordered" task)))
+ (previous-sibling (cdr (assoc "previous-sibling" task)))
+ (milestone (or (cdr (assoc "milestone" task))
+ (and (assoc "leaf-node" task)
+ (not (or effort
+ (cdr (assoc "duration" task))
+ (cdr (assoc "end" task))
+ (cdr (assoc "period" task)))))))
+ (attributes
+ '(account start note duration endbuffer endcredit end
+ flags journalentry length maxend maxstart minend
+ minstart period reference responsible scheduling
+ startbuffer startcredit statusnote)))
+ (insert
+ (concat
+ "task " unique-id " \"" headline "\" {\n"
+ (if (and parent-ordered previous-sibling)
+ (format " depends %s\n" previous-sibling)
+ (and depends (format " depends %s\n" depends)))
+ (and allocate (format " purge %s\n allocate %s\n"
+ (or (and (org-taskjuggler-targeting-tj3-p) "allocate")
+ "allocations")
+ allocate))
+ (and complete (format " complete %s\n" complete))
+ (and effort (format " effort %s\n" effort))
+ (and priority (format " priority %s\n" priority))
+ (and milestone (format " milestone\n"))
+
+ (org-taskjuggler-get-attributes task attributes)
+ "\n"))))
+
+(defun org-taskjuggler-close-maybe (level)
+ (while (> org-export-taskjuggler-old-level level)
+ (insert "}\n")
+ (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level)))
+ (when (= org-export-taskjuggler-old-level level)
+ (insert "}\n")))
+
+(defun org-taskjuggler-insert-reports ()
+ (let (report)
+ (dolist (report org-export-taskjuggler-default-reports)
+ (insert report "\n"))))
+
+(provide 'org-taskjuggler)
+
+;;; org-taskjuggler.el ends here
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
new file mode 100644
index 0000000..92aaf1c
--- /dev/null
+++ b/lisp/org-timer.el
@@ -0,0 +1,446 @@
+;;; org-timer.el --- The relative timer code for Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the relative timer code for Org-mode
+
+;;; Code:
+
+(require 'org)
+
+(declare-function org-notify "org-clock" (notification &optional play-sound))
+(declare-function org-agenda-error "org-agenda" ())
+
+(defvar org-timer-start-time nil
+ "t=0 for the running timer.")
+
+(defvar org-timer-pause-time nil
+ "Time when the timer was paused.")
+
+(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
+ "Regular expression used to match timer stamps.")
+
+(defcustom org-timer-format "%s "
+ "The format to insert the time of the timer.
+This format must contain one instance of \"%s\" which will be replaced by
+the value of the relative timer."
+ :group 'org-time
+ :type 'string)
+
+(defcustom org-timer-default-timer 0
+ "The default timer when a timer is set.
+When 0, the user is prompted for a value."
+ :group 'org-time
+ :version "24.1"
+ :type 'number)
+
+(defcustom org-timer-display 'mode-line
+ "When a timer is running, org-mode can display it in the mode
+line and/or frame title.
+Allowed values are:
+
+both displays in both mode line and frame title
+mode-line displays only in mode line (default)
+frame-title displays only in frame title
+nil current timer is not displayed"
+ :group 'org-time
+ :type '(choice
+ (const :tag "Mode line" mode-line)
+ (const :tag "Frame title" frame-title)
+ (const :tag "Both" both)
+ (const :tag "None" nil)))
+
+(defvar org-timer-start-hook nil
+ "Hook run after relative timer is started.")
+
+(defvar org-timer-stop-hook nil
+ "Hook run before relative timer is stopped.")
+
+(defvar org-timer-pause-hook nil
+ "Hook run before relative timer is paused.")
+
+(defvar org-timer-continue-hook nil
+ "Hook run after relative timer is continued.")
+
+(defvar org-timer-set-hook nil
+ "Hook run after countdown timer is set.")
+
+(defvar org-timer-done-hook nil
+ "Hook run after countdown timer reaches zero.")
+
+(defvar org-timer-cancel-hook nil
+ "Hook run before countdown timer is canceled.")
+
+;;;###autoload
+(defun org-timer-start (&optional offset)
+ "Set the starting time for the relative timer to now.
+When called with prefix argument OFFSET, prompt the user for an offset time,
+with the default taken from a timer stamp at point, if any.
+If OFFSET is a string or an integer, it is directly taken to be the offset
+without user interaction.
+When called with a double prefix arg, all timer strings in the active
+region will be shifted by a specific amount. You will be prompted for
+the amount, with the default to make the first timer string in
+the region 0:00:00."
+ (interactive "P")
+ (if (equal offset '(16))
+ (call-interactively 'org-timer-change-times-in-region)
+ (let (delta def s)
+ (if (not offset)
+ (setq org-timer-start-time (current-time))
+ (cond
+ ((integerp offset) (setq delta offset))
+ ((stringp offset) (setq delta (org-timer-hms-to-secs offset)))
+ (t
+ (setq def (if (org-in-regexp org-timer-re)
+ (match-string 0)
+ "0:00:00")
+ s (read-string
+ (format "Restart timer with offset [%s]: " def)))
+ (unless (string-match "\\S-" s) (setq s def))
+ (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
+ (setq org-timer-start-time
+ (seconds-to-time
+ (- (org-float-time) delta))))
+ (org-timer-set-mode-line 'on)
+ (message "Timer start time set to %s, current value is %s"
+ (format-time-string "%T" org-timer-start-time)
+ (org-timer-secs-to-hms (or delta 0)))
+ (run-hooks 'org-timer-start-hook))))
+
+;;;###autoload
+(defun org-timer-pause-or-continue (&optional stop)
+ "Pause or continue the relative timer.
+With prefix arg STOP, stop it entirely."
+ (interactive "P")
+ (cond
+ (stop (org-timer-stop))
+ ((not org-timer-start-time) (error "No timer is running"))
+ (org-timer-pause-time
+ ;; timer is paused, continue
+ (setq org-timer-start-time
+ (seconds-to-time
+ (-
+ (org-float-time)
+ (- (org-float-time org-timer-pause-time)
+ (org-float-time org-timer-start-time))))
+ org-timer-pause-time nil)
+ (org-timer-set-mode-line 'on)
+ (run-hooks 'org-timer-continue-hook)
+ (message "Timer continues at %s" (org-timer-value-string)))
+ (t
+ ;; pause timer
+ (run-hooks 'org-timer-pause-hook)
+ (setq org-timer-pause-time (current-time))
+ (org-timer-set-mode-line 'pause)
+ (message "Timer paused at %s" (org-timer-value-string)))))
+
+;;;###autoload
+(defun org-timer-stop ()
+ "Stop the relative timer."
+ (interactive)
+ (run-hooks 'org-timer-stop-hook)
+ (setq org-timer-start-time nil
+ org-timer-pause-time nil)
+ (org-timer-set-mode-line 'off))
+
+;;;###autoload
+(defun org-timer (&optional restart no-insert-p)
+ "Insert a H:MM:SS string from the timer into the buffer.
+The first time this command is used, the timer is started. When used with
+a \\[universal-argument] prefix, force restarting the timer.
+When used with a double prefix argument \\[universal-argument], change all the timer string
+in the region by a fixed amount. This can be used to recalibrate a timer
+that was not started at the correct moment.
+
+If NO-INSERT-P is non-nil, return the string instead of inserting
+it in the buffer."
+ (interactive "P")
+ (when (or (equal restart '(4)) (not org-timer-start-time))
+ (org-timer-start))
+ (if no-insert-p
+ (org-timer-value-string)
+ (insert (org-timer-value-string))))
+
+(defun org-timer-value-string ()
+ (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds)))))
+
+(defvar org-timer-timer-is-countdown nil)
+(defun org-timer-seconds ()
+ (if org-timer-timer-is-countdown
+ (- (org-float-time org-timer-start-time)
+ (org-float-time (current-time)))
+ (- (org-float-time (or org-timer-pause-time (current-time)))
+ (org-float-time org-timer-start-time))))
+
+;;;###autoload
+(defun org-timer-change-times-in-region (beg end delta)
+ "Change all h:mm:ss time in region by a DELTA."
+ (interactive
+ "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ")
+ (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p)
+ (unless (string-match "\\S-" delta)
+ (save-excursion
+ (goto-char beg)
+ (when (re-search-forward re end t)
+ (setq delta (match-string 0))
+ (if (equal (string-to-char delta) ?-)
+ (setq delta (substring delta 1))
+ (setq delta (concat "-" delta))))))
+ (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta)))
+ (when (= delta 0) (error "No change"))
+ (save-excursion
+ (goto-char end)
+ (while (re-search-backward re beg t)
+ (setq p (point))
+ (replace-match
+ (save-match-data
+ (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta)))
+ t t)
+ (goto-char p)))))
+
+;;;###autoload
+(defun org-timer-item (&optional arg)
+ "Insert a description-type item with the current timer value."
+ (interactive "P")
+ (let ((itemp (org-in-item-p)) (pos (point)))
+ (cond
+ ;; In a timer list, insert with `org-list-insert-item',
+ ;; then fix the list.
+ ((and itemp (goto-char itemp) (org-at-item-timer-p))
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (s (concat (org-timer (when arg '(4)) t) ":: ")))
+ (setq struct (org-list-insert-item pos struct prevs nil s))
+ (org-list-write-struct struct (org-list-parents-alist struct))
+ (looking-at org-list-full-item-re)
+ (goto-char (match-end 0))))
+ ;; In a list of another type, don't break anything: throw an error.
+ (itemp (goto-char pos) (error "This is not a timer list"))
+ ;; Else, start a new list.
+ (t
+ (beginning-of-line)
+ (org-indent-line)
+ (insert "- ")
+ (org-timer (when arg '(4)))
+ (insert ":: ")))))
+
+(defun org-timer-fix-incomplete (hms)
+ "If hms is a H:MM:SS string with missing hour or hour and minute, fix it."
+ (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms)
+ (replace-match
+ (format "%d:%02d:%02d"
+ (if (match-end 1) (string-to-number (match-string 1 hms)) 0)
+ (if (match-end 2) (string-to-number (match-string 2 hms)) 0)
+ (string-to-number (match-string 3 hms)))
+ t t hms)
+ (error "Cannot parse HMS string \"%s\"" hms)))
+
+(defun org-timer-hms-to-secs (hms)
+ "Convert h:mm:ss string to an integer time.
+If the string starts with a minus sign, the integer will be negative."
+ (if (not (string-match
+ "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
+ hms))
+ 0
+ (let* ((h (string-to-number (match-string 1 hms)))
+ (m (string-to-number (match-string 2 hms)))
+ (s (string-to-number (match-string 3 hms)))
+ (sign (equal (substring (match-string 1 hms) 0 1) "-")))
+ (setq h (abs h))
+ (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h))))))))
+
+(defun org-timer-secs-to-hms (s)
+ "Convert integer S into h:mm:ss.
+If the integer is negative, the string will start with \"-\"."
+ (let (sign m h)
+ (setq sign (if (< s 0) "-" "")
+ s (abs s)
+ m (/ s 60) s (- s (* 60 m))
+ h (/ m 60) m (- m (* 60 h)))
+ (format "%s%d:%02d:%02d" sign h m s)))
+
+(defvar org-timer-mode-line-timer nil)
+(defvar org-timer-mode-line-string nil)
+
+(defun org-timer-set-mode-line (value)
+ "Set the mode-line display of the relative timer.
+VALUE can be `on', `off', or `pause'."
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
+ (cond
+ ((equal value 'off)
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (setq global-mode-string
+ (delq 'org-timer-mode-line-string global-mode-string)))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (setq frame-title-format
+ (delq 'org-timer-mode-line-string frame-title-format)))
+ (force-mode-line-update))
+ ((equal value 'pause)
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil)))
+ ((equal value 'on)
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
+ (org-timer-update-mode-line)
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when org-timer-display
+ (setq org-timer-mode-line-timer
+ (run-with-timer 1 1 'org-timer-update-mode-line))))))
+
+(defun org-timer-update-mode-line ()
+ "Update the timer time in the mode line."
+ (if org-timer-pause-time
+ nil
+ (setq org-timer-mode-line-string
+ (concat " <" (substring (org-timer-value-string) 0 -1) ">"))
+ (force-mode-line-update)))
+
+(defvar org-timer-current-timer nil)
+(defun org-timer-cancel-timer ()
+ "Cancel the current timer."
+ (interactive)
+ (when (eval org-timer-current-timer)
+ (run-hooks 'org-timer-cancel-hook)
+ (cancel-timer org-timer-current-timer)
+ (setq org-timer-current-timer nil)
+ (setq org-timer-timer-is-countdown nil)
+ (org-timer-set-mode-line 'off))
+ (message "Last timer canceled"))
+
+(defun org-timer-show-remaining-time ()
+ "Display the remaining time before the timer ends."
+ (interactive)
+ (require 'time)
+ (if (not org-timer-current-timer)
+ (message "No timer set")
+ (let* ((rtime (decode-time
+ (time-subtract (timer--time org-timer-current-timer)
+ (current-time))))
+ (rsecs (nth 0 rtime))
+ (rmins (nth 1 rtime)))
+ (message "%d minute(s) %d seconds left before next time out"
+ rmins rsecs))))
+
+;;;###autoload
+(defun org-timer-set-timer (&optional opt)
+ "Prompt for a duration and set a timer.
+
+If `org-timer-default-timer' is not zero, suggest this value as
+the default duration for the timer. If a timer is already set,
+prompt the user if she wants to replace it.
+
+Called with a numeric prefix argument, use this numeric value as
+the duration of the timer.
+
+Called with a `C-u' prefix arguments, use `org-timer-default-timer'
+without prompting the user for a duration.
+
+With two `C-u' prefix arguments, use `org-timer-default-timer'
+without prompting the user for a duration and automatically
+replace any running timer."
+ (interactive "P")
+ (let ((minutes (or (and (numberp opt) (number-to-string opt))
+ (and (listp opt) (not (null opt))
+ (number-to-string org-timer-default-timer))
+ (read-from-minibuffer
+ "How many minutes left? "
+ (if (not (eq org-timer-default-timer 0))
+ (number-to-string org-timer-default-timer))))))
+ (if (not (string-match "[0-9]+" minutes))
+ (org-timer-show-remaining-time)
+ (let* ((mins (string-to-number (match-string 0 minutes)))
+ (secs (* mins 60))
+ (hl (cond
+ ((string-match "Org Agenda" (buffer-name))
+ (let* ((marker (or (get-text-property (point) 'org-marker)
+ (org-agenda-error)))
+ (hdmarker (or (get-text-property (point) 'org-hd-marker)
+ marker))
+ (pos (marker-position marker)))
+ (with-current-buffer (marker-buffer marker)
+ (widen)
+ (goto-char pos)
+ (org-show-entry)
+ (or (ignore-errors (org-get-heading))
+ (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
+ ((derived-mode-p 'org-mode)
+ (or (ignore-errors (org-get-heading))
+ (concat "File:" (file-name-nondirectory (buffer-file-name)))))
+ (t (error "Not in an Org buffer"))))
+ timer-set)
+ (if (or (and org-timer-current-timer
+ (or (equal opt '(16))
+ (y-or-n-p "Replace current timer? ")))
+ (not org-timer-current-timer))
+ (progn
+ (require 'org-clock)
+ (when org-timer-current-timer
+ (cancel-timer org-timer-current-timer))
+ (setq org-timer-current-timer
+ (run-with-timer
+ secs nil `(lambda ()
+ (setq org-timer-current-timer nil)
+ (org-notify ,(format "%s: time out" hl) t)
+ (setq org-timer-timer-is-countdown nil)
+ (org-timer-set-mode-line 'off)
+ (run-hooks 'org-timer-done-hook))))
+ (run-hooks 'org-timer-set-hook)
+ (setq org-timer-timer-is-countdown t
+ org-timer-start-time
+ (time-add (current-time) (seconds-to-time (* mins 60))))
+ (org-timer-set-mode-line 'on))
+ (message "No timer set"))))))
+
+(provide 'org-timer)
+
+;;; org-timer.el ends here
diff --git a/lisp/org-version.el b/lisp/org-version.el
new file mode 100644
index 0000000..4505eb0
--- /dev/null
+++ b/lisp/org-version.el
@@ -0,0 +1,27 @@
+;;; org-version.el --- autogenerated file, do not edit
+;;
+;;; Code:
+;;;###autoload
+(defun org-release ()
+ "The release version of org-mode.
+ Inserted by installing org-mode or when a release is made."
+ (let ((org-release "7.9.2"))
+ org-release))
+;;;###autoload
+(defun org-git-version ()
+ "The Git version of org-mode.
+ Inserted by installing org-mode or when a release is made."
+ (let ((org-git-version "7.9.2-dist"))
+ org-git-version))
+;;;###autoload
+(defconst org-odt-data-dir "/usr/share/emacs/etc/org"
+ "The location of ODT styles.")
+
+(provide 'org-version)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; coding: utf-8
+;; End:
+;;; org-version.el ends here
diff --git a/lisp/org-vm.el b/lisp/org-vm.el
new file mode 100644
index 0000000..b919cd1
--- /dev/null
+++ b/lisp/org-vm.el
@@ -0,0 +1,180 @@
+;;; org-vm.el --- Support for links to VM messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; Support for IMAP folders added
+;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
+;; Requires VM 8.2.0a or later.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;; This file implements links to VM messages and folders from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+;; Declare external functions and variables
+(declare-function vm-preview-current-message "ext:vm-page" ())
+(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
+(declare-function vm-get-header-contents "ext:vm-summary"
+ (message header-name-regexp &optional clump-sep))
+(declare-function vm-isearch-narrow "ext:vm-search" ())
+(declare-function vm-isearch-update "ext:vm-search" ())
+(declare-function vm-select-folder-buffer "ext:vm-macro" ())
+(declare-function vm-su-message-id "ext:vm-summary" (m))
+(declare-function vm-su-subject "ext:vm-summary" (m))
+(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
+(declare-function vm-imap-folder-p "ext:vm-save" ())
+(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
+(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
+(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
+(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
+(defvar vm-message-pointer)
+(defvar vm-folder-directory)
+
+;; Install the link type
+(org-add-link-type "vm" 'org-vm-open)
+(org-add-link-type "vm-imap" 'org-vm-imap-open)
+(add-hook 'org-store-link-functions 'org-vm-store-link)
+
+;; Implementation
+(defun org-vm-store-link ()
+ "Store a link to a VM folder or message."
+ (when (and (or (eq major-mode 'vm-summary-mode)
+ (eq major-mode 'vm-presentation-mode))
+ (save-window-excursion
+ (vm-select-folder-buffer) buffer-file-name))
+ (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
+ (vm-follow-summary-cursor)
+ (save-excursion
+ (vm-select-folder-buffer)
+ (let* ((message (car vm-message-pointer))
+ (subject (vm-su-subject message))
+ (to (vm-get-header-contents message "To"))
+ (from (vm-get-header-contents message "From"))
+ (message-id (vm-su-message-id message))
+ (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
+ (date (vm-get-header-contents message "Date"))
+ (date-ts (and date (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time date))))
+ (date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ folder desc link)
+ (if (vm-imap-folder-p)
+ (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
+ (setq folder (vm-imap-folder-for-spec spec)))
+ (progn
+ (setq folder (abbreviate-file-name buffer-file-name))
+ (if (and vm-folder-directory
+ (string-match (concat "^" (regexp-quote vm-folder-directory))
+ folder))
+ (setq folder (replace-match "" t t folder)))))
+ (setq message-id (org-remove-angle-brackets message-id))
+ (org-store-link-props :type link-type :from from :to to :subject subject
+ :message-id message-id)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq desc (org-email-link-description))
+ (setq link (concat (concat link-type ":") folder "#" message-id))
+ (org-add-link-props :link link :description desc)
+ link))))
+
+(defun org-vm-open (path)
+ "Follow a VM message link specified by PATH."
+ (let (folder article)
+ (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in VM link"))
+ (setq folder (match-string 1 path)
+ article (match-string 3 path))
+ ;; The prefix argument will be interpreted as read-only
+ (org-vm-follow-link folder article current-prefix-arg)))
+
+(defun org-vm-follow-link (&optional folder article readonly)
+ "Follow a VM link to FOLDER and ARTICLE."
+ (require 'vm)
+ (setq article (org-add-angle-brackets article))
+ (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
+ ;; ange-ftp or efs or tramp access
+ (let ((user (or (match-string 1 folder) (user-login-name)))
+ (host (match-string 2 folder))
+ (file (match-string 3 folder)))
+ (cond
+ ((featurep 'tramp)
+ ;; use tramp to access the file
+ (if (featurep 'xemacs)
+ (setq folder (format "[%s@%s]%s" user host file))
+ (setq folder (format "/%s@%s:%s" user host file))))
+ (t
+ ;; use ange-ftp or efs
+ (require (if (featurep 'xemacs) 'efs 'ange-ftp))
+ (setq folder (format "/%s@%s:%s" user host file))))))
+ (when folder
+ (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
+ (when article
+ (org-vm-select-message (org-add-angle-brackets article)))))
+
+(defun org-vm-imap-open (path)
+ "Follow a VM link to an IMAP folder."
+ (require 'vm-imap)
+ (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
+ (let* ((account-name (match-string 1 path))
+ (mailbox-name (match-string 2 path))
+ (message-id (match-string 3 path))
+ (account-spec (vm-imap-parse-spec-to-list
+ (vm-imap-spec-for-account account-name)))
+ (mailbox-spec (mapconcat 'identity
+ (append (butlast account-spec 4)
+ (cons mailbox-name
+ (last account-spec 3)))
+ ":")))
+ (funcall (cdr (assq 'vm-imap org-link-frame-setup))
+ mailbox-spec)
+ (when message-id
+ (org-vm-select-message (org-add-angle-brackets message-id))))))
+
+(defun org-vm-select-message (message-id)
+ "Go to the message with message-id in the current folder."
+ (require 'vm-search)
+ (sit-for 0.1)
+ (vm-select-folder-buffer)
+ (widen)
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (if (not (re-search-forward
+ (concat "^" "message-id: *" (regexp-quote message-id))))
+ (error "Could not find the specified message in this folder"))
+ (vm-isearch-update)
+ (vm-isearch-narrow)
+ (vm-preview-current-message)
+ (vm-summarize)))
+
+(provide 'org-vm)
+
+
+
+;;; org-vm.el ends here
diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el
new file mode 100644
index 0000000..bad2003
--- /dev/null
+++ b/lisp/org-w3m.el
@@ -0,0 +1,170 @@
+;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
+
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+
+;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements copying HTML content from a w3m buffer and
+;; transforming the text on the fly so that it can be pasted into
+;; an org-mode buffer with hot links. It will also work for regions
+;; in gnus buffers that have been washed with w3m.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Acknowledgments:
+
+;; Richard Riley <rileyrgdev at googlemail dot com>
+;;
+;; The idea of transforming the HTML content with org-mode style is
+;; proposed by Richard, I'm just coding it.
+;;
+
+;;; Code:
+
+(require 'org)
+
+(defun org-w3m-copy-for-org-mode ()
+ "Copy current buffer content or active region with `org-mode' style links.
+This will encode `link-title' and `link-location' with
+`org-make-link-string', and insert the transformed test into the kill ring,
+so that it can be yanked into an Org-mode buffer with links working correctly."
+ (interactive)
+ (let* ((regionp (org-region-active-p))
+ (transform-start (point-min))
+ (transform-end (point-max))
+ return-content
+ link-location link-title
+ temp-position out-bound)
+ (when regionp
+ (setq transform-start (region-beginning))
+ (setq transform-end (region-end))
+ ;; Deactivate mark if current mark is activate.
+ (if (fboundp 'deactivate-mark) (deactivate-mark)))
+ (message "Transforming links...")
+ (save-excursion
+ (goto-char transform-start)
+ (while (and (not out-bound) ; still inside region to copy
+ (not (org-w3m-no-next-link-p))) ; no next link current buffer
+ ;; store current point before jump next anchor
+ (setq temp-position (point))
+ ;; move to next anchor when current point is not at anchor
+ (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start))
+ (if (<= (point) transform-end) ; if point is inside transform bound
+ (progn
+ ;; get content between two links.
+ (if (> (point) temp-position)
+ (setq return-content (concat return-content
+ (buffer-substring
+ temp-position (point)))))
+ ;; get link location at current point.
+ (setq link-location (get-text-property (point) 'w3m-href-anchor))
+ ;; get link title at current point.
+ (setq link-title (buffer-substring (point)
+ (org-w3m-get-anchor-end)))
+ ;; concat `org-mode' style url to `return-content'.
+ (setq return-content (concat return-content
+ (org-make-link-string
+ link-location link-title))))
+ (goto-char temp-position) ; reset point before jump next anchor
+ (setq out-bound t) ; for break out `while' loop
+ ))
+ ;; add the rest until end of the region to be copied
+ (if (< (point) transform-end)
+ (setq return-content
+ (concat return-content
+ (buffer-substring (point) transform-end))))
+ (org-kill-new return-content)
+ (message "Transforming links...done, use C-y to insert text into Org-mode file")
+ (message "Copy with link transformation complete."))))
+
+(defun org-w3m-get-anchor-start ()
+ "Move cursor to the start of current anchor. Return point."
+ ;; get start position of anchor or current point
+ (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence)
+ (point))))
+
+(defun org-w3m-get-anchor-end ()
+ "Move cursor to the end of current anchor. Return point."
+ ;; get end position of anchor or point
+ (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence)
+ (point))))
+
+(defun org-w3m-get-next-link-start ()
+ "Move cursor to the start of next link. Return point."
+ (catch 'reach
+ (while (next-single-property-change (point) 'w3m-anchor-sequence)
+ ;; jump to next anchor
+ (goto-char (next-single-property-change (point) 'w3m-anchor-sequence))
+ (when (get-text-property (point) 'w3m-href-anchor)
+ ;; return point when current is valid link
+ (throw 'reach nil))))
+ (point))
+
+(defun org-w3m-get-prev-link-start ()
+ "Move cursor to the start of previous link. Return point."
+ (catch 'reach
+ (while (previous-single-property-change (point) 'w3m-anchor-sequence)
+ ;; jump to previous anchor
+ (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence))
+ (when (get-text-property (point) 'w3m-href-anchor)
+ ;; return point when current is valid link
+ (throw 'reach nil))))
+ (point))
+
+(defun org-w3m-no-next-link-p ()
+ "Whether there is no next link after the cursor.
+Return t if there is no next link; otherwise, return nil."
+ (save-excursion
+ (equal (point) (org-w3m-get-next-link-start))))
+
+(defun org-w3m-no-prev-link-p ()
+ "Whether there is no previous link after the cursor.
+Return t if there is no previous link; otherwise, return nil."
+ (save-excursion
+ (equal (point) (org-w3m-get-prev-link-start))))
+
+;; Install keys into the w3m keymap
+(defvar w3m-mode-map)
+(defvar w3m-minor-mode-map)
+(when (and (boundp 'w3m-mode-map)
+ (keymapp w3m-mode-map))
+ (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
+ (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
+(when (and (boundp 'w3m-minor-mode-map)
+ (keymapp w3m-minor-mode-map))
+ (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
+ (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))
+(add-hook
+ 'w3m-mode-hook
+ (lambda ()
+ (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
+ (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
+(add-hook
+ 'w3m-minor-mode-hook
+ (lambda ()
+ (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode)
+ (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)))
+
+(provide 'org-w3m)
+
+;;; org-w3m.el ends here
diff --git a/lisp/org-wl.el b/lisp/org-wl.el
new file mode 100644
index 0000000..724b07a
--- /dev/null
+++ b/lisp/org-wl.el
@@ -0,0 +1,316 @@
+;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
+;; David Maus <dmaus at ictsoc dot de>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to Wanderlust messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+(defgroup org-wl nil
+ "Options concerning the Wanderlust link."
+ :tag "Org Startup"
+ :group 'org-link)
+
+(defcustom org-wl-link-to-refile-destination t
+ "Create a link to the refile destination if the message is marked as refile."
+ :group 'org-wl
+ :type 'boolean)
+
+(defcustom org-wl-link-remove-filter nil
+ "Remove filter condition if message is filter folder."
+ :group 'org-wl
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-wl-shimbun-prefer-web-links nil
+ "If non-nil create web links for shimbun messages."
+ :group 'org-wl
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-wl-nntp-prefer-web-links nil
+ "If non-nil create web links for nntp messages.
+When folder name contains string \"gmane\" link to gmane,
+googlegroups otherwise."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-wl)
+
+(defcustom org-wl-disable-folder-check t
+ "Disable check for new messages when open a link."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-wl)
+
+(defcustom org-wl-namazu-default-index nil
+ "Default namazu search index."
+ :type 'directory
+ :version "24.1"
+ :group 'org-wl)
+
+;; Declare external functions and variables
+(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
+(declare-function elmo-message-entity-field "ext:elmo-msgdb"
+ (entity field &optional type))
+(declare-function elmo-message-field "ext:elmo"
+ (folder number field &optional type) t)
+(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t)
+;; Backward compatibility to old version of wl
+(declare-function wl "ext:wl" () t)
+(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
+(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
+ (&optional id))
+(declare-function wl-summary-jump-to-msg "ext:wl-summary"
+ (&optional number beg end))
+(declare-function wl-summary-line-from "ext:wl-summary" ())
+(declare-function wl-summary-line-subject "ext:wl-summary" ())
+(declare-function wl-summary-message-number "ext:wl-summary" ())
+(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
+(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
+(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
+ (&optional folder sticky))
+(declare-function wl-folder-get-petname "ext:wl-folder" (name))
+(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
+ (&optional getid))
+(declare-function wl-folder-buffer-group-p "ext:wl-folder")
+(defvar wl-init)
+(defvar wl-summary-buffer-elmo-folder)
+(defvar wl-summary-buffer-folder-name)
+(defvar wl-folder-group-regexp)
+(defvar wl-auto-check-folder-name)
+(defvar elmo-nntp-default-server)
+
+(defconst org-wl-folder-types
+ '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
+ ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search)
+ ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal))
+ "List of folder indicators. See Wanderlust manual, section 3.")
+
+;; Install the link type
+(org-add-link-type "wl" 'org-wl-open)
+(add-hook 'org-store-link-functions 'org-wl-store-link)
+
+;; Implementation
+
+(defun org-wl-folder-type (folder)
+ "Return symbol that indicates the type of FOLDER.
+FOLDER is the wanderlust folder name. The first character of the
+folder name determines the folder type."
+ (let* ((indicator (substring folder 0 1))
+ (type (cdr (assoc indicator org-wl-folder-types))))
+ ;; maybe access or file folder
+ (when (not type)
+ (setq type
+ (cond
+ ((and (>= (length folder) 5)
+ (string= (substring folder 0 5) "file:"))
+ 'file)
+ ((and (>= (length folder) 7)
+ (string= (substring folder 0 7) "access:"))
+ 'access)
+ (t
+ nil))))
+ type))
+
+(defun org-wl-message-field (field entity)
+ "Return content of FIELD in ENTITY.
+FIELD is a symbol of a rfc822 message header field.
+ENTITY is a message entity."
+ (let ((content (elmo-message-entity-field entity field 'string)))
+ (if (listp content) (car content) content)))
+
+(defun org-wl-store-link ()
+ "Store a link to a WL message or folder."
+ (unless (eobp)
+ (cond
+ ((memq major-mode '(wl-summary-mode mime-view-mode))
+ (org-wl-store-link-message))
+ ((eq major-mode 'wl-folder-mode)
+ (org-wl-store-link-folder))
+ (t
+ nil))))
+
+(defun org-wl-store-link-folder ()
+ "Store a link to a WL folder."
+ (let* ((folder (wl-folder-get-entity-from-buffer))
+ (petname (wl-folder-get-petname folder))
+ (link (concat "wl:" folder)))
+ (save-excursion
+ (beginning-of-line)
+ (unless (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
+ (org-store-link-props :type "wl" :description petname
+ :link link)
+ link))))
+
+(defun org-wl-store-link-message ()
+ "Store a link to a WL message."
+ (save-excursion
+ (let ((buf (if (eq major-mode 'wl-summary-mode)
+ (current-buffer)
+ (and (boundp 'wl-message-buffer-cur-summary-buffer)
+ wl-message-buffer-cur-summary-buffer))))
+ (when buf
+ (with-current-buffer buf
+ (let* ((msgnum (wl-summary-message-number))
+ (mark-info (wl-summary-registered-temp-mark msgnum))
+ (folder-name
+ (if (and org-wl-link-to-refile-destination
+ mark-info
+ (equal (nth 1 mark-info) "o")) ; marked as refile
+ (nth 2 mark-info)
+ wl-summary-buffer-folder-name))
+ (folder-type (org-wl-folder-type folder-name))
+ (wl-message-entity
+ (if (fboundp 'elmo-message-entity)
+ (elmo-message-entity
+ wl-summary-buffer-elmo-folder msgnum)
+ (elmo-msgdb-overview-get-entity
+ msgnum (wl-summary-buffer-msgdb))))
+ (message-id
+ (org-wl-message-field 'message-id wl-message-entity))
+ (message-id-no-brackets
+ (org-remove-angle-brackets message-id))
+ (from (org-wl-message-field 'from wl-message-entity))
+ (to (org-wl-message-field 'to wl-message-entity))
+ (xref (org-wl-message-field 'xref wl-message-entity))
+ (subject (org-wl-message-field 'subject wl-message-entity))
+ (date (org-wl-message-field 'date wl-message-entity))
+ (date-ts (and date (format-time-string
+ (org-time-stamp-format t)
+ (date-to-time date))))
+ (date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ desc link)
+
+ ;; remove text properties of subject string to avoid possible bug
+ ;; when formatting the subject
+ ;; (Emacs bug #5306, fixed)
+ (set-text-properties 0 (length subject) nil subject)
+
+ ;; maybe remove filter condition
+ (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
+ (while (eq (org-wl-folder-type folder-name) 'filter)
+ (setq folder-name
+ (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
+
+ ;; maybe create http link
+ (cond
+ ((and (eq folder-type 'shimbun)
+ org-wl-shimbun-prefer-web-links xref)
+ (org-store-link-props :type "http" :link xref :description subject
+ :from from :to to :message-id message-id
+ :message-id-no-brackets message-id-no-brackets
+ :subject subject))
+ ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
+ (setq link
+ (format
+ (if (string-match "gmane\\." folder-name)
+ "http://mid.gmane.org/%s"
+ "http://groups.google.com/groups/search?as_umsgid=%s")
+ (org-fixup-message-id-for-http message-id)))
+ (org-store-link-props :type "http" :link link :description subject
+ :from from :to to :message-id message-id
+ :message-id-no-brackets message-id-no-brackets
+ :subject subject))
+ (t
+ (org-store-link-props :type "wl" :from from :to to
+ :subject subject :message-id message-id
+ :message-id-no-brackets message-id-no-brackets)
+ (setq desc (org-email-link-description))
+ (setq link (concat "wl:" folder-name "#" message-id-no-brackets))
+ (org-add-link-props :link link :description desc)))
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (or link xref)))))))
+
+(defun org-wl-open-nntp (path)
+ "Follow the nntp: link specified by PATH."
+ (let* ((spec (split-string path "/"))
+ (server (split-string (nth 2 spec) "@"))
+ (group (nth 3 spec))
+ (article (nth 4 spec)))
+ (org-wl-open
+ (concat "-" group ":" (if (cdr server)
+ (car (split-string (car server) ":"))
+ "")
+ (if (string= elmo-nntp-default-server (nth 2 spec))
+ ""
+ (concat "@" (or (cdr server) (car server))))
+ (if article (concat "#" article) "")))))
+
+(defun org-wl-open (path)
+ "Follow the WL message link specified by PATH.
+When called with one prefix, open message in namazu search folder
+with `org-wl-namazu-default-index' as search index. When called
+with two prefixes or `org-wl-namazu-default-index' is nil, ask
+for namazu index."
+ (require 'wl)
+ (let ((wl-auto-check-folder-name
+ (if org-wl-disable-folder-check
+ 'none
+ wl-auto-check-folder-name)))
+ (unless wl-init (wl))
+ ;; XXX: The imap-uw's MH folder names start with "%#".
+ (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in Wanderlust link"))
+ (let ((folder (match-string 1 path))
+ (article (match-string 3 path)))
+ ;; maybe open message in namazu search folder
+ (when current-prefix-arg
+ (setq folder (concat "[" article "]"
+ (if (and (equal current-prefix-arg '(4))
+ org-wl-namazu-default-index)
+ org-wl-namazu-default-index
+ (read-directory-name "Namazu index: ")))))
+ (if (not (elmo-folder-exists-p (org-no-warnings
+ (wl-folder-get-elmo-folder folder))))
+ (error "No such folder: %s" folder))
+ (let ((old-buf (current-buffer))
+ (old-point (point-marker)))
+ (wl-folder-goto-folder-subr folder)
+ (with-current-buffer old-buf
+ ;; XXX: `wl-folder-goto-folder-subr' moves point to the
+ ;; beginning of the current line. So, restore the point
+ ;; in the old buffer.
+ (goto-char old-point))
+ (when article
+ (if (org-string-match-p "@" article)
+ (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
+ article))
+ (or (wl-summary-jump-to-msg (string-to-number article))
+ (error "No such message: %s" article)))
+ (wl-summary-redisplay))))))
+
+(provide 'org-wl)
+
+;;; org-wl.el ends here
diff --git a/lisp/org-xoxo.el b/lisp/org-xoxo.el
new file mode 100644
index 0000000..ee54962
--- /dev/null
+++ b/lisp/org-xoxo.el
@@ -0,0 +1,125 @@
+;;; org-xoxo.el --- XOXO export for Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;; XOXO export
+
+;;; Code:
+
+(require 'org-exp)
+
+(defvar org-export-xoxo-final-hook nil
+ "Hook run after XOXO export, in the new buffer.")
+
+(defun org-export-as-xoxo-insert-into (buffer &rest output)
+ (with-current-buffer buffer
+ (apply 'insert output)))
+(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
+
+;;;###autoload
+(defun org-export-as-xoxo (&optional buffer)
+ "Export the org buffer as XOXO.
+The XOXO buffer is named *xoxo-<source buffer name>*"
+ (interactive (list (current-buffer)))
+ (run-hooks 'org-export-first-hook)
+ ;; A quickie abstraction
+
+ ;; Output everything as XOXO
+ (with-current-buffer (get-buffer buffer)
+ (let* ((pos (point))
+ (opt-plist (org-combine-plists (org-default-export-plist)
+ (org-infile-export-plist)))
+ (filename (concat (file-name-as-directory
+ (org-export-directory :xoxo opt-plist))
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ ".html"))
+ (out (find-file-noselect filename))
+ (last-level 1)
+ (hanging-li nil))
+ (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
+ ;; Check the output buffer is empty.
+ (with-current-buffer out (erase-buffer))
+ ;; Kick off the output
+ (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
+ (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
+ (let* ((hd (match-string-no-properties 1))
+ (level (length hd))
+ (text (concat
+ (match-string-no-properties 2)
+ (save-excursion
+ (goto-char (match-end 0))
+ (let ((str ""))
+ (catch 'loop
+ (while 't
+ (forward-line)
+ (if (looking-at "^[ \t]\\(.*\\)")
+ (setq str (concat str (match-string-no-properties 1)))
+ (throw 'loop str)))))))))
+
+ ;; Handle level rendering
+ (cond
+ ((> level last-level)
+ (org-export-as-xoxo-insert-into out "\n<ol>\n"))
+
+ ((< level last-level)
+ (dotimes (- (- last-level level) 1)
+ (if hanging-li
+ (org-export-as-xoxo-insert-into out "</li>\n"))
+ (org-export-as-xoxo-insert-into out "</ol>\n"))
+ (when hanging-li
+ (org-export-as-xoxo-insert-into out "</li>\n")
+ (setq hanging-li nil)))
+
+ ((equal level last-level)
+ (if hanging-li
+ (org-export-as-xoxo-insert-into out "</li>\n")))
+ )
+
+ (setq last-level level)
+
+ ;; And output the new li
+ (setq hanging-li 't)
+ (if (equal ?+ (elt text 0))
+ (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
+ (org-export-as-xoxo-insert-into out "<li>" text))))
+
+ ;; Finally finish off the ol
+ (dotimes (- last-level 1)
+ (if hanging-li
+ (org-export-as-xoxo-insert-into out "</li>\n"))
+ (org-export-as-xoxo-insert-into out "</ol>\n"))
+
+ (goto-char pos)
+ ;; Finish the buffer off and clean it up.
+ (switch-to-buffer-other-window out)
+ (indent-region (point-min) (point-max) nil)
+ (run-hooks 'org-export-xoxo-final-hook)
+ (save-buffer)
+ (goto-char (point-min))
+ )))
+
+(provide 'org-xoxo)
+
+;;; org-xoxo.el ends here
diff --git a/lisp/org.el b/lisp/org.el
new file mode 100644
index 0000000..cfd8651
--- /dev/null
+++ b/lisp/org.el
@@ -0,0 +1,22447 @@
+;;; org.el --- Outline-based notes management and organizer
+
+;; Carstens outline-mode for keeping track of everything.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Maintainer: Bastien Guerry <bzg at gnu dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
+;; project planning with a fast and effective plain-text system.
+;;
+;; Org-mode develops organizational tasks around NOTES files that contain
+;; information about projects as plain text. Org-mode is implemented on
+;; top of outline-mode, which makes it possible to keep the content of
+;; large files well structured. Visibility cycling and structure editing
+;; help to work with the tree. Tables are easily created with a built-in
+;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
+;; and scheduling. It dynamically compiles entries into an agenda that
+;; utilizes and smoothly integrates much of the Emacs calendar and diary.
+;; Plain text URL-like links connect to websites, emails, Usenet
+;; messages, BBDB entries, and any files related to the projects. For
+;; printing and sharing of notes, an Org-mode file can be exported as a
+;; structured ASCII file, as HTML, or (todo and agenda items only) as an
+;; iCalendar file. It can also serve as a publishing tool for a set of
+;; linked webpages.
+;;
+;; Installation and Activation
+;; ---------------------------
+;; See the corresponding sections in the manual at
+;;
+;; http://orgmode.org/org.html#Installation
+;;
+;; Documentation
+;; -------------
+;; The documentation of Org-mode can be found in the TeXInfo file. The
+;; distribution also contains a PDF version of it. At the homepage of
+;; Org-mode, you can read the same text online as HTML. There is also an
+;; excellent reference card made by Philip Rooke. This card can be found
+;; in the etc/ directory of Emacs 22.
+;;
+;; A list of recent changes can be found at
+;; http://orgmode.org/Changes.html
+;;
+;;; Code:
+
+(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
+(defvar org-table-formula-constants-local nil
+ "Local version of `org-table-formula-constants'.")
+(make-variable-buffer-local 'org-table-formula-constants-local)
+
+;;;; Require other packages
+
+(eval-when-compile
+ (require 'cl)
+ (require 'gnus-sum))
+
+(require 'calendar)
+(require 'find-func)
+(require 'format-spec)
+
+;; `org-outline-regexp' ought to be a defconst but is let-binding in
+;; some places -- e.g. see the macro org-with-limited-levels.
+;;
+;; In Org buffers, the value of `outline-regexp' is that of
+;; `org-outline-regexp'. The only function still directly relying on
+;; `outline-regexp' is `org-overview' so that `org-cycle' can do its
+;; job when `orgstruct-mode' is active.
+(defvar org-outline-regexp "\\*+ "
+ "Regexp to match Org headlines.")
+
+(defvar org-outline-regexp-bol "^\\*+ "
+ "Regexp to match Org headlines.
+This is similar to `org-outline-regexp' but additionally makes
+sure that we are at the beginning of the line.")
+
+(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Matches an headline, putting stars and text into groups.
+Stars are put in group 1 and the trimmed body in group 2.")
+
+;; Emacs 22 calendar compatibility: Make sure the new variables are available
+(when (fboundp 'defvaralias)
+ (unless (boundp 'calendar-view-holidays-initially-flag)
+ (defvaralias 'calendar-view-holidays-initially-flag
+ 'view-calendar-holidays-initially))
+ (unless (boundp 'calendar-view-diary-initially-flag)
+ (defvaralias 'calendar-view-diary-initially-flag
+ 'view-diary-entries-initially))
+ (unless (boundp 'diary-fancy-buffer)
+ (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)))
+
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
+(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-at-clock-log-p "org-clock" ())
+(declare-function org-clock-timestamps-up "org-clock" ())
+(declare-function org-clock-timestamps-down "org-clock" ())
+(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
+
+;; load languages based on value of `org-babel-load-languages'
+(defvar org-babel-load-languages)
+;;;###autoload
+(defun org-babel-do-load-languages (sym value)
+ "Load the languages defined in `org-babel-load-languages'."
+ (set-default sym value)
+ (mapc (lambda (pair)
+ (let ((active (cdr pair)) (lang (symbol-name (car pair))))
+ (if active
+ (progn
+ (require (intern (concat "ob-" lang))))
+ (progn
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-execute:" lang)))
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-expand-body:" lang)))))))
+ org-babel-load-languages))
+
+(defcustom org-babel-load-languages '((emacs-lisp . t))
+ "Languages which can be evaluated in Org-mode buffers.
+This list can be used to load support for any of the languages
+below, note that each language will depend on a different set of
+system executables and/or Emacs modes. When a language is
+\"loaded\", then code blocks in that language can be evaluated
+with `org-babel-execute-src-block' bound by default to C-c
+C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can
+be set to remove code block evaluation from the C-c C-c
+keybinding. By default only Emacs Lisp (which has no
+requirements) is loaded."
+ :group 'org-babel
+ :set 'org-babel-do-load-languages
+ :version "24.1"
+ :type '(alist :tag "Babel Languages"
+ :key-type
+ (choice
+ (const :tag "Awk" awk)
+ (const :tag "C" C)
+ (const :tag "R" R)
+ (const :tag "Asymptote" asymptote)
+ (const :tag "Calc" calc)
+ (const :tag "Clojure" clojure)
+ (const :tag "CSS" css)
+ (const :tag "Ditaa" ditaa)
+ (const :tag "Dot" dot)
+ (const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Fortran" fortran)
+ (const :tag "Gnuplot" gnuplot)
+ (const :tag "Haskell" haskell)
+ (const :tag "IO" io)
+ (const :tag "Java" java)
+ (const :tag "Javascript" js)
+ (const :tag "LaTeX" latex)
+ (const :tag "Ledger" ledger)
+ (const :tag "Lilypond" lilypond)
+ (const :tag "Lisp" lisp)
+ (const :tag "Maxima" maxima)
+ (const :tag "Matlab" matlab)
+ (const :tag "Mscgen" mscgen)
+ (const :tag "Ocaml" ocaml)
+ (const :tag "Octave" octave)
+ (const :tag "Org" org)
+ (const :tag "Perl" perl)
+ (const :tag "Pico Lisp" picolisp)
+ (const :tag "PlantUML" plantuml)
+ (const :tag "Python" python)
+ (const :tag "Ruby" ruby)
+ (const :tag "Sass" sass)
+ (const :tag "Scala" scala)
+ (const :tag "Scheme" scheme)
+ (const :tag "Screen" screen)
+ (const :tag "Shell Script" sh)
+ (const :tag "Shen" shen)
+ (const :tag "Sql" sql)
+ (const :tag "Sqlite" sqlite))
+ :value-type (boolean :tag "Activate" :value t)))
+
+;;;; Customization variables
+(defcustom org-clone-delete-id nil
+ "Remove ID property of clones of a subtree.
+When non-nil, clones of a subtree don't inherit the ID property.
+Otherwise they inherit the ID property with a new unique
+identifier."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-id)
+
+;;; Version
+(require 'org-compat)
+(org-check-version)
+;;;###autoload
+(defun org-version (&optional here full message)
+ "Show the org-mode version in the echo area.
+With prefix argument HERE, insert it at point.
+When FULL is non-nil, use a verbose version string.
+When MESSAGE is non-nil, display a message with the version."
+ (interactive "P")
+ (let* ((org-dir (ignore-errors (org-find-library-dir "org")))
+ (org-install-dir (ignore-errors (org-find-library-dir "org-install.el")))
+ (org-trash (or
+ (and (fboundp 'org-release) (fboundp 'org-git-version))
+ (load (concat org-dir "org-version.el")
+ 'noerror 'nomessage 'nosuffix)))
+ (org-version (org-release))
+ (git-version (org-git-version))
+ (version (format "Org-mode version %s (%s @ %s)"
+ org-version
+ git-version
+ (if org-install-dir
+ (if (string= org-dir org-install-dir)
+ org-install-dir
+ (concat "mixed installation! " org-install-dir " and " org-dir))
+ "org-install.el can not be found!")))
+ (_version (if full version org-version)))
+ (if (org-called-interactively-p 'interactive)
+ (if here
+ (insert version)
+ (message version))
+ (if message (message _version))
+ _version)))
+
+(defconst org-version (org-version))
+
+;;; Compatibility constants
+
+;;; The custom variables
+
+(defgroup org nil
+ "Outline-based notes management and organizer."
+ :tag "Org"
+ :group 'outlines
+ :group 'calendar)
+
+(defcustom org-mode-hook nil
+ "Mode hook for Org-mode, run after the mode was turned on."
+ :group 'org
+ :type 'hook)
+
+(defcustom org-load-hook nil
+ "Hook that is run after org.el has been loaded."
+ :group 'org
+ :type 'hook)
+
+(defcustom org-log-buffer-setup-hook nil
+ "Hook that is run after an Org log buffer is created."
+ :group 'org
+ :version "24.1"
+ :type 'hook)
+
+(defvar org-modules) ; defined below
+(defvar org-modules-loaded nil
+ "Have the modules been loaded already?")
+
+(defun org-load-modules-maybe (&optional force)
+ "Load all extensions listed in `org-modules'."
+ (when (or force (not org-modules-loaded))
+ (mapc (lambda (ext)
+ (condition-case nil (require ext)
+ (error (message "Problems while trying to load feature `%s'" ext))))
+ org-modules)
+ (setq org-modules-loaded t)))
+
+(defun org-set-modules (var value)
+ "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
+ (set var value)
+ (when (featurep 'org)
+ (org-load-modules-maybe 'force)))
+
+(when (org-bound-and-true-p org-modules)
+ (let ((a (member 'org-infojs org-modules)))
+ (and a (setcar a 'org-jsinfo))))
+
+(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl)
+ "Modules that should always be loaded together with org.el.
+If a description starts with <C>, the file is not part of Emacs
+and loading it will require that you have downloaded and properly installed
+the org-mode distribution.
+
+You can also use this system to load external packages (i.e. neither Org
+core modules, nor modules from the CONTRIB directory). Just add symbols
+to the end of the list. If the package is called org-xyz.el, then you need
+to add the symbol `xyz', and the package must have a call to
+
+ (provide 'org-xyz)"
+ :group 'org
+ :set 'org-set-modules
+ :type
+ '(set :greedy t
+ (const :tag " bbdb: Links to BBDB entries" org-bbdb)
+ (const :tag " bibtex: Links to BibTeX entries" org-bibtex)
+ (const :tag " crypt: Encryption of subtrees" org-crypt)
+ (const :tag " ctags: Access to Emacs tags with links" org-ctags)
+ (const :tag " docview: Links to doc-view buffers" org-docview)
+ (const :tag " gnus: Links to GNUS folders/messages" org-gnus)
+ (const :tag " id: Global IDs for identifying entries" org-id)
+ (const :tag " info: Links to Info nodes" org-info)
+ (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo)
+ (const :tag " habit: Track your consistency with habits" org-habit)
+ (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
+ (const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
+ (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
+ (const :tag " mew Links to Mew folders/messages" org-mew)
+ (const :tag " mhe: Links to MHE folders/messages" org-mhe)
+ (const :tag " protocol: Intercept calls from emacsclient" org-protocol)
+ (const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
+ (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
+ (const :tag " vm: Links to VM folders/messages" org-vm)
+ (const :tag " wl: Links to Wanderlust folders/messages" org-wl)
+ (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
+ (const :tag " mouse: Additional mouse support" org-mouse)
+ (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler)
+
+ (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
+ (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
+ (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
+ (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
+ (const :tag "C collector: Collect properties into tables" org-collector)
+ (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
+ (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill)
+ (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
+ (const :tag "C eshell Support for links to working directories in eshell" org-eshell)
+ (const :tag "C eval: Include command output as text" org-eval)
+ (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
+ (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
+ (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
+ (const :tag "C git-link: Provide org links to specific file version" org-git-link)
+ (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
+
+ (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
+
+ (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
+ (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
+ (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
+ (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
+ (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
+ (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
+ (const :tag "C man: Support for links to manpages in Org-mode" org-man)
+ (const :tag "C mtags: Support for muse-like tags" org-mtags)
+ (const :tag "C panel: Simple routines for us with bad memory" org-panel)
+ (const :tag "C registry: A registry for Org-mode links" org-registry)
+ (const :tag "C org2rem: Convert org appointments into reminders" org2rem)
+ (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
+ (const :tag "C secretary: Team management with org-mode" org-secretary)
+ (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
+ (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
+ (const :tag "C track: Keep up with Org-mode development" org-track)
+ (const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
+ (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
+ (repeat :tag "External packages" :inline t (symbol :tag "Package"))))
+
+(defcustom org-support-shift-select nil
+ "Non-nil means make shift-cursor commands select text when possible.
+
+In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
+start selecting a region, or enlarge regions started in this way.
+In Org-mode, in special contexts, these same keys are used for
+other purposes, important enough to compete with shift selection.
+Org tries to balance these needs by supporting `shift-select-mode'
+outside these special contexts, under control of this variable.
+
+The default of this variable is nil, to avoid confusing behavior. Shifted
+cursor keys will then execute Org commands in the following contexts:
+- on a headline, changing TODO state (left/right) and priority (up/down)
+- on a time stamp, changing the time
+- in a plain list item, changing the bullet type
+- in a property definition line, switching between allowed values
+- in the BEGIN line of a clock table (changing the time block).
+Outside these contexts, the commands will throw an error.
+
+When this variable is t and the cursor is not in a special
+context, Org-mode will support shift-selection for making and
+enlarging regions. To make this more effective, the bullet
+cycling will no longer happen anywhere in an item line, but only
+if the cursor is exactly on the bullet.
+
+If you set this variable to the symbol `always', then the keys
+will not be special in headlines, property lines, and item lines,
+to make shift selection work there as well. If this is what you
+want, you can use the following alternative commands: `C-c C-t'
+and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t'
+can be used to switch TODO sets, `C-c -' to cycle item bullet
+types, and properties can be edited by hand or in column view.
+
+However, when the cursor is on a timestamp, shift-cursor commands
+will still edit the time stamp - this is just too good to give up.
+
+XEmacs user should have this variable set to nil, because
+`shift-select-mode' is in Emacs 23 or later only."
+ :group 'org
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "When outside special context" t)
+ (const :tag "Everywhere except timestamps" always)))
+
+(defcustom org-loop-over-headlines-in-active-region nil
+ "Shall some commands act upon headlines in the active region?
+
+When set to `t', some commands will be performed in all headlines
+within the active region.
+
+When set to `start-level', some commands will be performed in all
+headlines within the active region, provided that these headlines
+are of the same level than the first one.
+
+When set to a string, those commands will be performed on the
+matching headlines within the active region. Such string must be
+a tags/property/todo match as it is used in the agenda tags view.
+
+The list of commands is: `org-schedule', `org-deadline',
+`org-todo', `org-archive-subtree', `org-archive-set-tag' and
+`org-archive-to-archive-sibling'. The archiving commands skip
+already archived entries."
+ :type '(choice (const :tag "Don't loop" nil)
+ (const :tag "All headlines in active region" t)
+ (const :tag "In active region, headlines at the same level than the first one" 'start-level)
+ (string :tag "Tags/Property/Todo matcher"))
+ :version "24.1"
+ :group 'org-todo
+ :group 'org-archive)
+
+(defgroup org-startup nil
+ "Options concerning startup of Org-mode."
+ :tag "Org Startup"
+ :group 'org)
+
+(defcustom org-startup-folded t
+ "Non-nil means entering Org-mode will switch to OVERVIEW.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: fold (or `overview', this is equivalent)
+ #+STARTUP: nofold (or `showall', this is equivalent)
+ #+STARTUP: content
+ #+STARTUP: showeverything"
+ :group 'org-startup
+ :type '(choice
+ (const :tag "nofold: show all" nil)
+ (const :tag "fold: overview" t)
+ (const :tag "content: all headlines" content)
+ (const :tag "show everything, even drawers" showeverything)))
+
+(defcustom org-startup-truncated t
+ "Non-nil means entering Org-mode will set `truncate-lines'.
+This is useful since some lines containing links can be very long and
+uninteresting. Also tables look terrible when wrapped."
+ :group 'org-startup
+ :type 'boolean)
+
+(defcustom org-startup-indented nil
+ "Non-nil means turn on `org-indent-mode' on startup.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: indent
+ #+STARTUP: noindent"
+ :group 'org-structure
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Globally (slow on startup in large files)" t)))
+
+(defcustom org-use-sub-superscripts t
+ "Non-nil means interpret \"_\" and \"^\" for export.
+When this option is turned on, you can use TeX-like syntax for sub- and
+superscripts. Several characters after \"_\" or \"^\" will be
+considered as a single item - so grouping with {} is normally not
+needed. For example, the following things will be parsed as single
+sub- or superscripts.
+
+ 10^24 or 10^tau several digits will be considered 1 item.
+ 10^-12 or 10^-tau a leading sign with digits or a word
+ x^2-y^3 will be read as x^2 - y^3, because items are
+ terminated by almost any nonword/nondigit char.
+ x_{i^2} or x^(2-i) braces or parenthesis do grouping.
+
+Still, ambiguity is possible - so when in doubt use {} to enclose the
+sub/superscript. If you set this variable to the symbol `{}',
+the braces are *required* in order to trigger interpretations as
+sub/superscript. This can be helpful in documents that need \"_\"
+frequently in plain text.
+
+Not all export backends support this, but HTML does.
+
+This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"."
+ :group 'org-startup
+ :group 'org-export-translation
+ :version "24.1"
+ :type '(choice
+ (const :tag "Always interpret" t)
+ (const :tag "Only with braces" {})
+ (const :tag "Never interpret" nil)))
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts))
+
+
+(defcustom org-startup-with-beamer-mode nil
+ "Non-nil means turn on `org-beamer-mode' on startup.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: beamer"
+ :group 'org-startup
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-startup-align-all-tables nil
+ "Non-nil means align all tables when visiting a file.
+This is useful when the column width in tables is forced with <N> cookies
+in table fields. Such tables will look correct only after the first re-align.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+ #+STARTUP: align
+ #+STARTUP: noalign"
+ :group 'org-startup
+ :type 'boolean)
+
+(defcustom org-startup-with-inline-images nil
+ "Non-nil means show inline images when loading a new Org file.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+ #+STARTUP: inlineimages
+ #+STARTUP: noinlineimages"
+ :group 'org-startup
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-insert-mode-line-in-empty-file nil
+ "Non-nil means insert the first line setting Org-mode in empty files.
+When the function `org-mode' is called interactively in an empty file, this
+normally means that the file name does not automatically trigger Org-mode.
+To ensure that the file will always be in Org-mode in the future, a
+line enforcing Org-mode will be inserted into the buffer, if this option
+has been set."
+ :group 'org-startup
+ :type 'boolean)
+
+(defcustom org-replace-disputed-keys nil
+ "Non-nil means use alternative key bindings for some keys.
+Org-mode uses S-<cursor> keys for changing timestamps and priorities.
+These keys are also used by other packages like shift-selection-mode'
+\(built into Emacs 23), `CUA-mode' or `windmove.el'.
+If you want to use Org-mode together with one of these other modes,
+or more generally if you would like to move some Org-mode commands to
+other keys, set this variable and configure the keys with the variable
+`org-disputed-keys'.
+
+This option is only relevant at load-time of Org-mode, and must be set
+*before* org.el is loaded. Changing it requires a restart of Emacs to
+become effective."
+ :group 'org-startup
+ :type 'boolean)
+
+(defcustom org-use-extra-keys nil
+ "Non-nil means use extra key sequence definitions for certain commands.
+This happens automatically if you run XEmacs or if `window-system'
+is nil. This variable lets you do the same manually. You must
+set it before loading org.
+
+Example: on Carbon Emacs 22 running graphically, with an external
+keyboard on a Powerbook, the default way of setting M-left might
+not work for either Alt or ESC. Setting this variable will make
+it work for ESC."
+ :group 'org-startup
+ :type 'boolean)
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys))
+
+(defcustom org-disputed-keys
+ '(([(shift up)] . [(meta p)])
+ ([(shift down)] . [(meta n)])
+ ([(shift left)] . [(meta -)])
+ ([(shift right)] . [(meta +)])
+ ([(control shift right)] . [(meta shift +)])
+ ([(control shift left)] . [(meta shift -)]))
+ "Keys for which Org-mode and other modes compete.
+This is an alist, cars are the default keys, second element specifies
+the alternative to use when `org-replace-disputed-keys' is t.
+
+Keys can be specified in any syntax supported by `define-key'.
+The value of this option takes effect only at Org-mode's startup,
+therefore you'll have to restart Emacs to apply it after changing."
+ :group 'org-startup
+ :type 'alist)
+
+(defun org-key (key)
+ "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
+Or return the original if not disputed.
+Also apply the translations defined in `org-xemacs-key-equivalents'."
+ (when org-replace-disputed-keys
+ (let* ((nkey (key-description key))
+ (x (org-find-if (lambda (x)
+ (equal (key-description (car x)) nkey))
+ org-disputed-keys)))
+ (setq key (if x (cdr x) key))))
+ (when (featurep 'xemacs)
+ (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key)))
+ key)
+
+(defun org-find-if (predicate seq)
+ (catch 'exit
+ (while seq
+ (if (funcall predicate (car seq))
+ (throw 'exit (car seq))
+ (pop seq)))))
+
+(defun org-defkey (keymap key def)
+ "Define a key, possibly translated, as returned by `org-key'."
+ (define-key keymap (org-key key) def))
+
+(defcustom org-ellipsis nil
+ "The ellipsis to use in the Org-mode outline.
+When nil, just use the standard three dots. When a string, use that instead,
+When a face, use the standard 3 dots, but with the specified face.
+The change affects only Org-mode (which will then use its own display table).
+Changing this requires executing `M-x org-mode' in a buffer to become
+effective."
+ :group 'org-startup
+ :type '(choice (const :tag "Default" nil)
+ (face :tag "Face" :value org-warning)
+ (string :tag "String" :value "...#")))
+
+(defvar org-display-table nil
+ "The display table for org-mode, in case `org-ellipsis' is non-nil.")
+
+(defgroup org-keywords nil
+ "Keywords in Org-mode."
+ :tag "Org Keywords"
+ :group 'org)
+
+(defcustom org-deadline-string "DEADLINE:"
+ "String to mark deadline entries.
+A deadline is this string, followed by a time stamp. Should be a word,
+terminated by a colon. You can insert a schedule keyword and
+a timestamp with \\[org-deadline].
+Changes become only effective after restarting Emacs."
+ :group 'org-keywords
+ :type 'string)
+
+(defcustom org-scheduled-string "SCHEDULED:"
+ "String to mark scheduled TODO entries.
+A schedule is this string, followed by a time stamp. Should be a word,
+terminated by a colon. You can insert a schedule keyword and
+a timestamp with \\[org-schedule].
+Changes become only effective after restarting Emacs."
+ :group 'org-keywords
+ :type 'string)
+
+(defcustom org-closed-string "CLOSED:"
+ "String used as the prefix for timestamps logging closing a TODO entry."
+ :group 'org-keywords
+ :type 'string)
+
+(defcustom org-clock-string "CLOCK:"
+ "String used as prefix for timestamps clocking work hours on an item."
+ :group 'org-keywords
+ :type 'string)
+
+(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
+ org-scheduled-string "\\|"
+ org-deadline-string "\\|"
+ org-closed-string "\\|"
+ org-clock-string "\\)")
+ "Matches a line with planning or clock info.")
+
+(defcustom org-comment-string "COMMENT"
+ "Entries starting with this keyword will never be exported.
+An entry can be toggled between COMMENT and normal with
+\\[org-toggle-comment].
+Changes become only effective after restarting Emacs."
+ :group 'org-keywords
+ :type 'string)
+
+(defcustom org-quote-string "QUOTE"
+ "Entries starting with this keyword will be exported in fixed-width font.
+Quoting applies only to the text in the entry following the headline, and does
+not extend beyond the next headline, even if that is lower level.
+An entry can be toggled between QUOTE and normal with
+\\[org-toggle-fixed-width-section]."
+ :group 'org-keywords
+ :type 'string)
+
+(defconst org-repeat-re
+ "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)"
+ "Regular expression for specifying repeated events.
+After a match, group 1 contains the repeat expression.")
+
+(defgroup org-structure nil
+ "Options concerning the general structure of Org-mode files."
+ :tag "Org Structure"
+ :group 'org)
+
+(defgroup org-reveal-location nil
+ "Options about how to make context of a location visible."
+ :tag "Org Reveal Location"
+ :group 'org-structure)
+
+(defconst org-context-choice
+ '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const agenda)
+ (const org-goto)
+ (const occur-tree)
+ (const tags-tree)
+ (const link-search)
+ (const mark-goto)
+ (const bookmark-jump)
+ (const isearch)
+ (const default))
+ (boolean))))
+ "Contexts for the reveal options.")
+
+(defcustom org-show-hierarchy-above '((default . t))
+ "Non-nil means show full hierarchy when revealing a location.
+Org-mode often shows locations in an org-mode file which might have
+been invisible before. When this is set, the hierarchy of headings
+above the exposed location is shown.
+Turning this off for example for sparse trees makes them very compact.
+Instead of t, this can also be an alist specifying this option for different
+contexts. Valid contexts are
+ agenda when exposing an entry from the agenda
+ org-goto when using the command `org-goto' on key C-c C-j
+ occur-tree when using the command `org-occur' on key C-c /
+ tags-tree when constructing a sparse tree based on tags matches
+ link-search when exposing search matches associated with a link
+ mark-goto when exposing the jump goal of a mark
+ bookmark-jump when exposing a bookmark location
+ isearch when exiting from an incremental search
+ default default for all contexts not set explicitly"
+ :group 'org-reveal-location
+ :type org-context-choice)
+
+(defcustom org-show-following-heading '((default . nil))
+ "Non-nil means show following heading when revealing a location.
+Org-mode often shows locations in an org-mode file which might have
+been invisible before. When this is set, the heading following the
+match is shown.
+Turning this off for example for sparse trees makes them very compact,
+but makes it harder to edit the location of the match. In such a case,
+use the command \\[org-reveal] to show more context.
+Instead of t, this can also be an alist specifying this option for different
+contexts. See `org-show-hierarchy-above' for valid contexts."
+ :group 'org-reveal-location
+ :type org-context-choice)
+
+(defcustom org-show-siblings '((default . nil) (isearch t))
+ "Non-nil means show all sibling heading when revealing a location.
+Org-mode often shows locations in an org-mode file which might have
+been invisible before. When this is set, the sibling of the current entry
+heading are all made visible. If `org-show-hierarchy-above' is t,
+the same happens on each level of the hierarchy above the current entry.
+
+By default this is on for the isearch context, off for all other contexts.
+Turning this off for example for sparse trees makes them very compact,
+but makes it harder to edit the location of the match. In such a case,
+use the command \\[org-reveal] to show more context.
+Instead of t, this can also be an alist specifying this option for different
+contexts. See `org-show-hierarchy-above' for valid contexts."
+ :group 'org-reveal-location
+ :type org-context-choice)
+
+(defcustom org-show-entry-below '((default . nil))
+ "Non-nil means show the entry below a headline when revealing a location.
+Org-mode often shows locations in an org-mode file which might have
+been invisible before. When this is set, the text below the headline that is
+exposed is also shown.
+
+By default this is off for all contexts.
+Instead of t, this can also be an alist specifying this option for different
+contexts. See `org-show-hierarchy-above' for valid contexts."
+ :group 'org-reveal-location
+ :type org-context-choice)
+
+(defcustom org-indirect-buffer-display 'other-window
+ "How should indirect tree buffers be displayed?
+This applies to indirect buffers created with the commands
+\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer].
+Valid values are:
+current-window Display in the current window
+other-window Just display in another window.
+dedicated-frame Create one new frame, and re-use it each time.
+new-frame Make a new frame each time. Note that in this case
+ previously-made indirect buffers are kept, and you need to
+ kill these buffers yourself."
+ :group 'org-structure
+ :group 'org-agenda-windows
+ :type '(choice
+ (const :tag "In current window" current-window)
+ (const :tag "In current frame, other window" other-window)
+ (const :tag "Each time a new frame" new-frame)
+ (const :tag "One dedicated frame" dedicated-frame)))
+
+(defcustom org-use-speed-commands nil
+ "Non-nil means activate single letter commands at beginning of a headline.
+This may also be a function to test for appropriate locations where speed
+commands should be active."
+ :group 'org-structure
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "At beginning of headline stars" t)
+ (function)))
+
+(defcustom org-speed-commands-user nil
+ "Alist of additional speed commands.
+This list will be checked before `org-speed-commands-default'
+when the variable `org-use-speed-commands' is non-nil
+and when the cursor is at the beginning of a headline.
+The car if each entry is a string with a single letter, which must
+be assigned to `self-insert-command' in the global map.
+The cdr is either a command to be called interactively, a function
+to be called, or a form to be evaluated.
+An entry that is just a list with a single string will be interpreted
+as a descriptive headline that will be added when listing the speed
+commands in the Help buffer using the `?' speed command."
+ :group 'org-structure
+ :type '(repeat :value ("k" . ignore)
+ (choice :value ("k" . ignore)
+ (list :tag "Descriptive Headline" (string :tag "Headline"))
+ (cons :tag "Letter and Command"
+ (string :tag "Command letter")
+ (choice
+ (function)
+ (sexp))))))
+
+(defgroup org-cycle nil
+ "Options concerning visibility cycling in Org-mode."
+ :tag "Org Cycle"
+ :group 'org-structure)
+
+(defcustom org-cycle-skip-children-state-if-no-children t
+ "Non-nil means skip CHILDREN state in entries that don't have any."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-max-level nil
+ "Maximum level which should still be subject to visibility cycling.
+Levels higher than this will, for cycling, be treated as text, not a headline.
+When `org-odd-levels-only' is set, a value of N in this variable actually
+means 2N-1 stars as the limiting headline.
+When nil, cycle all levels.
+Note that the limiting level of cycling is also influenced by
+`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
+`org-inlinetask-min-level' is, cycling will be limited to levels one less
+than its value."
+ :group 'org-cycle
+ :type '(choice
+ (const :tag "No limit" nil)
+ (integer :tag "Maximum level")))
+
+(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS")
+ "Names of drawers. Drawers are not opened by cycling on the headline above.
+Drawers only open with a TAB on the drawer line itself. A drawer looks like
+this:
+ :DRAWERNAME:
+ .....
+ :END:
+The drawer \"PROPERTIES\" is special for capturing properties through
+the property API.
+
+Drawers can be defined on the per-file basis with a line like:
+
+#+DRAWERS: HIDDEN STATE PROPERTIES"
+ :group 'org-structure
+ :group 'org-cycle
+ :type '(repeat (string :tag "Drawer Name")))
+
+(defcustom org-hide-block-startup nil
+ "Non-nil means entering Org-mode will fold all blocks.
+This can also be set in on a per-file basis with
+
+#+STARTUP: hideblocks
+#+STARTUP: showblocks"
+ :group 'org-startup
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-global-at-bob nil
+ "Cycle globally if cursor is at beginning of buffer and not at a headline.
+This makes it possible to do global cycling without having to use S-TAB or
+\\[universal-argument] TAB. For this special case to work, the first line
+of the buffer must not be a headline -- it may be empty or some other text.
+When used in this way, `org-cycle-hook' is disabled temporarily to make
+sure the cursor stays at the beginning of the buffer. When this option is
+nil, don't do anything special at the beginning of the buffer."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-level-after-item/entry-creation t
+ "Non-nil means cycle entry level or item indentation in new empty entries.
+
+When the cursor is at the end of an empty headline, i.e with only stars
+and maybe a TODO keyword, TAB will then switch the entry to become a child,
+and then all possible ancestor states, before returning to the original state.
+This makes data entry extremely fast: M-RET to create a new headline,
+on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
+
+When the cursor is at the end of an empty plain list item, one TAB will
+make it a subitem, two or more tabs will back up to make this an item
+higher up in the item hierarchy."
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-cycle-emulate-tab t
+ "Where should `org-cycle' emulate TAB.
+nil Never
+white Only in completely white lines
+whitestart Only at the beginning of lines, before the first non-white char
+t Everywhere except in headlines
+exc-hl-bol Everywhere except at the start of a headline
+If TAB is used in a place where it does not emulate TAB, the current subtree
+visibility is cycled."
+ :group 'org-cycle
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Only in completely white lines" white)
+ (const :tag "Before first char in a line" whitestart)
+ (const :tag "Everywhere except in headlines" t)
+ (const :tag "Everywhere except at bol in headlines" exc-hl-bol)
+ ))
+
+(defcustom org-cycle-separator-lines 2
+ "Number of empty lines needed to keep an empty line between collapsed trees.
+If you leave an empty line between the end of a subtree and the following
+headline, this empty line is hidden when the subtree is folded.
+Org-mode will leave (exactly) one empty line visible if the number of
+empty lines is equal or larger to the number given in this variable.
+So the default 2 means at least 2 empty lines after the end of a subtree
+are needed to produce free space between a collapsed subtree and the
+following headline.
+
+If the number is negative, and the number of empty lines is at least -N,
+all empty lines are shown.
+
+Special case: when 0, never leave empty lines in collapsed view."
+ :group 'org-cycle
+ :type 'integer)
+(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
+
+(defcustom org-pre-cycle-hook nil
+ "Hook that is run before visibility cycling is happening.
+The function(s) in this hook must accept a single argument which indicates
+the new state that will be set right after running this hook. The
+argument is a symbol. Before a global state change, it can have the values
+`overview', `content', or `all'. Before a local state change, it can have
+the values `folded', `children', or `subtree'."
+ :group 'org-cycle
+ :type 'hook)
+
+(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
+ org-cycle-hide-drawers
+ org-cycle-show-empty-lines
+ org-optimize-window-after-visibility-change)
+ "Hook that is run after `org-cycle' has changed the buffer visibility.
+The function(s) in this hook must accept a single argument which indicates
+the new state that was set by the most recent `org-cycle' command. The
+argument is a symbol. After a global state change, it can have the values
+`overview', `contents', or `all'. After a local state change, it can have
+the values `folded', `children', or `subtree'."
+ :group 'org-cycle
+ :type 'hook)
+
+(defgroup org-edit-structure nil
+ "Options concerning structure editing in Org-mode."
+ :tag "Org Edit Structure"
+ :group 'org-structure)
+
+(defcustom org-odd-levels-only nil
+ "Non-nil means skip even levels and only use odd levels for the outline.
+This has the effect that two stars are being added/taken away in
+promotion/demotion commands. It also influences how levels are
+handled by the exporters.
+Changing it requires restart of `font-lock-mode' to become effective
+for fontification also in regions already fontified.
+You may also set this on a per-file basis by adding one of the following
+lines to the buffer:
+
+ #+STARTUP: odd
+ #+STARTUP: oddeven"
+ :group 'org-edit-structure
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-adapt-indentation t
+ "Non-nil means adapt indentation to outline node level.
+
+When this variable is set, Org assumes that you write outlines by
+indenting text in each node to align with the headline (after the stars).
+The following issues are influenced by this variable:
+
+- When this is set and the *entire* text in an entry is indented, the
+ indentation is increased by one space in a demotion command, and
+ decreased by one in a promotion command. If any line in the entry
+ body starts with text at column 0, indentation is not changed at all.
+
+- Property drawers and planning information is inserted indented when
+ this variable s set. When nil, they will not be indented.
+
+- TAB indents a line relative to context. The lines below a headline
+ will be indented when this variable is set.
+
+Note that this is all about true indentation, by adding and removing
+space characters. See also `org-indent.el' which does level-dependent
+indentation in a virtual way, i.e. at display time in Emacs."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-special-ctrl-a/e nil
+ "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
+
+When t, `C-a' will bring back the cursor to the beginning of the
+headline text, i.e. after the stars and after a possible TODO
+keyword. In an item, this will be the position after bullet and
+check-box, if any. When the cursor is already at that position,
+another `C-a' will bring it to the beginning of the line.
+
+`C-e' will jump to the end of the headline, ignoring the presence
+of tags in the headline. A second `C-e' will then jump to the
+true end of the line, after any tags. This also means that, when
+this variable is non-nil, `C-e' also will never jump beyond the
+end of the heading of a folded section, i.e. not after the
+ellipses.
+
+When set to the symbol `reversed', the first `C-a' or `C-e' works
+normally, going to the true line boundary first. Only a directly
+following, identical keypress will bring the cursor to the
+special positions.
+
+This may also be a cons cell where the behavior for `C-a' and
+`C-e' is set separately."
+ :group 'org-edit-structure
+ :type '(choice
+ (const :tag "off" nil)
+ (const :tag "on: after stars/bullet and before tags first" t)
+ (const :tag "reversed: true line boundary first" reversed)
+ (cons :tag "Set C-a and C-e separately"
+ (choice :tag "Special C-a"
+ (const :tag "off" nil)
+ (const :tag "on: after stars/bullet first" t)
+ (const :tag "reversed: before stars/bullet first" reversed))
+ (choice :tag "Special C-e"
+ (const :tag "off" nil)
+ (const :tag "on: before tags first" t)
+ (const :tag "reversed: after tags first" reversed)))))
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
+
+(defcustom org-special-ctrl-k nil
+ "Non-nil means `C-k' will behave specially in headlines.
+When nil, `C-k' will call the default `kill-line' command.
+When t, the following will happen while the cursor is in the headline:
+
+- When the cursor is at the beginning of a headline, kill the entire
+ line and possible the folded subtree below the line.
+- When in the middle of the headline text, kill the headline up to the tags.
+- When after the headline text, kill the tags."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-ctrl-k-protect-subtree nil
+ "Non-nil means, do not delete a hidden subtree with C-k.
+When set to the symbol `error', simply throw an error when C-k is
+used to kill (part-of) a headline that has hidden text behind it.
+Any other non-nil value will result in a query to the user, if it is
+OK to kill that hidden subtree. When nil, kill without remorse."
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not protect hidden subtrees" nil)
+ (const :tag "Protect hidden subtrees with a security query" t)
+ (const :tag "Never kill a hidden subtree with C-k" error)))
+
+(defcustom org-catch-invisible-edits nil
+ "Check if in invisible region before inserting or deleting a character.
+Valid values are:
+
+nil Do not check, so just do invisible edits.
+error Throw an error and do nothing.
+show Make point visible, and do the requested edit.
+show-and-error Make point visible, then throw an error and abort the edit.
+smart Make point visible, and do insertion/deletion if it is
+ adjacent to visible text and the change feels predictable.
+ Never delete a previously invisible character or add in the
+ middle or right after an invisible region. Basically, this
+ allows insertion and backward-delete right before ellipses.
+ FIXME: maybe in this case we should not even show?"
+ :group 'org-edit-structure
+ :version "24.1"
+ :type '(choice
+ (const :tag "Do not check" nil)
+ (const :tag "Throw error when trying to edit" error)
+ (const :tag "Unhide, but do not do the edit" show-and-error)
+ (const :tag "Show invisible part and do the edit" show)
+ (const :tag "Be smart and do the right thing" smart)))
+
+(defcustom org-yank-folded-subtrees t
+ "Non-nil means when yanking subtrees, fold them.
+If the kill is a single subtree, or a sequence of subtrees, i.e. if
+it starts with a heading and all other headings in it are either children
+or siblings, then fold all the subtrees. However, do this only if no
+text after the yank would be swallowed into a folded tree by this action."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-yank-adjusted-subtrees nil
+ "Non-nil means when yanking subtrees, adjust the level.
+With this setting, `org-paste-subtree' is used to insert the subtree, see
+this function for details."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-M-RET-may-split-line '((default . t))
+ "Non-nil means M-RET will split the line at the cursor position.
+When nil, it will go to the end of the line before making a
+new line.
+You may also set this option in a different way for different
+contexts. Valid contexts are:
+
+headline when creating a new headline
+item when creating a new item
+table in a table field
+default the value to be used for all contexts not explicitly
+ customized"
+ :group 'org-structure
+ :group 'org-table
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const headline)
+ (const item)
+ (const table)
+ (const default))
+ (boolean)))))
+
+
+(defcustom org-insert-heading-respect-content nil
+ "Non-nil means insert new headings after the current subtree.
+When nil, the new heading is created directly after the current line.
+The commands \\[org-insert-heading-respect-content] and
+\\[org-insert-todo-heading-respect-content] turn this variable on
+for the duration of the command."
+ :group 'org-structure
+ :type 'boolean)
+
+(defcustom org-blank-before-new-entry '((heading . auto)
+ (plain-list-item . auto))
+ "Should `org-insert-heading' leave a blank line before new heading/item?
+The value is an alist, with `heading' and `plain-list-item' as CAR,
+and a boolean flag as CDR. The cdr may also be the symbol `auto', in
+which case Org will look at the surrounding headings/items and try to
+make an intelligent decision whether to insert a blank line or not.
+
+For plain lists, if the variable `org-empty-line-terminates-plain-lists' is
+set, the setting here is ignored and no empty line is inserted, to avoid
+breaking the list structure."
+ :group 'org-edit-structure
+ :type '(list
+ (cons (const heading)
+ (choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Auto" auto)))
+ (cons (const plain-list-item)
+ (choice (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Auto" auto)))))
+
+(defcustom org-insert-heading-hook nil
+ "Hook being run after inserting a new heading."
+ :group 'org-edit-structure
+ :type 'hook)
+
+(defcustom org-enable-fixed-width-editor t
+ "Non-nil means lines starting with \":\" are treated as fixed-width.
+This currently only means they are never auto-wrapped.
+When nil, such lines will be treated like ordinary lines.
+See also the QUOTE keyword."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defcustom org-goto-auto-isearch t
+ "Non-nil means typing characters in `org-goto' starts incremental search."
+ :group 'org-edit-structure
+ :type 'boolean)
+
+(defgroup org-sparse-trees nil
+ "Options concerning sparse trees in Org-mode."
+ :tag "Org Sparse Trees"
+ :group 'org-structure)
+
+(defcustom org-highlight-sparse-tree-matches t
+ "Non-nil means highlight all matches that define a sparse tree.
+The highlights will automatically disappear the next time the buffer is
+changed by an edit command."
+ :group 'org-sparse-trees
+ :type 'boolean)
+
+(defcustom org-remove-highlights-with-change t
+ "Non-nil means any change to the buffer will remove temporary highlights.
+Such highlights are created by `org-occur' and `org-clock-display'.
+When nil, `C-c C-c needs to be used to get rid of the highlights.
+The highlights created by `org-preview-latex-fragment' always need
+`C-c C-c' to be removed."
+ :group 'org-sparse-trees
+ :group 'org-time
+ :type 'boolean)
+
+
+(defcustom org-occur-hook '(org-first-headline-recenter)
+ "Hook that is run after `org-occur' has constructed a sparse tree.
+This can be used to recenter the window to show as much of the structure
+as possible."
+ :group 'org-sparse-trees
+ :type 'hook)
+
+(defgroup org-imenu-and-speedbar nil
+ "Options concerning imenu and speedbar in Org-mode."
+ :tag "Org Imenu and Speedbar"
+ :group 'org-structure)
+
+(defcustom org-imenu-depth 2
+ "The maximum level for Imenu access to Org-mode headlines.
+This also applied for speedbar access."
+ :group 'org-imenu-and-speedbar
+ :type 'integer)
+
+(defgroup org-table nil
+ "Options concerning tables in Org-mode."
+ :tag "Org Table"
+ :group 'org)
+
+(defcustom org-enable-table-editor 'optimized
+ "Non-nil means lines starting with \"|\" are handled by the table editor.
+When nil, such lines will be treated like ordinary lines.
+
+When equal to the symbol `optimized', the table editor will be optimized to
+do the following:
+- Automatic overwrite mode in front of whitespace in table fields.
+ This makes the structure of the table stay in tact as long as the edited
+ field does not exceed the column width.
+- Minimize the number of realigns. Normally, the table is aligned each time
+ TAB or RET are pressed to move to another field. With optimization this
+ happens only if changes to a field might have changed the column width.
+Optimization requires replacing the functions `self-insert-command',
+`delete-char', and `backward-delete-char' in Org-mode buffers, with a
+slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
+very good at guessing when a re-align will be necessary, but you can always
+force one with \\[org-ctrl-c-ctrl-c].
+
+If you would like to use the optimized version in Org-mode, but the
+un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
+
+This variable can be used to turn on and off the table editor during a session,
+but in order to toggle optimization, a restart is required.
+
+See also the variable `org-table-auto-blank-field'."
+ :group 'org-table
+ :type '(choice
+ (const :tag "off" nil)
+ (const :tag "on" t)
+ (const :tag "on, optimized" optimized)))
+
+(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs)
+ (version<= emacs-version "24.1"))
+ "Non-nil means cluster self-insert commands for undo when possible.
+If this is set, then, like in the Emacs command loop, 20 consecutive
+characters will be undone together.
+This is configurable, because there is some impact on typing performance."
+ :group 'org-table
+ :type 'boolean)
+
+(defcustom org-table-tab-recognizes-table.el t
+ "Non-nil means TAB will automatically notice a table.el table.
+When it sees such a table, it moves point into it and - if necessary -
+calls `table-recognize-table'."
+ :group 'org-table-editing
+ :type 'boolean)
+
+(defgroup org-link nil
+ "Options concerning links in Org-mode."
+ :tag "Org Link"
+ :group 'org)
+
+(defvar org-link-abbrev-alist-local nil
+ "Buffer-local version of `org-link-abbrev-alist', which see.
+The value of this is taken from the #+LINK lines.")
+(make-variable-buffer-local 'org-link-abbrev-alist-local)
+
+(defcustom org-link-abbrev-alist nil
+ "Alist of link abbreviations.
+The car of each element is a string, to be replaced at the start of a link.
+The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
+links in Org-mode buffers can have an optional tag after a double colon, e.g.
+
+ [[linkkey:tag][description]]
+
+The 'linkkey' must be a word word, starting with a letter, followed
+by letters, numbers, '-' or '_'.
+
+If REPLACE is a string, the tag will simply be appended to create the link.
+If the string contains \"%s\", the tag will be inserted there. If the string
+contains \"%h\", it will cause a url-encoded version of the tag to be inserted
+at that point (see the function `url-hexify-string'). If the string contains
+the specifier \"%(my-function)\", then the custom function `my-function' will
+be invoked: this function takes the tag as its only argument and must return
+a string.
+
+REPLACE may also be a function that will be called with the tag as the
+only argument to create the link, which should be returned as a string.
+
+See the manual for examples."
+ :group 'org-link
+ :type '(repeat
+ (cons
+ (string :tag "Protocol")
+ (choice
+ (string :tag "Format")
+ (function)))))
+
+(defcustom org-descriptive-links t
+ "Non-nil means Org will display descriptive links.
+E.g. [[http://orgmode.org][Org website]] will be displayed as
+\"Org Website\", hiding the link itself and just displaying its
+description. When set to `nil', Org will display the full links
+literally.
+
+You can interactively set the value of this variable by calling
+`org-toggle-link-display' or from the menu Org>Hyperlinks menu."
+ :group 'org-link
+ :type 'boolean)
+
+(defcustom org-link-file-path-type 'adaptive
+ "How the path name in file links should be stored.
+Valid values are:
+
+relative Relative to the current directory, i.e. the directory of the file
+ into which the link is being inserted.
+absolute Absolute path, if possible with ~ for home directory.
+noabbrev Absolute path, no abbreviation of home directory.
+adaptive Use relative path for files in the current directory and sub-
+ directories of it. For other files, use an absolute path."
+ :group 'org-link
+ :type '(choice
+ (const relative)
+ (const absolute)
+ (const noabbrev)
+ (const adaptive)))
+
+(defcustom org-activate-links '(bracket angle plain radio tag date footnote)
+ "Types of links that should be activated in Org-mode files.
+This is a list of symbols, each leading to the activation of a certain link
+type. In principle, it does not hurt to turn on most link types - there may
+be a small gain when turning off unused link types. The types are:
+
+bracket The recommended [[link][description]] or [[link]] links with hiding.
+angle Links in angular brackets that may contain whitespace like
+ <bbdb:Carsten Dominik>.
+plain Plain links in normal text, no whitespace, like http://google.com.
+radio Text that is matched by a radio target, see manual for details.
+tag Tag settings in a headline (link to tag search).
+date Time stamps (link to calendar).
+footnote Footnote labels.
+
+Changing this variable requires a restart of Emacs to become effective."
+ :group 'org-link
+ :type '(set :greedy t
+ (const :tag "Double bracket links" bracket)
+ (const :tag "Angular bracket links" angle)
+ (const :tag "Plain text links" plain)
+ (const :tag "Radio target matches" radio)
+ (const :tag "Tags" tag)
+ (const :tag "Timestamps" date)
+ (const :tag "Footnotes" footnote)))
+
+(defcustom org-make-link-description-function nil
+ "Function to use for generating link descriptions from links.
+When nil, the link location will be used. This function must take
+two parameters: the first one is the link, the second one is the
+description generated by `org-insert-link'. The function should
+return the description to use."
+ :group 'org-link
+ :type 'function)
+
+(defgroup org-link-store nil
+ "Options concerning storing links in Org-mode."
+ :tag "Org Store Link"
+ :group 'org-link)
+
+(defcustom org-url-hexify-p t
+ "When non-nil, hexify URL when creating a link."
+ :type 'boolean
+ :version "24.3"
+ :group 'org-link-store)
+
+(defcustom org-email-link-description-format "Email %c: %.30s"
+ "Format of the description part of a link to an email or usenet message.
+The following %-escapes will be replaced by corresponding information:
+
+%F full \"From\" field
+%f name, taken from \"From\" field, address if no name
+%T full \"To\" field
+%t first name in \"To\" field, address if no name
+%c correspondent. Usually \"from NAME\", but if you sent it yourself, it
+ will be \"to NAME\". See also the variable `org-from-is-user-regexp'.
+%s subject
+%d date
+%m message-id.
+
+You may use normal field width specification between the % and the letter.
+This is for example useful to limit the length of the subject.
+
+Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
+ :group 'org-link-store
+ :type 'string)
+
+(defcustom org-from-is-user-regexp
+ (let (r1 r2)
+ (when (and user-mail-address (not (string= user-mail-address "")))
+ (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>")))
+ (when (and user-full-name (not (string= user-full-name "")))
+ (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>")))
+ (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2)))
+ "Regexp matched against the \"From:\" header of an email or usenet message.
+It should match if the message is from the user him/herself."
+ :group 'org-link-store
+ :type 'regexp)
+
+(defcustom org-context-in-file-links t
+ "Non-nil means file links from `org-store-link' contain context.
+A search string will be added to the file name with :: as separator and
+used to find the context when the link is activated by the command
+`org-open-at-point'. When this option is t, the entire active region
+will be placed in the search string of the file link. If set to a
+positive integer, only the first n lines of context will be stored.
+
+Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+negates this setting for the duration of the command."
+ :group 'org-link-store
+ :type '(choice boolean integer))
+
+(defcustom org-keep-stored-link-after-insertion nil
+ "Non-nil means keep link in list for entire session.
+
+The command `org-store-link' adds a link pointing to the current
+location to an internal list. These links accumulate during a session.
+The command `org-insert-link' can be used to insert links into any
+Org-mode file (offering completion for all stored links). When this
+option is nil, every link which has been inserted once using \\[org-insert-link]
+will be removed from the list, to make completing the unused links
+more efficient."
+ :group 'org-link-store
+ :type 'boolean)
+
+(defgroup org-link-follow nil
+ "Options concerning following links in Org-mode."
+ :tag "Org Follow Link"
+ :group 'org-link)
+
+(defcustom org-link-translation-function nil
+ "Function to translate links with different syntax to Org syntax.
+This can be used to translate links created for example by the Planner
+or emacs-wiki packages to Org syntax.
+The function must accept two parameters, a TYPE containing the link
+protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
+which is everything after the link protocol. It should return a cons
+with possibly modified values of type and path.
+Org contains a function for this, so if you set this variable to
+`org-translate-link-from-planner', you should be able follow many
+links created by planner."
+ :group 'org-link-follow
+ :type 'function)
+
+(defcustom org-follow-link-hook nil
+ "Hook that is run after a link has been followed."
+ :group 'org-link-follow
+ :type 'hook)
+
+(defcustom org-tab-follows-link nil
+ "Non-nil means on links TAB will follow the link.
+Needs to be set before org.el is loaded.
+This really should not be used, it does not make sense, and the
+implementation is bad."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-return-follows-link nil
+ "Non-nil means on links RET will follow the link."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-mouse-1-follows-link
+ (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
+ "Non-nil means mouse-1 on a link will follow the link.
+A longer mouse click will still set point. Does not work on XEmacs.
+Needs to be set before org.el is loaded."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-mark-ring-length 4
+ "Number of different positions to be recorded in the ring.
+Changing this requires a restart of Emacs to work correctly."
+ :group 'org-link-follow
+ :type 'integer)
+
+(defcustom org-link-search-must-match-exact-headline 'query-to-create
+ "Non-nil means internal links in Org files must exactly match a headline.
+When nil, the link search tries to match a phrase with all words
+in the search text."
+ :group 'org-link-follow
+ :version "24.1"
+ :type '(choice
+ (const :tag "Use fuzzy text search" nil)
+ (const :tag "Match only exact headline" t)
+ (const :tag "Match exact headline or query to create it"
+ query-to-create)))
+
+(defcustom org-link-frame-setup
+ '((vm . vm-visit-folder-other-frame)
+ (vm-imap . vm-visit-imap-folder-other-frame)
+ (gnus . org-gnus-no-new-news)
+ (file . find-file-other-window)
+ (wl . wl-other-frame))
+ "Setup the frame configuration for following links.
+When following a link with Emacs, it may often be useful to display
+this link in another window or frame. This variable can be used to
+set this up for the different types of links.
+For VM, use any of
+ `vm-visit-folder'
+ `vm-visit-folder-other-window'
+ `vm-visit-folder-other-frame'
+For Gnus, use any of
+ `gnus'
+ `gnus-other-frame'
+ `org-gnus-no-new-news'
+For FILE, use any of
+ `find-file'
+ `find-file-other-window'
+ `find-file-other-frame'
+For Wanderlust use any of
+ `wl'
+ `wl-other-frame'
+For the calendar, use the variable `calendar-setup'.
+For BBDB, it is currently only possible to display the matches in
+another window."
+ :group 'org-link-follow
+ :type '(list
+ (cons (const vm)
+ (choice
+ (const vm-visit-folder)
+ (const vm-visit-folder-other-window)
+ (const vm-visit-folder-other-frame)))
+ (cons (const gnus)
+ (choice
+ (const gnus)
+ (const gnus-other-frame)
+ (const org-gnus-no-new-news)))
+ (cons (const file)
+ (choice
+ (const find-file)
+ (const find-file-other-window)
+ (const find-file-other-frame)))
+ (cons (const wl)
+ (choice
+ (const wl)
+ (const wl-other-frame)))))
+
+(defcustom org-display-internal-link-with-indirect-buffer nil
+ "Non-nil means use indirect buffer to display infile links.
+Activating internal links (from one location in a file to another location
+in the same file) normally just jumps to the location. When the link is
+activated with a \\[universal-argument] prefix (or with mouse-3), the link \
+is displayed in
+another window. When this option is set, the other window actually displays
+an indirect buffer clone of the current buffer, to avoid any visibility
+changes to the current buffer."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-open-non-existing-files nil
+ "Non-nil means `org-open-file' will open non-existing files.
+When nil, an error will be generated.
+This variable applies only to external applications because they
+might choke on non-existing files. If the link is to a file that
+will be opened in Emacs, the variable is ignored."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-open-directory-means-index-dot-org nil
+ "Non-nil means a link to a directory really means to index.org.
+When nil, following a directory link will run dired or open a finder/explorer
+window on that directory."
+ :group 'org-link-follow
+ :type 'boolean)
+
+(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s")
+ "Function and arguments to call for following mailto links.
+This is a list with the first element being a Lisp function, and the
+remaining elements being arguments to the function. In string arguments,
+%a will be replaced by the address, and %s will be replaced by the subject
+if one was given like in <mailto:arthur@galaxy.org::this subject>."
+ :group 'org-link-follow
+ :type '(choice
+ (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s"))
+ (const :tag "compose-mail" (compose-mail "%a" "%s"))
+ (const :tag "message-mail" (message-mail "%a" "%s"))
+ (cons :tag "other" (function) (repeat :tag "argument" sexp))))
+
+(defcustom org-confirm-shell-link-function 'yes-or-no-p
+ "Non-nil means ask for confirmation before executing shell links.
+Shell links can be dangerous: just think about a link
+
+ [[shell:rm -rf ~/*][Google Search]]
+
+This link would show up in your Org-mode document as \"Google Search\",
+but really it would remove your entire home directory.
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' if you want to confirm with a
+single keystroke rather than having to type \"yes\"."
+ :group 'org-link-follow
+ :type '(choice
+ (const :tag "with yes-or-no (safer)" yes-or-no-p)
+ (const :tag "with y-or-n (faster)" y-or-n-p)
+ (const :tag "no confirmation (dangerous)" nil)))
+(put 'org-confirm-shell-link-function
+ 'safe-local-variable
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
+(defcustom org-confirm-shell-link-not-regexp ""
+ "A regexp to skip confirmation for shell links."
+ :group 'org-link-follow
+ :version "24.1"
+ :type 'regexp)
+
+(defcustom org-confirm-elisp-link-function 'yes-or-no-p
+ "Non-nil means ask for confirmation before executing Emacs Lisp links.
+Elisp links can be dangerous: just think about a link
+
+ [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
+
+This link would show up in your Org-mode document as \"Google Search\",
+but really it would remove your entire home directory.
+Therefore we advise against setting this variable to nil.
+Just change it to `y-or-n-p' if you want to confirm with a
+single keystroke rather than having to type \"yes\"."
+ :group 'org-link-follow
+ :type '(choice
+ (const :tag "with yes-or-no (safer)" yes-or-no-p)
+ (const :tag "with y-or-n (faster)" y-or-n-p)
+ (const :tag "no confirmation (dangerous)" nil)))
+(put 'org-confirm-shell-link-function
+ 'safe-local-variable
+ #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+
+(defcustom org-confirm-elisp-link-not-regexp ""
+ "A regexp to skip confirmation for Elisp links."
+ :group 'org-link-follow
+ :version "24.1"
+ :type 'regexp)
+
+(defconst org-file-apps-defaults-gnu
+ '((remote . emacs)
+ (system . mailcap)
+ (t . mailcap))
+ "Default file applications on a UNIX or GNU/Linux system.
+See `org-file-apps'.")
+
+(defconst org-file-apps-defaults-macosx
+ '((remote . emacs)
+ (t . "open %s")
+ (system . "open %s")
+ ("ps.gz" . "gv %s")
+ ("eps.gz" . "gv %s")
+ ("dvi" . "xdvi %s")
+ ("fig" . "xfig %s"))
+ "Default file applications on a MacOS X system.
+The system \"open\" is known as a default, but we use X11 applications
+for some files for which the OS does not have a good default.
+See `org-file-apps'.")
+
+(defconst org-file-apps-defaults-windowsnt
+ (list
+ '(remote . emacs)
+ (cons t
+ (list (if (featurep 'xemacs)
+ 'mswindows-shell-execute
+ 'w32-shell-execute)
+ "open" 'file))
+ (cons 'system
+ (list (if (featurep 'xemacs)
+ 'mswindows-shell-execute
+ 'w32-shell-execute)
+ "open" 'file)))
+ "Default file applications on a Windows NT system.
+The system \"open\" is used for most files.
+See `org-file-apps'.")
+
+(defcustom org-file-apps
+ '(
+ (auto-mode . emacs)
+ ("\\.mm\\'" . default)
+ ("\\.x?html?\\'" . default)
+ ("\\.pdf\\'" . default)
+ )
+ "External applications for opening `file:path' items in a document.
+Org-mode uses system defaults for different file types, but
+you can use this variable to set the application for a given file
+extension. The entries in this list are cons cells where the car identifies
+files and the cdr the corresponding command. Possible values for the
+file identifier are
+ \"string\" A string as a file identifier can be interpreted in different
+ ways, depending on its contents:
+
+ - Alphanumeric characters only:
+ Match links with this file extension.
+ Example: (\"pdf\" . \"evince %s\")
+ to open PDFs with evince.
+
+ - Regular expression: Match links where the
+ filename matches the regexp. If you want to
+ use groups here, use shy groups.
+
+ Example: (\"\\.x?html\\'\" . \"firefox %s\")
+ (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\")
+ to open *.html and *.xhtml with firefox.
+
+ - Regular expression which contains (non-shy) groups:
+ Match links where the whole link, including \"::\", and
+ anything after that, matches the regexp.
+ In a custom command string, %1, %2, etc. are replaced with
+ the parts of the link that were matched by the groups.
+ For backwards compatibility, if a command string is given
+ that does not use any of the group matches, this case is
+ handled identically to the second one (i.e. match against
+ file name only).
+ In a custom lisp form, you can access the group matches with
+ (match-string n link).
+
+ Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\")
+ to open [[file:document.pdf::5]] with evince at page 5.
+
+ `directory' Matches a directory
+ `remote' Matches a remote file, accessible through tramp or efs.
+ Remote files most likely should be visited through Emacs
+ because external applications cannot handle such paths.
+`auto-mode' Matches files that are matched by any entry in `auto-mode-alist',
+ so all files Emacs knows how to handle. Using this with
+ command `emacs' will open most files in Emacs. Beware that this
+ will also open html files inside Emacs, unless you add
+ (\"html\" . default) to the list as well.
+ t Default for files not matched by any of the other options.
+ `system' The system command to open files, like `open' on Windows
+ and Mac OS X, and mailcap under GNU/Linux. This is the command
+ that will be selected if you call `C-c C-o' with a double
+ \\[universal-argument] \\[universal-argument] prefix.
+
+Possible values for the command are:
+ `emacs' The file will be visited by the current Emacs process.
+ `default' Use the default application for this file type, which is the
+ association for t in the list, most likely in the system-specific
+ part.
+ This can be used to overrule an unwanted setting in the
+ system-specific variable.
+ `system' Use the system command for opening files, like \"open\".
+ This command is specified by the entry whose car is `system'.
+ Most likely, the system-specific version of this variable
+ does define this command, but you can overrule/replace it
+ here.
+ string A command to be executed by a shell; %s will be replaced
+ by the path to the file.
+ sexp A Lisp form which will be evaluated. The file path will
+ be available in the Lisp variable `file'.
+For more examples, see the system specific constants
+`org-file-apps-defaults-macosx'
+`org-file-apps-defaults-windowsnt'
+`org-file-apps-defaults-gnu'."
+ :group 'org-link-follow
+ :type '(repeat
+ (cons (choice :value ""
+ (string :tag "Extension")
+ (const :tag "System command to open files" system)
+ (const :tag "Default for unrecognized files" t)
+ (const :tag "Remote file" remote)
+ (const :tag "Links to a directory" directory)
+ (const :tag "Any files that have Emacs modes"
+ auto-mode))
+ (choice :value ""
+ (const :tag "Visit with Emacs" emacs)
+ (const :tag "Use default" default)
+ (const :tag "Use the system command" system)
+ (string :tag "Command")
+ (sexp :tag "Lisp form")))))
+
+(defcustom org-doi-server-url "http://dx.doi.org/"
+ "The URL of the DOI server."
+ :type 'string
+ :version "24.3"
+ :group 'org-link-follow)
+
+(defgroup org-refile nil
+ "Options concerning refiling entries in Org-mode."
+ :tag "Org Refile"
+ :group 'org)
+
+(defcustom org-directory "~/org"
+ "Directory with org files.
+This is just a default location to look for Org files. There is no need
+at all to put your files into this directory. It is only used in the
+following situations:
+
+1. When a capture template specifies a target file that is not an
+ absolute path. The path will then be interpreted relative to
+ `org-directory'
+2. When a capture note is filed away in an interactive way (when exiting the
+ note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
+ with `org-directory' as the default path."
+ :group 'org-refile
+ :group 'org-remember
+ :group 'org-capture
+ :type 'directory)
+
+(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
+ "Default target for storing notes.
+Used as a fall back file for org-remember.el and org-capture.el, for
+templates that do not specify a target file."
+ :group 'org-refile
+ :group 'org-remember
+ :group 'org-capture
+ :type '(choice
+ (const :tag "Default from remember-data-file" nil)
+ file))
+
+(defcustom org-goto-interface 'outline
+ "The default interface to be used for `org-goto'.
+Allowed values are:
+outline The interface shows an outline of the relevant file
+ and the correct heading is found by moving through
+ the outline or by searching with incremental search.
+outline-path-completion Headlines in the current buffer are offered via
+ completion. This is the interface also used by
+ the refile command."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Outline" outline)
+ (const :tag "Outline-path-completion" outline-path-completion)))
+
+(defcustom org-goto-max-level 5
+ "Maximum target level when running `org-goto' with refile interface."
+ :group 'org-refile
+ :type 'integer)
+
+(defcustom org-reverse-note-order nil
+ "Non-nil means store new notes at the beginning of a file or entry.
+When nil, new notes will be filed to the end of a file or entry.
+This can also be a list with cons cells of regular expressions that
+are matched against file names, and values."
+ :group 'org-remember
+ :group 'org-capture
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Reverse always" t)
+ (const :tag "Reverse never" nil)
+ (repeat :tag "By file name regexp"
+ (cons regexp boolean))))
+
+(defcustom org-log-refile nil
+ "Information to record when a task is refiled.
+
+Possible values are:
+
+nil Don't add anything
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologrefile
+ #+STARTUP: logrefile
+ #+STARTUP: lognoterefile
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords.
+
+When bulk-refiling from the agenda, the value `note' is forbidden and
+will temporarily be changed to `time'."
+ :group 'org-refile
+ :group 'org-progress
+ :version "24.1"
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-refile-targets nil
+ "Targets for refiling entries with \\[org-refile].
+This is a list of cons cells. Each cell contains:
+- a specification of the files to be considered, either a list of files,
+ or a symbol whose function or variable value will be used to retrieve
+ a file name or a list of file names. If you use `org-agenda-files' for
+ that, all agenda files will be scanned for targets. Nil means consider
+ headings in the current buffer.
+- A specification of how to find candidate refile targets. This may be
+ any of:
+ - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
+ This tag has to be present in all target headlines, inheritance will
+ not be considered.
+ - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
+ todo keyword.
+ - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
+ headlines that are refiling targets.
+ - a cons cell (:level . N). Any headline of level N is considered a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+ - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
+ Note that, when `org-odd-levels-only' is set, level corresponds to
+ order in hierarchy, not to the number of stars.
+
+Each element of this list generates a set of possible targets.
+The union of these sets is presented (with completion) to
+the user by `org-refile'.
+
+You can set the variable `org-refile-target-verify-function' to a function
+to verify each headline found by the simple criteria above.
+
+When this variable is nil, all top-level headlines in the current buffer
+are used, equivalent to the value `((nil . (:level . 1))'."
+ :group 'org-refile
+ :type '(repeat
+ (cons
+ (choice :value org-agenda-files
+ (const :tag "All agenda files" org-agenda-files)
+ (const :tag "Current buffer" nil)
+ (function) (variable) (file))
+ (choice :tag "Identify target headline by"
+ (cons :tag "Specific tag" (const :value :tag) (string))
+ (cons :tag "TODO keyword" (const :value :todo) (string))
+ (cons :tag "Regular expression" (const :value :regexp) (regexp))
+ (cons :tag "Level number" (const :value :level) (integer))
+ (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
+
+(defcustom org-refile-target-verify-function nil
+ "Function to verify if the headline at point should be a refile target.
+The function will be called without arguments, with point at the
+beginning of the headline. It should return t and leave point
+where it is if the headline is a valid target for refiling.
+
+If the target should not be selected, the function must return nil.
+In addition to this, it may move point to a place from where the search
+should be continued. For example, the function may decide that the entire
+subtree of the current entry should be excluded and move point to the end
+of the subtree."
+ :group 'org-refile
+ :type 'function)
+
+(defcustom org-refile-use-cache nil
+ "Non-nil means cache refile targets to speed up the process.
+The cache for a particular file will be updated automatically when
+the buffer has been killed, or when any of the marker used for flagging
+refile targets no longer points at a live buffer.
+If you have added new entries to a buffer that might themselves be targets,
+you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you
+find that easier, `C-u C-u C-u C-c C-w'."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-refile-use-outline-path nil
+ "Non-nil means provide refile targets as paths.
+So a level 3 headline will be available as level1/level2/level3.
+
+When the value is `file', also include the file name (without directory)
+into the path. In this case, you can also stop the completion after
+the file name, to get entries inserted as top level in the file.
+
+When `full-file-path', include the full file path."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Yes" t)
+ (const :tag "Start with file name" file)
+ (const :tag "Start with full file path" full-file-path)))
+
+(defcustom org-outline-path-complete-in-steps t
+ "Non-nil means complete the outline path in hierarchical steps.
+When Org-mode uses the refile interface to select an outline path
+\(see variable `org-refile-use-outline-path'), the completion of
+the path can be done is a single go, or if can be done in steps down
+the headline hierarchy. Going in steps is probably the best if you
+do not use a special completion package like `ido' or `icicles'.
+However, when using these packages, going in one step can be very
+fast, while still showing the whole path to the entry."
+ :group 'org-refile
+ :type 'boolean)
+
+(defcustom org-refile-allow-creating-parent-nodes nil
+ "Non-nil means allow to create new nodes as refile targets.
+New nodes are then created by adding \"/new node name\" to the completion
+of an existing node. When the value of this variable is `confirm',
+new node creation must be confirmed by the user (recommended)
+When nil, the completion must match an existing entry.
+
+Note that, if the new heading is not seen by the criteria
+listed in `org-refile-targets', multiple instances of the same
+heading would be created by trying again to file under the new
+heading."
+ :group 'org-refile
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (const :tag "Prompt for confirmation" confirm)))
+
+(defcustom org-refile-active-region-within-subtree nil
+ "Non-nil means also refile active region within a subtree.
+
+By default `org-refile' doesn't allow refiling regions if they
+don't contain a set of subtrees, but it might be convenient to
+do so sometimes: in that case, the first line of the region is
+converted to a headline before refiling."
+ :group 'org-refile
+ :version "24.1"
+ :type 'boolean)
+
+(defgroup org-todo nil
+ "Options concerning TODO items in Org-mode."
+ :tag "Org TODO"
+ :group 'org)
+
+(defgroup org-progress nil
+ "Options concerning Progress logging in Org-mode."
+ :tag "Org Progress"
+ :group 'org-time)
+
+(defvar org-todo-interpretation-widgets
+ '((:tag "Sequence (cycling hits every state)" sequence)
+ (:tag "Type (cycling directly to DONE)" type))
+ "The available interpretation symbols for customizing `org-todo-keywords'.
+Interested libraries should add to this list.")
+
+(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
+ "List of TODO entry keyword sequences and their interpretation.
+\\<org-mode-map>This is a list of sequences.
+
+Each sequence starts with a symbol, either `sequence' or `type',
+indicating if the keywords should be interpreted as a sequence of
+action steps, or as different types of TODO items. The first
+keywords are states requiring action - these states will select a headline
+for inclusion into the global TODO list Org-mode produces. If one of
+the \"keywords\" is the vertical bar, \"|\", the remaining keywords
+signify that no further action is necessary. If \"|\" is not found,
+the last keyword is treated as the only DONE state of the sequence.
+
+The command \\[org-todo] cycles an entry through these states, and one
+additional state where no keyword is present. For details about this
+cycling, see the manual.
+
+TODO keywords and interpretation can also be set on a per-file basis with
+the special #+SEQ_TODO and #+TYP_TODO lines.
+
+Each keyword can optionally specify a character for fast state selection
+\(in combination with the variable `org-use-fast-todo-selection')
+and specifiers for state change logging, using the same syntax that
+is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that
+the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
+indicates to record a time stamp each time this state is selected.
+
+Each keyword may also specify if a timestamp or a note should be
+recorded when entering or leaving the state, by adding additional
+characters in the parenthesis after the keyword. This looks like this:
+\"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to
+record only the time of the state change. With X and Y being either
+\"@\" or \"!\", \"X/Y\" means use X when entering the state, and use
+Y when leaving the state if and only if the *target* state does not
+define X. You may omit any of the fast-selection key or X or /Y,
+so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
+
+For backward compatibility, this variable may also be just a list
+of keywords. In this case the interpretation (sequence or type) will be
+taken from the (otherwise obsolete) variable `org-todo-interpretation'."
+ :group 'org-todo
+ :group 'org-keywords
+ :type '(choice
+ (repeat :tag "Old syntax, just keywords"
+ (string :tag "Keyword"))
+ (repeat :tag "New syntax"
+ (cons
+ (choice
+ :tag "Interpretation"
+ ;;Quick and dirty way to see
+ ;;`org-todo-interpretations'. This takes the
+ ;;place of item arguments
+ :convert-widget
+ (lambda (widget)
+ (widget-put widget
+ :args (mapcar
+ #'(lambda (x)
+ (widget-convert
+ (cons 'const x)))
+ org-todo-interpretation-widgets))
+ widget))
+ (repeat
+ (string :tag "Keyword"))))))
+
+(defvar org-todo-keywords-1 nil
+ "All TODO and DONE keywords active in a buffer.")
+(make-variable-buffer-local 'org-todo-keywords-1)
+(defvar org-todo-keywords-for-agenda nil)
+(defvar org-done-keywords-for-agenda nil)
+(defvar org-drawers-for-agenda nil)
+(defvar org-todo-keyword-alist-for-agenda nil)
+(defvar org-tag-alist-for-agenda nil)
+(defvar org-agenda-contributing-files nil)
+(defvar org-not-done-keywords nil)
+(make-variable-buffer-local 'org-not-done-keywords)
+(defvar org-done-keywords nil)
+(make-variable-buffer-local 'org-done-keywords)
+(defvar org-todo-heads nil)
+(make-variable-buffer-local 'org-todo-heads)
+(defvar org-todo-sets nil)
+(make-variable-buffer-local 'org-todo-sets)
+(defvar org-todo-log-states nil)
+(make-variable-buffer-local 'org-todo-log-states)
+(defvar org-todo-kwd-alist nil)
+(make-variable-buffer-local 'org-todo-kwd-alist)
+(defvar org-todo-key-alist nil)
+(make-variable-buffer-local 'org-todo-key-alist)
+(defvar org-todo-key-trigger nil)
+(make-variable-buffer-local 'org-todo-key-trigger)
+
+(defcustom org-todo-interpretation 'sequence
+ "Controls how TODO keywords are interpreted.
+This variable is in principle obsolete and is only used for
+backward compatibility, if the interpretation of todo keywords is
+not given already in `org-todo-keywords'. See that variable for
+more information."
+ :group 'org-todo
+ :group 'org-keywords
+ :type '(choice (const sequence)
+ (const type)))
+
+(defcustom org-use-fast-todo-selection t
+ "Non-nil means use the fast todo selection scheme with C-c C-t.
+This variable describes if and under what circumstances the cycling
+mechanism for TODO keywords will be replaced by a single-key, direct
+selection scheme.
+
+When nil, fast selection is never used.
+
+When the symbol `prefix', it will be used when `org-todo' is called
+with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and
+`C-u t' in an agenda buffer.
+
+When t, fast selection is used by default. In this case, the prefix
+argument forces cycling instead.
+
+In all cases, the special interface is only used if access keys have
+actually been assigned by the user, i.e. if keywords in the configuration
+are followed by a letter in parenthesis, like TODO(t)."
+ :group 'org-todo
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "By default" t)
+ (const :tag "Only with C-u C-c C-t" prefix)))
+
+(defcustom org-provide-todo-statistics t
+ "Non-nil means update todo statistics after insert and toggle.
+ALL-HEADLINES means update todo statistics by including headlines
+with no TODO keyword as well, counting them as not done.
+A list of TODO keywords means the same, but skip keywords that are
+not in this list.
+
+When this is set, todo statistics is updated in the parent of the
+current entry each time a todo state is changed."
+ :group 'org-todo
+ :type '(choice
+ (const :tag "Yes, only for TODO entries" t)
+ (const :tag "Yes, including all entries" 'all-headlines)
+ (repeat :tag "Yes, for TODOs in this list"
+ (string :tag "TODO keyword"))
+ (other :tag "No TODO statistics" nil)))
+
+(defcustom org-hierarchical-todo-statistics t
+ "Non-nil means TODO statistics covers just direct children.
+When nil, all entries in the subtree are considered.
+This has only an effect if `org-provide-todo-statistics' is set.
+To set this to nil for only a single subtree, use a COOKIE_DATA
+property and include the word \"recursive\" into the value."
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-after-todo-state-change-hook nil
+ "Hook which is run after the state of a TODO item was changed.
+The new state (a string with a TODO keyword, or nil) is available in the
+Lisp variable `org-state'."
+ :group 'org-todo
+ :type 'hook)
+
+(defvar org-blocker-hook nil
+ "Hook for functions that are allowed to block a state change.
+
+Each function gets as its single argument a property list, see
+`org-trigger-hook' for more information about this list.
+
+If any of the functions in this hook returns nil, the state change
+is blocked.")
+
+(defvar org-trigger-hook nil
+ "Hook for functions that are triggered by a state change.
+
+Each function gets as its single argument a property list with at least
+the following elements:
+
+ (:type type-of-change :position pos-at-entry-start
+ :from old-state :to new-state)
+
+Depending on the type, more properties may be present.
+
+This mechanism is currently implemented for:
+
+TODO state changes
+------------------
+:type todo-state-change
+:from previous state (keyword as a string), or nil, or a symbol
+ 'todo' or 'done', to indicate the general type of state.
+:to new state, like in :from")
+
+(defcustom org-enforce-todo-dependencies nil
+ "Non-nil means undone TODO entries will block switching the parent to DONE.
+Also, if a parent has an :ORDERED: property, switching an entry to DONE will
+be blocked if any prior sibling is not yet done.
+Finally, if the parent is blocked because of ordered siblings of its own,
+the child will also be blocked."
+ :set (lambda (var val)
+ (set var val)
+ (if val
+ (add-hook 'org-blocker-hook
+ 'org-block-todo-from-children-or-siblings-or-parent)
+ (remove-hook 'org-blocker-hook
+ 'org-block-todo-from-children-or-siblings-or-parent)))
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-enforce-todo-checkbox-dependencies nil
+ "Non-nil means unchecked boxes will block switching the parent to DONE.
+When this is nil, checkboxes have no influence on switching TODO states.
+When non-nil, you first need to check off all check boxes before the TODO
+entry can be switched to DONE.
+This variable needs to be set before org.el is loaded, and you need to
+restart Emacs after a change to make the change effective. The only way
+to change is while Emacs is running is through the customize interface."
+ :set (lambda (var val)
+ (set var val)
+ (if val
+ (add-hook 'org-blocker-hook
+ 'org-block-todo-from-checkboxes)
+ (remove-hook 'org-blocker-hook
+ 'org-block-todo-from-checkboxes)))
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-treat-insert-todo-heading-as-state-change nil
+ "Non-nil means inserting a TODO heading is treated as state change.
+So when the command \\[org-insert-todo-heading] is used, state change
+logging will apply if appropriate. When nil, the new TODO item will
+be inserted directly, and no logging will take place."
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-treat-S-cursor-todo-selection-as-state-change t
+ "Non-nil means switching TODO states with S-cursor counts as state change.
+This is the default behavior. However, setting this to nil allows a
+convenient way to select a TODO state and bypass any logging associated
+with that."
+ :group 'org-todo
+ :type 'boolean)
+
+(defcustom org-todo-state-tags-triggers nil
+ "Tag changes that should be triggered by TODO state changes.
+This is a list. Each entry is
+
+ (state-change (tag . flag) .......)
+
+State-change can be a string with a state, and empty string to indicate the
+state that has no TODO keyword, or it can be one of the symbols `todo'
+or `done', meaning any not-done or done state, respectively."
+ :group 'org-todo
+ :group 'org-tags
+ :type '(repeat
+ (cons (choice :tag "When changing to"
+ (const :tag "Not-done state" todo)
+ (const :tag "Done state" done)
+ (string :tag "State"))
+ (repeat
+ (cons :tag "Tag action"
+ (string :tag "Tag")
+ (choice (const :tag "Add" t) (const :tag "Remove" nil)))))))
+
+(defcustom org-log-done nil
+ "Information to record when a task moves to the DONE state.
+
+Possible values are:
+
+nil Don't add anything, just change the keyword
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologdone
+ #+STARTUP: logdone
+ #+STARTUP: lognotedone
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record CLOSED timestamp" time)
+ (const :tag "Record CLOSED timestamp with note." note)))
+
+;; Normalize old uses of org-log-done.
+(cond
+ ((eq org-log-done t) (setq org-log-done 'time))
+ ((and (listp org-log-done) (memq 'done org-log-done))
+ (setq org-log-done 'note)))
+
+(defcustom org-log-reschedule nil
+ "Information to record when the scheduling date of a tasks is modified.
+
+Possible values are:
+
+nil Don't add anything, just change the date
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologreschedule
+ #+STARTUP: logreschedule
+ #+STARTUP: lognotereschedule"
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-log-redeadline nil
+ "Information to record when the deadline date of a tasks is modified.
+
+Possible values are:
+
+nil Don't add anything, just change the date
+time Add a time stamp to the task
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologredeadline
+ #+STARTUP: logredeadline
+ #+STARTUP: lognoteredeadline
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "No logging" nil)
+ (const :tag "Record timestamp" time)
+ (const :tag "Record timestamp with note." note)))
+
+(defcustom org-log-note-clock-out nil
+ "Non-nil means record a note when clocking out of an item.
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+
+ #+STARTUP: lognoteclock-out
+ #+STARTUP: nolognoteclock-out"
+ :group 'org-todo
+ :group 'org-progress
+ :type 'boolean)
+
+(defcustom org-log-done-with-time t
+ "Non-nil means the CLOSED time stamp will contain date and time.
+When nil, only the date will be recorded."
+ :group 'org-progress
+ :type 'boolean)
+
+(defcustom org-log-note-headings
+ '((done . "CLOSING NOTE %t")
+ (state . "State %-12s from %-12S %t")
+ (note . "Note taken on %t")
+ (reschedule . "Rescheduled from %S on %t")
+ (delschedule . "Not scheduled, was %S on %t")
+ (redeadline . "New deadline from %S on %t")
+ (deldeadline . "Removed deadline, was %S on %t")
+ (refile . "Refiled on %t")
+ (clock-out . ""))
+ "Headings for notes added to entries.
+The value is an alist, with the car being a symbol indicating the note
+context, and the cdr is the heading to be used. The heading may also be the
+empty string.
+%t in the heading will be replaced by a time stamp.
+%T will be an active time stamp instead the default inactive one
+%d will be replaced by a short-format time stamp.
+%D will be replaced by an active short-format time stamp.
+%s will be replaced by the new TODO state, in double quotes.
+%S will be replaced by the old TODO state, in double quotes.
+%u will be replaced by the user name.
+%U will be replaced by the full user name.
+
+In fact, it is not a good idea to change the `state' entry, because
+agenda log mode depends on the format of these entries."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(list :greedy t
+ (cons (const :tag "Heading when closing an item" done) string)
+ (cons (const :tag
+ "Heading when changing todo state (todo sequence only)"
+ state) string)
+ (cons (const :tag "Heading when just taking a note" note) string)
+ (cons (const :tag "Heading when clocking out" clock-out) string)
+ (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
+ (cons (const :tag "Heading when rescheduling" reschedule) string)
+ (cons (const :tag "Heading when changing deadline" redeadline) string)
+ (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
+ (cons (const :tag "Heading when refiling" refile) string)))
+
+(unless (assq 'note org-log-note-headings)
+ (push '(note . "%t") org-log-note-headings))
+
+(defcustom org-log-into-drawer nil
+ "Non-nil means insert state change notes and time stamps into a drawer.
+When nil, state changes notes will be inserted after the headline and
+any scheduling and clock lines, but not inside a drawer.
+
+The value of this variable should be the name of the drawer to use.
+LOGBOOK is proposed as the default drawer for this purpose, you can
+also set this to a string to define the drawer of your choice.
+
+A value of t is also allowed, representing \"LOGBOOK\".
+
+If this variable is set, `org-log-state-notes-insert-after-drawers'
+will be ignored.
+
+You can set the property LOG_INTO_DRAWER to overrule this setting for
+a subtree."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "Not into a drawer" nil)
+ (const :tag "LOGBOOK" t)
+ (string :tag "Other")))
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
+
+(defun org-log-into-drawer ()
+ "Return the value of `org-log-into-drawer', but let properties overrule.
+If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
+used instead of the default value."
+ (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
+ (cond
+ ((or (not p) (equal p "nil")) org-log-into-drawer)
+ ((equal p "t") "LOGBOOK")
+ (t p))))
+
+(defcustom org-log-state-notes-insert-after-drawers nil
+ "Non-nil means insert state change notes after any drawers in entry.
+Only the drawers that *immediately* follow the headline and the
+deadline/scheduled line are skipped.
+When nil, insert notes right after the heading and perhaps the line
+with deadline/scheduling if present.
+
+This variable will have no effect if `org-log-into-drawer' is
+set."
+ :group 'org-todo
+ :group 'org-progress
+ :type 'boolean)
+
+(defcustom org-log-states-order-reversed t
+ "Non-nil means the latest state note will be directly after heading.
+When nil, the state change notes will be ordered according to time."
+ :group 'org-todo
+ :group 'org-progress
+ :type 'boolean)
+
+(defcustom org-todo-repeat-to-state nil
+ "The TODO state to which a repeater should return the repeating task.
+By default this is the first task in a TODO sequence, or the previous state
+in a TODO_TYP set. But you can specify another task here.
+alternatively, set the :REPEAT_TO_STATE: property of the entry."
+ :group 'org-todo
+ :version "24.1"
+ :type '(choice (const :tag "Head of sequence" nil)
+ (string :tag "Specific state")))
+
+(defcustom org-log-repeat 'time
+ "Non-nil means record moving through the DONE state when triggering repeat.
+An auto-repeating task is immediately switched back to TODO when
+marked DONE. If you are not logging state changes (by adding \"@\"
+or \"!\" to the TODO keyword definition), or set `org-log-done' to
+record a closing note, there will be no record of the task moving
+through DONE. This variable forces taking a note anyway.
+
+nil Don't force a record
+time Record a time stamp
+note Prompt for a note and add it with template `org-log-note-headings'
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: nologrepeat
+ #+STARTUP: logrepeat
+ #+STARTUP: lognoterepeat
+
+You can have local logging settings for a subtree by setting the LOGGING
+property to one or more of these keywords."
+ :group 'org-todo
+ :group 'org-progress
+ :type '(choice
+ (const :tag "Don't force a record" nil)
+ (const :tag "Force recording the DONE state" time)
+ (const :tag "Force recording a note with the DONE state" note)))
+
+
+(defgroup org-priorities nil
+ "Priorities in Org-mode."
+ :tag "Org Priorities"
+ :group 'org-todo)
+
+(defcustom org-enable-priority-commands t
+ "Non-nil means priority commands are active.
+When nil, these commands will be disabled, so that you never accidentally
+set a priority."
+ :group 'org-priorities
+ :type 'boolean)
+
+(defcustom org-highest-priority ?A
+ "The highest priority of TODO items. A character like ?A, ?B etc.
+Must have a smaller ASCII number than `org-lowest-priority'."
+ :group 'org-priorities
+ :type 'character)
+
+(defcustom org-lowest-priority ?C
+ "The lowest priority of TODO items. A character like ?A, ?B etc.
+Must have a larger ASCII number than `org-highest-priority'."
+ :group 'org-priorities
+ :type 'character)
+
+(defcustom org-default-priority ?B
+ "The default priority of TODO items.
+This is the priority an item gets if no explicit priority is given.
+When starting to cycle on an empty priority the first step in the cycle
+depends on `org-priority-start-cycle-with-default'. The resulting first
+step priority must not exceed the range from `org-highest-priority' to
+`org-lowest-priority' which means that `org-default-priority' has to be
+in this range exclusive or inclusive the range boundaries. Else the
+first step refuses to set the default and the second will fall back
+to (depending on the command used) the highest or lowest priority."
+ :group 'org-priorities
+ :type 'character)
+
+(defcustom org-priority-start-cycle-with-default t
+ "Non-nil means start with default priority when starting to cycle.
+When this is nil, the first step in the cycle will be (depending on the
+command used) one higher or lower than the default priority.
+See also `org-default-priority'."
+ :group 'org-priorities
+ :type 'boolean)
+
+(defcustom org-get-priority-function nil
+ "Function to extract the priority from a string.
+The string is normally the headline. If this is nil Org computes the
+priority from the priority cookie like [#A] in the headline. It returns
+an integer, increasing by 1000 for each priority level.
+The user can set a different function here, which should take a string
+as an argument and return the numeric priority."
+ :group 'org-priorities
+ :version "24.1"
+ :type 'function)
+
+(defgroup org-time nil
+ "Options concerning time stamps and deadlines in Org-mode."
+ :tag "Org Time"
+ :group 'org)
+
+(defcustom org-insert-labeled-timestamps-at-point nil
+ "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point.
+When nil, these labeled time stamps are forces into the second line of an
+entry, just after the headline. When scheduling from the global TODO list,
+the time stamp will always be forced into the second line."
+ :group 'org-time
+ :type 'boolean)
+
+(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
+ "Formats for `format-time-string' which are used for time stamps.
+It is not recommended to change this constant.")
+
+(defcustom org-time-stamp-rounding-minutes '(0 5)
+ "Number of minutes to round time stamps to.
+These are two values, the first applies when first creating a time stamp.
+The second applies when changing it with the commands `S-up' and `S-down'.
+When changing the time stamp, this means that it will change in steps
+of N minutes, as given by the second value.
+
+When a setting is 0 or 1, insert the time unmodified. Useful rounding
+numbers should be factors of 60, so for example 5, 10, 15.
+
+When this is larger than 1, you can still force an exact time stamp by using
+a double prefix argument to a time stamp command like `C-c .' or `C-c !',
+and by using a prefix arg to `S-up/down' to specify the exact number
+of minutes to shift."
+ :group 'org-time
+ :get #'(lambda (var) ; Make sure both elements are there
+ (if (integerp (default-value var))
+ (list (default-value var) 5)
+ (default-value var)))
+ :type '(list
+ (integer :tag "when inserting times")
+ (integer :tag "when modifying times")))
+
+;; Normalize old customizations of this variable.
+(when (integerp org-time-stamp-rounding-minutes)
+ (setq org-time-stamp-rounding-minutes
+ (list org-time-stamp-rounding-minutes
+ org-time-stamp-rounding-minutes)))
+
+(defcustom org-display-custom-times nil
+ "Non-nil means overlay custom formats over all time stamps.
+The formats are defined through the variable `org-time-stamp-custom-formats'.
+To turn this on on a per-file basis, insert anywhere in the file:
+ #+STARTUP: customtime"
+ :group 'org-time
+ :set 'set-default
+ :type 'sexp)
+(make-variable-buffer-local 'org-display-custom-times)
+
+(defcustom org-time-stamp-custom-formats
+ '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
+ "Custom formats for time stamps. See `format-time-string' for the syntax.
+These are overlaid over the default ISO format if the variable
+`org-display-custom-times' is set. Time like %H:%M should be at the
+end of the second format. The custom formats are also honored by export
+commands, if custom time display is turned on at the time of export."
+ :group 'org-time
+ :type 'sexp)
+
+(defun org-time-stamp-format (&optional long inactive)
+ "Get the right format for a time string."
+ (let ((f (if long (cdr org-time-stamp-formats)
+ (car org-time-stamp-formats))))
+ (if inactive
+ (concat "[" (substring f 1 -1) "]")
+ f)))
+
+(defcustom org-time-clocksum-format "%d:%02d"
+ "The format string used when creating CLOCKSUM lines.
+This is also used when org-mode generates a time duration."
+ :group 'org-time
+ :type 'string)
+
+(defcustom org-time-clocksum-use-fractional nil
+ "If non-nil, \\[org-clock-display] uses fractional times.
+org-mode generates a time duration."
+ :group 'org-time
+ :type 'boolean)
+
+(defcustom org-time-clocksum-fractional-format "%.2f"
+ "The format string used when creating CLOCKSUM lines, or when
+org-mode generates a time duration."
+ :group 'org-time
+ :type 'string)
+
+(defcustom org-deadline-warning-days 14
+ "No. of days before expiration during which a deadline becomes active.
+This variable governs the display in sparse trees and in the agenda.
+When 0 or negative, it means use this number (the absolute value of it)
+even if a deadline has a different individual lead time specified.
+
+Custom commands can set this variable in the options section."
+ :group 'org-time
+ :group 'org-agenda-daily/weekly
+ :type 'integer)
+
+(defcustom org-read-date-prefer-future t
+ "Non-nil means assume future for incomplete date input from user.
+This affects the following situations:
+1. The user gives a month but not a year.
+ For example, if it is April and you enter \"feb 2\", this will be read
+ as Feb 2, *next* year. \"May 5\", however, will be this year.
+2. The user gives a day, but no month.
+ For example, if today is the 15th, and you enter \"3\", Org-mode will
+ read this as the third of *next* month. However, if you enter \"17\",
+ it will be considered as *this* month.
+
+If you set this variable to the symbol `time', then also the following
+will work:
+
+3. If the user gives a time.
+ If the time is before now, it will be interpreted as tomorrow.
+
+Currently none of this works for ISO week specifications.
+
+When this option is nil, the current day, month and year will always be
+used as defaults.
+
+See also `org-agenda-jump-prefer-future'."
+ :group 'org-time
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Check month and day" t)
+ (const :tag "Check month, day, and time" time)))
+
+(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future
+ "Should the agenda jump command prefer the future for incomplete dates?
+The default is to do the same as configured in `org-read-date-prefer-future'.
+But you can also set a deviating value here.
+This may t or nil, or the symbol `org-read-date-prefer-future'."
+ :group 'org-agenda
+ :group 'org-time
+ :version "24.1"
+ :type '(choice
+ (const :tag "Use org-read-date-prefer-future"
+ org-read-date-prefer-future)
+ (const :tag "Never" nil)
+ (const :tag "Always" t)))
+
+(defcustom org-read-date-force-compatible-dates t
+ "Should date/time prompt force dates that are guaranteed to work in Emacs?
+
+Depending on the system Emacs is running on, certain dates cannot
+be represented with the type used internally to represent time.
+Dates between 1970-1-1 and 2038-1-1 can always be represented
+correctly. Some systems allow for earlier dates, some for later,
+some for both. One way to find out it to insert any date into an
+Org buffer, putting the cursor on the year and hitting S-up and
+S-down to test the range.
+
+When this variable is set to t, the date/time prompt will not let
+you specify dates outside the 1970-2037 range, so it is certain that
+these dates will work in whatever version of Emacs you are
+running, and also that you can move a file from one Emacs implementation
+to another. WHenever Org is forcing the year for you, it will display
+a message and beep.
+
+When this variable is nil, Org will check if the date is
+representable in the specific Emacs implementation you are using.
+If not, it will force a year, usually the current year, and beep
+to remind you. Currently this setting is not recommended because
+the likelihood that you will open your Org files in an Emacs that
+has limited date range is not negligible.
+
+A workaround for this problem is to use diary sexp dates for time
+stamps outside of this range."
+ :group 'org-time
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-read-date-display-live t
+ "Non-nil means display current interpretation of date prompt live.
+This display will be in an overlay, in the minibuffer."
+ :group 'org-time
+ :type 'boolean)
+
+(defcustom org-read-date-popup-calendar t
+ "Non-nil means pop up a calendar when prompting for a date.
+In the calendar, the date can be selected with mouse-1. However, the
+minibuffer will also be active, and you can simply enter the date as well.
+When nil, only the minibuffer will be available."
+ :group 'org-time
+ :type 'boolean)
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-popup-calendar-for-date-prompt
+ 'org-read-date-popup-calendar))
+
+(defcustom org-read-date-minibuffer-setup-hook nil
+ "Hook to be used to set up keys for the date/time interface.
+Add key definitions to `minibuffer-local-map', which will be a temporary
+copy."
+ :group 'org-time
+ :type 'hook)
+
+(defcustom org-extend-today-until 0
+ "The hour when your day really ends. Must be an integer.
+This has influence for the following applications:
+- When switching the agenda to \"today\". It it is still earlier than
+ the time given here, the day recognized as TODAY is actually yesterday.
+- When a date is read from the user and it is still before the time given
+ here, the current date and time will be assumed to be yesterday, 23:59.
+ Also, timestamps inserted in capture templates follow this rule.
+
+IMPORTANT: This is a feature whose implementation is and likely will
+remain incomplete. Really, it is only here because past midnight seems to
+be the favorite working time of John Wiegley :-)"
+ :group 'org-time
+ :type 'integer)
+
+(defcustom org-use-effective-time nil
+ "If non-nil, consider `org-extend-today-until' when creating timestamps.
+For example, if `org-extend-today-until' is 8, and it's 4am, then the
+\"effective time\" of any timestamps between midnight and 8am will be
+23:59 of the previous day."
+ :group 'org-time
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-edit-timestamp-down-means-later nil
+ "Non-nil means S-down will increase the time in a time stamp.
+When nil, S-up will increase."
+ :group 'org-time
+ :type 'boolean)
+
+(defcustom org-calendar-follow-timestamp-change t
+ "Non-nil means make the calendar window follow timestamp changes.
+When a timestamp is modified and the calendar window is visible, it will be
+moved to the new date."
+ :group 'org-time
+ :type 'boolean)
+
+(defgroup org-tags nil
+ "Options concerning tags in Org-mode."
+ :tag "Org Tags"
+ :group 'org)
+
+(defcustom org-tag-alist nil
+ "List of tags allowed in Org-mode files.
+When this list is nil, Org-mode will base TAG input on what is already in the
+buffer.
+The value of this variable is an alist, the car of each entry must be a
+keyword as a string, the cdr may be a character that is used to select
+that tag through the fast-tag-selection interface.
+See the manual for details."
+ :group 'org-tags
+ :type '(repeat
+ (choice
+ (cons (string :tag "Tag name")
+ (character :tag "Access char"))
+ (list :tag "Start radio group"
+ (const :startgroup)
+ (option (string :tag "Group description")))
+ (list :tag "End radio group"
+ (const :endgroup)
+ (option (string :tag "Group description")))
+ (const :tag "New line" (:newline)))))
+
+(defcustom org-tag-persistent-alist nil
+ "List of tags that will always appear in all Org-mode files.
+This is in addition to any in buffer settings or customizations
+of `org-tag-alist'.
+When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
+The value of this variable is an alist, the car of each entry must be a
+keyword as a string, the cdr may be a character that is used to select
+that tag through the fast-tag-selection interface.
+See the manual for details.
+To disable these tags on a per-file basis, insert anywhere in the file:
+ #+STARTUP: noptag"
+ :group 'org-tags
+ :type '(repeat
+ (choice
+ (cons (string :tag "Tag name")
+ (character :tag "Access char"))
+ (const :tag "Start radio group" (:startgroup))
+ (const :tag "End radio group" (:endgroup))
+ (const :tag "New line" (:newline)))))
+
+(defcustom org-complete-tags-always-offer-all-agenda-tags nil
+ "If non-nil, always offer completion for all tags of all agenda files.
+Instead of customizing this variable directly, you might want to
+set it locally for capture buffers, because there no list of
+tags in that file can be created dynamically (there are none).
+
+ (add-hook 'org-capture-mode-hook
+ (lambda ()
+ (set (make-local-variable
+ 'org-complete-tags-always-offer-all-agenda-tags)
+ t)))"
+ :group 'org-tags
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-file-tags nil
+ "List of tags that can be inherited by all entries in the file.
+The tags will be inherited if the variable `org-use-tag-inheritance'
+says they should be.
+This variable is populated from #+FILETAGS lines.")
+
+(defcustom org-use-fast-tag-selection 'auto
+ "Non-nil means use fast tag selection scheme.
+This is a special interface to select and deselect tags with single keys.
+When nil, fast selection is never used.
+When the symbol `auto', fast selection is used if and only if selection
+characters for tags have been configured, either through the variable
+`org-tag-alist' or through a #+TAGS line in the buffer.
+When t, fast selection is always used and selection keys are assigned
+automatically if necessary."
+ :group 'org-tags
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "When selection characters are configured" 'auto)))
+
+(defcustom org-fast-tag-selection-single-key nil
+ "Non-nil means fast tag selection exits after first change.
+When nil, you have to press RET to exit it.
+During fast tag selection, you can toggle this flag with `C-c'.
+This variable can also have the value `expert'. In this case, the window
+displaying the tags menu is not even shown, until you press C-c again."
+ :group 'org-tags
+ :type '(choice
+ (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (const :tag "Expert" expert)))
+
+(defvar org-fast-tag-selection-include-todo nil
+ "Non-nil means fast tags selection interface will also offer TODO states.
+This is an undocumented feature, you should not rely on it.")
+
+(defcustom org-tags-column (if (featurep 'xemacs) -76 -77)
+ "The column to which tags should be indented in a headline.
+If this number is positive, it specifies the column. If it is negative,
+it means that the tags should be flushright to that column. For example,
+-80 works well for a normal 80 character screen.
+When 0, place tags directly after headline text, with only one space in
+between."
+ :group 'org-tags
+ :type 'integer)
+
+(defcustom org-auto-align-tags t
+ "Non-nil keeps tags aligned when modifying headlines.
+Some operations (i.e. demoting) change the length of a headline and
+therefore shift the tags around. With this option turned on, after
+each such operation the tags are again aligned to `org-tags-column'."
+ :group 'org-tags
+ :type 'boolean)
+
+(defcustom org-use-tag-inheritance t
+ "Non-nil means tags in levels apply also for sublevels.
+When nil, only the tags directly given in a specific line apply there.
+This may also be a list of tags that should be inherited, or a regexp that
+matches tags that should be inherited. Additional control is possible
+with the variable `org-tags-exclude-from-inheritance' which gives an
+explicit list of tags to be excluded from inheritance., even if the value of
+`org-use-tag-inheritance' would select it for inheritance.
+
+If this option is t, a match early-on in a tree can lead to a large
+number of matches in the subtree when constructing the agenda or creating
+a sparse tree. If you only want to see the first match in a tree during
+a search, check out the variable `org-tags-match-list-sublevels'."
+ :group 'org-tags
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Always" t)
+ (repeat :tag "Specific tags" (string :tag "Tag"))
+ (regexp :tag "Tags matched by regexp")))
+
+(defcustom org-tags-exclude-from-inheritance nil
+ "List of tags that should never be inherited.
+This is a way to exclude a few tags from inheritance. For way to do
+the opposite, to actively allow inheritance for selected tags,
+see the variable `org-use-tag-inheritance'."
+ :group 'org-tags
+ :type '(repeat (string :tag "Tag")))
+
+(defun org-tag-inherit-p (tag)
+ "Check if TAG is one that should be inherited."
+ (cond
+ ((member tag org-tags-exclude-from-inheritance) nil)
+ ((eq org-use-tag-inheritance t) t)
+ ((not org-use-tag-inheritance) nil)
+ ((stringp org-use-tag-inheritance)
+ (string-match org-use-tag-inheritance tag))
+ ((listp org-use-tag-inheritance)
+ (member tag org-use-tag-inheritance))
+ (t (error "Invalid setting of `org-use-tag-inheritance'"))))
+
+(defcustom org-tags-match-list-sublevels t
+ "Non-nil means list also sublevels of headlines matching a search.
+This variable applies to tags/property searches, and also to stuck
+projects because this search is based on a tags match as well.
+
+When set to the symbol `indented', sublevels are indented with
+leading dots.
+
+Because of tag inheritance (see variable `org-use-tag-inheritance'),
+the sublevels of a headline matching a tag search often also match
+the same search. Listing all of them can create very long lists.
+Setting this variable to nil causes subtrees of a match to be skipped.
+
+This variable is semi-obsolete and probably should always be true. It
+is better to limit inheritance to certain tags using the variables
+`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
+ :group 'org-tags
+ :type '(choice
+ (const :tag "No, don't list them" nil)
+ (const :tag "Yes, do list them" t)
+ (const :tag "List them, indented with leading dots" indented)))
+
+(defcustom org-tags-sort-function nil
+ "When set, tags are sorted using this function as a comparator."
+ :group 'org-tags
+ :type '(choice
+ (const :tag "No sorting" nil)
+ (const :tag "Alphabetical" string<)
+ (const :tag "Reverse alphabetical" string>)
+ (function :tag "Custom function" nil)))
+
+(defvar org-tags-history nil
+ "History of minibuffer reads for tags.")
+(defvar org-last-tags-completion-table nil
+ "The last used completion table for tags.")
+(defvar org-after-tags-change-hook nil
+ "Hook that is run after the tags in a line have changed.")
+
+(defgroup org-properties nil
+ "Options concerning properties in Org-mode."
+ :tag "Org Properties"
+ :group 'org)
+
+(defcustom org-property-format "%-10s %s"
+ "How property key/value pairs should be formatted by `indent-line'.
+When `indent-line' hits a property definition, it will format the line
+according to this format, mainly to make sure that the values are
+lined-up with respect to each other."
+ :group 'org-properties
+ :type 'string)
+
+(defcustom org-properties-postprocess-alist nil
+ "Alist of properties and functions to adjust inserted values.
+Elements of this alist must be of the form
+
+ ([string] [function])
+
+where [string] must be a property name and [function] must be a
+lambda expression: this lambda expression must take one argument,
+the value to adjust, and return the new value as a string.
+
+For example, this element will allow the property \"Remaining\"
+to be updated wrt the relation between the \"Effort\" property
+and the clock summary:
+
+ ((\"Remaining\" (lambda(value)
+ (let ((clocksum (org-clock-sum-current-item))
+ (effort (org-duration-string-to-minutes
+ (org-entry-get (point) \"Effort\"))))
+ (org-minutes-to-hh:mm-string (- effort clocksum))))))"
+ :group 'org-properties
+ :version "24.1"
+ :type '(alist :key-type (string :tag "Property")
+ :value-type (function :tag "Function")))
+
+(defcustom org-use-property-inheritance nil
+ "Non-nil means properties apply also for sublevels.
+
+This setting is chiefly used during property searches. Turning it on can
+cause significant overhead when doing a search, which is why it is not
+on by default.
+
+When nil, only the properties directly given in the current entry count.
+When t, every property is inherited. The value may also be a list of
+properties that should have inheritance, or a regular expression matching
+properties that should be inherited.
+
+However, note that some special properties use inheritance under special
+circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
+and the properties ending in \"_ALL\" when they are used as descriptor
+for valid values of a property.
+
+Note for programmers:
+When querying an entry with `org-entry-get', you can control if inheritance
+should be used. By default, `org-entry-get' looks only at the local
+properties. You can request inheritance by setting the inherit argument
+to t (to force inheritance) or to `selective' (to respect the setting
+in this variable)."
+ :group 'org-properties
+ :type '(choice
+ (const :tag "Not" nil)
+ (const :tag "Always" t)
+ (repeat :tag "Specific properties" (string :tag "Property"))
+ (regexp :tag "Properties matched by regexp")))
+
+(defun org-property-inherit-p (property)
+ "Check if PROPERTY is one that should be inherited."
+ (cond
+ ((eq org-use-property-inheritance t) t)
+ ((not org-use-property-inheritance) nil)
+ ((stringp org-use-property-inheritance)
+ (string-match org-use-property-inheritance property))
+ ((listp org-use-property-inheritance)
+ (member property org-use-property-inheritance))
+ (t (error "Invalid setting of `org-use-property-inheritance'"))))
+
+(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
+ "The default column format, if no other format has been defined.
+This variable can be set on the per-file basis by inserting a line
+
+#+COLUMNS: %25ITEM ....."
+ :group 'org-properties
+ :type 'string)
+
+(defcustom org-columns-ellipses ".."
+ "The ellipses to be used when a field in column view is truncated.
+When this is the empty string, as many characters as possible are shown,
+but then there will be no visual indication that the field has been truncated.
+When this is a string of length N, the last N characters of a truncated
+field are replaced by this string. If the column is narrower than the
+ellipses string, only part of the ellipses string will be shown."
+ :group 'org-properties
+ :type 'string)
+
+(defcustom org-columns-modify-value-for-display-function nil
+ "Function that modifies values for display in column view.
+For example, it can be used to cut out a certain part from a time stamp.
+The function must take 2 arguments:
+
+column-title The title of the column (*not* the property name)
+value The value that should be modified.
+
+The function should return the value that should be displayed,
+or nil if the normal value should be used."
+ :group 'org-properties
+ :type 'function)
+
+(defcustom org-effort-property "Effort"
+ "The property that is being used to keep track of effort estimates.
+Effort estimates given in this property need to have the format H:MM."
+ :group 'org-properties
+ :group 'org-progress
+ :type '(string :tag "Property"))
+
+(defconst org-global-properties-fixed
+ '(("VISIBILITY_ALL" . "folded children content all")
+ ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
+ "List of property/value pairs that can be inherited by any entry.
+
+These are fixed values, for the preset properties. The user variable
+that can be used to add to this list is `org-global-properties'.
+
+The entries in this list are cons cells where the car is a property
+name and cdr is a string with the value. If the value represents
+multiple items like an \"_ALL\" property, separate the items by
+spaces.")
+
+(defcustom org-global-properties nil
+ "List of property/value pairs that can be inherited by any entry.
+
+This list will be combined with the constant `org-global-properties-fixed'.
+
+The entries in this list are cons cells where the car is a property
+name and cdr is a string with the value.
+
+You can set buffer-local values for the same purpose in the variable
+`org-file-properties' this by adding lines like
+
+#+PROPERTY: NAME VALUE"
+ :group 'org-properties
+ :type '(repeat
+ (cons (string :tag "Property")
+ (string :tag "Value"))))
+
+(defvar org-file-properties nil
+ "List of property/value pairs that can be inherited by any entry.
+Valid for the current buffer.
+This variable is populated from #+PROPERTY lines.")
+(make-variable-buffer-local 'org-file-properties)
+
+(defgroup org-agenda nil
+ "Options concerning agenda views in Org-mode."
+ :tag "Org Agenda"
+ :group 'org)
+
+(defvar org-category nil
+ "Variable used by org files to set a category for agenda display.
+Such files should use a file variable to set it, for example
+
+# -*- mode: org; org-category: \"ELisp\"
+
+or contain a special line
+
+#+CATEGORY: ELisp
+
+If the file does not specify a category, then file's base name
+is used instead.")
+(make-variable-buffer-local 'org-category)
+(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x))))
+
+(defcustom org-agenda-files nil
+ "The files to be used for agenda display.
+Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
+\\[org-remove-file]. You can also use customize to edit the list.
+
+If an entry is a directory, all files in that directory that are matched by
+`org-agenda-file-regexp' will be part of the file list.
+
+If the value of the variable is not a list but a single file name, then
+the list of agenda files is actually stored and maintained in that file, one
+agenda file per line. In this file paths can be given relative to
+`org-directory'. Tilde expansion and environment variable substitution
+are also made."
+ :group 'org-agenda
+ :type '(choice
+ (repeat :tag "List of files and directories" file)
+ (file :tag "Store list in a file\n" :value "~/.agenda_files")))
+
+(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
+ "Regular expression to match files for `org-agenda-files'.
+If any element in the list in that variable contains a directory instead
+of a normal file, all files in that directory that are matched by this
+regular expression will be included."
+ :group 'org-agenda
+ :type 'regexp)
+
+(defcustom org-agenda-text-search-extra-files nil
+ "List of extra files to be searched by text search commands.
+These files will be search in addition to the agenda files by the
+commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'.
+Note that these files will only be searched for text search commands,
+not for the other agenda views like todo lists, tag searches or the weekly
+agenda. This variable is intended to list notes and possibly archive files
+that should also be searched by these two commands.
+In fact, if the first element in the list is the symbol `agenda-archives',
+than all archive files of all agenda files will be added to the search
+scope."
+ :group 'org-agenda
+ :type '(set :greedy t
+ (const :tag "Agenda Archives" agenda-archives)
+ (repeat :inline t (file))))
+
+(if (fboundp 'defvaralias)
+ (defvaralias 'org-agenda-multi-occur-extra-files
+ 'org-agenda-text-search-extra-files))
+
+(defcustom org-agenda-skip-unavailable-files nil
+ "Non-nil means to just skip non-reachable files in `org-agenda-files'.
+A nil value means to remove them, after a query, from the list."
+ :group 'org-agenda
+ :type 'boolean)
+
+(defcustom org-calendar-to-agenda-key [?c]
+ "The key to be installed in `calendar-mode-map' for switching to the agenda.
+The command `org-calendar-goto-agenda' will be bound to this key. The
+default is the character `c' because then `c' can be used to switch back and
+forth between agenda and calendar."
+ :group 'org-agenda
+ :type 'sexp)
+
+(defcustom org-calendar-agenda-action-key [?k]
+ "The key to be installed in `calendar-mode-map' for agenda-action.
+The command `org-agenda-action' will be bound to this key. The
+default is the character `k' because we use the same key in the agenda."
+ :group 'org-agenda
+ :type 'sexp)
+
+(defcustom org-calendar-insert-diary-entry-key [?i]
+ "The key to be installed in `calendar-mode-map' for adding diary entries.
+This option is irrelevant until `org-agenda-diary-file' has been configured
+to point to an Org-mode file. When that is the case, the command
+`org-agenda-diary-entry' will be bound to the key given here, by default
+`i'. In the calendar, `i' normally adds entries to `diary-file'. So
+if you want to continue doing this, you need to change this to a different
+key."
+ :group 'org-agenda
+ :type 'sexp)
+
+(defcustom org-agenda-diary-file 'diary-file
+ "File to which to add new entries with the `i' key in agenda and calendar.
+When this is the symbol `diary-file', the functionality in the Emacs
+calendar will be used to add entries to the `diary-file'. But when this
+points to a file, `org-agenda-diary-entry' will be used instead."
+ :group 'org-agenda
+ :type '(choice
+ (const :tag "The standard Emacs diary file" diary-file)
+ (file :tag "Special Org file diary entries")))
+
+(eval-after-load "calendar"
+ '(progn
+ (org-defkey calendar-mode-map org-calendar-to-agenda-key
+ 'org-calendar-goto-agenda)
+ (org-defkey calendar-mode-map org-calendar-agenda-action-key
+ 'org-agenda-action)
+ (add-hook 'calendar-mode-hook
+ (lambda ()
+ (unless (eq org-agenda-diary-file 'diary-file)
+ (define-key calendar-mode-map
+ org-calendar-insert-diary-entry-key
+ 'org-agenda-diary-entry))))))
+
+(defgroup org-latex nil
+ "Options for embedding LaTeX code into Org-mode."
+ :tag "Org LaTeX"
+ :group 'org)
+
+(defcustom org-format-latex-options
+ '(:foreground default :background default :scale 1.0
+ :html-foreground "Black" :html-background "Transparent"
+ :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
+ "Options for creating images from LaTeX fragments.
+This is a property list with the following properties:
+:foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
+ `default' means use the foreground of the default face.
+:background the background color, or \"Transparent\".
+ `default' means use the background of the default face.
+:scale a scaling factor for the size of the images, to get more pixels
+:html-foreground, :html-background, :html-scale
+ the same numbers for HTML export.
+:matchers a list indicating which matchers should be used to
+ find LaTeX fragments. Valid members of this list are:
+ \"begin\" find environments
+ \"$1\" find single characters surrounded by $.$
+ \"$\" find math expressions surrounded by $...$
+ \"$$\" find math expressions surrounded by $$....$$
+ \"\\(\" find math expressions surrounded by \\(...\\)
+ \"\\ [\" find math expressions surrounded by \\ [...\\]"
+ :group 'org-latex
+ :type 'plist)
+
+(defcustom org-format-latex-signal-error t
+ "Non-nil means signal an error when image creation of LaTeX snippets fails.
+When nil, just push out a message."
+ :group 'org-latex
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-latex-to-mathml-jar-file nil
+ "Value of\"%j\" in `org-latex-to-mathml-convert-command'.
+Use this to specify additional executable file say a jar file.
+
+When using MathToWeb as the converter, specify the full-path to
+your mathtoweb.jar file."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (file :tag "JAR file" :must-match t)))
+
+(defcustom org-latex-to-mathml-convert-command nil
+ "Command to convert LaTeX fragments to MathML.
+Replace format-specifiers in the command as noted below and use
+`shell-command' to convert LaTeX to MathML.
+%j: Executable file in fully expanded form as specified by
+ `org-latex-to-mathml-jar-file'.
+%I: Input LaTeX file in fully expanded form
+%o: Output MathML file
+This command is used by `org-create-math-formula'.
+
+When using MathToWeb as the converter, set this to
+\"java -jar %j -unicode -force -df %o %I\"."
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (string :tag "\nShell command")))
+
+(defcustom org-latex-create-formula-image-program 'dvipng
+ "Program to convert LaTeX fragments with.
+
+dvipng Process the LaTeX fragments to dvi file, then convert
+ dvi files to png files using dvipng.
+ This will also include processing of non-math environments.
+imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
+ to convert pdf files to png files"
+ :group 'org-latex
+ :version "24.1"
+ :type '(choice
+ (const :tag "dvipng" dvipng)
+ (const :tag "imagemagick" imagemagick)))
+
+(defcustom org-latex-preview-ltxpng-directory "ltxpng/"
+ "Path to store latex preview images. A relative path here creates many
+ directories relative to the processed org files paths. An absolute path
+ puts all preview images at the same place."
+ :group 'org-latex
+ :version "24.3"
+ :type 'string)
+
+(defun org-format-latex-mathml-available-p ()
+ "Return t if `org-latex-to-mathml-convert-command' is usable."
+ (save-match-data
+ (when (and (boundp 'org-latex-to-mathml-convert-command)
+ org-latex-to-mathml-convert-command)
+ (let ((executable (car (split-string
+ org-latex-to-mathml-convert-command))))
+ (when (executable-find executable)
+ (if (string-match
+ "%j" org-latex-to-mathml-convert-command)
+ (file-readable-p org-latex-to-mathml-jar-file)
+ t))))))
+
+(defcustom org-format-latex-header "\\documentclass{article}
+\\usepackage[usenames]{color}
+\\usepackage{amsmath}
+\\usepackage[mathscr]{eucal}
+\\pagestyle{empty} % do not remove
+\[PACKAGES]
+\[DEFAULT-PACKAGES]
+% The settings below are copied from fullpage.sty
+\\setlength{\\textwidth}{\\paperwidth}
+\\addtolength{\\textwidth}{-3cm}
+\\setlength{\\oddsidemargin}{1.5cm}
+\\addtolength{\\oddsidemargin}{-2.54cm}
+\\setlength{\\evensidemargin}{\\oddsidemargin}
+\\setlength{\\textheight}{\\paperheight}
+\\addtolength{\\textheight}{-\\headheight}
+\\addtolength{\\textheight}{-\\headsep}
+\\addtolength{\\textheight}{-\\footskip}
+\\addtolength{\\textheight}{-3cm}
+\\setlength{\\topmargin}{1.5cm}
+\\addtolength{\\topmargin}{-2.54cm}"
+ "The document header used for processing LaTeX fragments.
+It is imperative that this header make sure that no page number
+appears on the page. The package defined in the variables
+`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist'
+will either replace the placeholder \"[PACKAGES]\" in this header, or they
+will be appended."
+ :group 'org-latex
+ :type 'string)
+
+(defvar org-format-latex-header-extra nil)
+
+(defun org-set-packages-alist (var val)
+ "Set the packages alist and make sure it has 3 elements per entry."
+ (set var (mapcar (lambda (x)
+ (if (and (consp x) (= (length x) 2))
+ (list (car x) (nth 1 x) t)
+ x))
+ val)))
+
+(defun org-get-packages-alist (var)
+
+ "Get the packages alist and make sure it has 3 elements per entry."
+ (mapcar (lambda (x)
+ (if (and (consp x) (= (length x) 2))
+ (list (car x) (nth 1 x) t)
+ x))
+ (default-value var)))
+
+;; The following variables are defined here because is it also used
+;; when formatting latex fragments. Originally it was part of the
+;; LaTeX exporter, which is why the name includes "export".
+(defcustom org-export-latex-default-packages-alist
+ '(("AUTO" "inputenc" t)
+ ("T1" "fontenc" t)
+ ("" "fixltx2e" nil)
+ ("" "graphicx" t)
+ ("" "longtable" nil)
+ ("" "float" nil)
+ ("" "wrapfig" nil)
+ ("" "soul" t)
+ ("" "textcomp" t)
+ ("" "marvosym" t)
+ ("" "wasysym" t)
+ ("" "latexsym" t)
+ ("" "amssymb" t)
+ ("" "hyperref" nil)
+ "\\tolerance=1000"
+ )
+ "Alist of default packages to be inserted in the header.
+Change this only if one of the packages here causes an incompatibility
+with another package you are using.
+The packages in this list are needed by one part or another of Org-mode
+to function properly.
+
+- inputenc, fontenc: for basic font and character selection
+- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used
+ for interpreting the entities in `org-entities'. You can skip some of these
+ packages if you don't use any of the symbols in it.
+- graphicx: for including images
+- float, wrapfig: for figure placement
+- longtable: for long tables
+- hyperref: for cross references
+
+Therefore you should not modify this variable unless you know what you
+are doing. The one reason to change it anyway is that you might be loading
+some other package that conflicts with one of the default packages.
+Each cell is of the format \( \"options\" \"package\" snippet-flag\).
+If SNIPPET-FLAG is t, the package also needs to be included when
+compiling LaTeX snippets into images for inclusion into HTML."
+ :group 'org-export-latex
+ :set 'org-set-packages-alist
+ :get 'org-get-packages-alist
+ :version "24.1"
+ :type '(repeat
+ (choice
+ (list :tag "options/package pair"
+ (string :tag "options")
+ (string :tag "package")
+ (boolean :tag "Snippet"))
+ (string :tag "A line of LaTeX"))))
+
+(defcustom org-export-latex-packages-alist nil
+ "Alist of packages to be inserted in every LaTeX header.
+These will be inserted after `org-export-latex-default-packages-alist'.
+Each cell is of the format \( \"options\" \"package\" snippet-flag \).
+SNIPPET-FLAG, when t, indicates that this package is also needed when
+turning LaTeX snippets into images for inclusion into HTML.
+Make sure that you only list packages here which:
+- you want in every file
+- do not conflict with the default packages in
+ `org-export-latex-default-packages-alist'
+- do not conflict with the setup in `org-format-latex-header'."
+ :group 'org-export-latex
+ :set 'org-set-packages-alist
+ :get 'org-get-packages-alist
+ :type '(repeat
+ (choice
+ (list :tag "options/package pair"
+ (string :tag "options")
+ (string :tag "package")
+ (boolean :tag "Snippet"))
+ (string :tag "A line of LaTeX"))))
+
+
+(defgroup org-appearance nil
+ "Settings for Org-mode appearance."
+ :tag "Org Appearance"
+ :group 'org)
+
+(defcustom org-level-color-stars-only nil
+ "Non-nil means fontify only the stars in each headline.
+When nil, the entire headline is fontified.
+Changing it requires restart of `font-lock-mode' to become effective
+also in regions already fontified."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-hide-leading-stars nil
+ "Non-nil means hide the first N-1 stars in a headline.
+This works by using the face `org-hide' for these stars. This
+face is white for a light background, and black for a dark
+background. You may have to customize the face `org-hide' to
+make this work.
+Changing it requires restart of `font-lock-mode' to become effective
+also in regions already fontified.
+You may also set this on a per-file basis by adding one of the following
+lines to the buffer:
+
+ #+STARTUP: hidestars
+ #+STARTUP: showstars"
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-hidden-keywords nil
+ "List of symbols corresponding to keywords to be hidden the org buffer.
+For example, a value '(title) for this list will make the document's title
+appear in the buffer without the initial #+TITLE: keyword."
+ :group 'org-appearance
+ :version "24.1"
+ :type '(set (const :tag "#+AUTHOR" author)
+ (const :tag "#+DATE" date)
+ (const :tag "#+EMAIL" email)
+ (const :tag "#+TITLE" title)))
+
+(defcustom org-custom-properties nil
+ "List of properties (as strings) with a special meaning.
+The default use of these custom properties is to let the user
+hide them with `org-toggle-custom-properties-visibility'."
+ :group 'org-properties
+ :group 'org-appearance
+ :version "24.3"
+ :type '(repeat (string :tag "Property Name")))
+
+(defcustom org-fontify-done-headline nil
+ "Non-nil means change the face of a headline if it is marked DONE.
+Normally, only the TODO/DONE keyword indicates the state of a headline.
+When this is non-nil, the headline after the keyword is set to the
+`org-headline-done' as an additional indication."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-fontify-emphasized-text t
+ "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
+Changing this variable requires a restart of Emacs to take effect."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-fontify-whole-heading-line nil
+ "Non-nil means fontify the whole line for headings.
+This is useful when setting a background color for the
+org-level-* faces."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-highlight-latex-fragments-and-specials nil
+ "Non-nil means fontify what is treated specially by the exporters."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-hide-emphasis-markers nil
+ "Non-nil mean font-lock should hide the emphasis marker characters."
+ :group 'org-appearance
+ :type 'boolean)
+
+(defcustom org-pretty-entities nil
+ "Non-nil means show entities as UTF8 characters.
+When nil, the \\name form remains in the buffer."
+ :group 'org-appearance
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-pretty-entities-include-sub-superscripts t
+ "Non-nil means, pretty entity display includes formatting sub/superscripts."
+ :group 'org-appearance
+ :version "24.1"
+ :type 'boolean)
+
+(defvar org-emph-re nil
+ "Regular expression for matching emphasis.
+After a match, the match groups contain these elements:
+0 The match of the full regular expression, including the characters
+ before and after the proper match
+1 The character before the proper match, or empty at beginning of line
+2 The proper match, including the leading and trailing markers
+3 The leading marker like * or /, indicating the type of highlighting
+4 The text between the emphasis markers, not including the markers
+5 The character after the match, empty at the end of a line")
+(defvar org-verbatim-re nil
+ "Regular expression for matching verbatim text.")
+(defvar org-emphasis-regexp-components) ; defined just below
+(defvar org-emphasis-alist) ; defined just below
+(defun org-set-emph-re (var val)
+ "Set variable and compute the emphasis regular expression."
+ (set var val)
+ (when (and (boundp 'org-emphasis-alist)
+ (boundp 'org-emphasis-regexp-components)
+ org-emphasis-alist org-emphasis-regexp-components)
+ (let* ((e org-emphasis-regexp-components)
+ (pre (car e))
+ (post (nth 1 e))
+ (border (nth 2 e))
+ (body (nth 3 e))
+ (nl (nth 4 e))
+ (body1 (concat body "*?"))
+ (markers (mapconcat 'car org-emphasis-alist ""))
+ (vmarkers (mapconcat
+ (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
+ org-emphasis-alist "")))
+ ;; make sure special characters appear at the right position in the class
+ (if (string-match "\\^" markers)
+ (setq markers (concat (replace-match "" t t markers) "^")))
+ (if (string-match "-" markers)
+ (setq markers (concat (replace-match "" t t markers) "-")))
+ (if (string-match "\\^" vmarkers)
+ (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
+ (if (string-match "-" vmarkers)
+ (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
+ (if (> nl 0)
+ (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
+ (int-to-string nl) "\\}")))
+ ;; Make the regexp
+ (setq org-emph-re
+ (concat "\\([" pre "]\\|^\\)"
+ "\\("
+ "\\([" markers "]\\)"
+ "\\("
+ "[^" border "]\\|"
+ "[^" border "]"
+ body1
+ "[^" border "]"
+ "\\)"
+ "\\3\\)"
+ "\\([" post "]\\|$\\)"))
+ (setq org-verbatim-re
+ (concat "\\([" pre "]\\|^\\)"
+ "\\("
+ "\\([" vmarkers "]\\)"
+ "\\("
+ "[^" border "]\\|"
+ "[^" border "]"
+ body1
+ "[^" border "]"
+ "\\)"
+ "\\3\\)"
+ "\\([" post "]\\|$\\)")))))
+
+(defcustom org-emphasis-regexp-components
+ '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
+ "Components used to build the regular expression for emphasis.
+This is a list with five entries. Terminology: In an emphasis string
+like \" *strong word* \", we call the initial space PREMATCH, the final
+space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
+and \"trong wor\" is the body. The different components in this variable
+specify what is allowed/forbidden in each part:
+
+pre Chars allowed as prematch. Beginning of line will be allowed too.
+post Chars allowed as postmatch. End of line will be allowed too.
+border The chars *forbidden* as border characters.
+body-regexp A regexp like \".\" to match a body character. Don't use
+ non-shy groups here, and don't allow newline here.
+newline The maximum number of newlines allowed in an emphasis exp.
+
+Use customize to modify this, or restart Emacs after changing it."
+ :group 'org-appearance
+ :set 'org-set-emph-re
+ :type '(list
+ (sexp :tag "Allowed chars in pre ")
+ (sexp :tag "Allowed chars in post ")
+ (sexp :tag "Forbidden chars in border ")
+ (sexp :tag "Regexp for body ")
+ (integer :tag "number of newlines allowed")
+ (option (boolean :tag "Please ignore this button"))))
+
+(defcustom org-emphasis-alist
+ `(("*" bold "<b>" "</b>")
+ ("/" italic "<i>" "</i>")
+ ("_" underline "<span style=\"text-decoration:underline;\">" "</span>")
+ ("=" org-code "<code>" "</code>" verbatim)
+ ("~" org-verbatim "<code>" "</code>" verbatim)
+ ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))
+ "<del>" "</del>")
+ )
+ "Special syntax for emphasized text.
+Text starting and ending with a special character will be emphasized, for
+example *bold*, _underlined_ and /italic/. This variable sets the marker
+characters, the face to be used by font-lock for highlighting in Org-mode
+Emacs buffers, and the HTML tags to be used for this.
+For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
+For DocBook export, see the variable `org-export-docbook-emphasis-alist'.
+Use customize to modify this, or restart Emacs after changing it."
+ :group 'org-appearance
+ :set 'org-set-emph-re
+ :type '(repeat
+ (list
+ (string :tag "Marker character")
+ (choice
+ (face :tag "Font-lock-face")
+ (plist :tag "Face property list"))
+ (string :tag "HTML start tag")
+ (string :tag "HTML end tag")
+ (option (const verbatim)))))
+
+(defvar org-protecting-blocks
+ '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
+ "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
+This is needed for font-lock setup.")
+
+;;; Miscellaneous options
+
+(defgroup org-completion nil
+ "Completion in Org-mode."
+ :tag "Org Completion"
+ :group 'org)
+
+(defcustom org-completion-use-ido nil
+ "Non-nil means use ido completion wherever possible.
+Note that `ido-mode' must be active for this variable to be relevant.
+If you decide to turn this variable on, you might well want to turn off
+`org-outline-path-complete-in-steps'.
+See also `org-completion-use-iswitchb'."
+ :group 'org-completion
+ :type 'boolean)
+
+(defcustom org-completion-use-iswitchb nil
+ "Non-nil means use iswitchb completion wherever possible.
+Note that `iswitchb-mode' must be active for this variable to be relevant.
+If you decide to turn this variable on, you might well want to turn off
+`org-outline-path-complete-in-steps'.
+Note that this variable has only an effect if `org-completion-use-ido' is nil."
+ :group 'org-completion
+ :type 'boolean)
+
+(defcustom org-completion-fallback-command 'hippie-expand
+ "The expansion command called by \\[pcomplete] in normal context.
+Normal means, no org-mode-specific context."
+ :group 'org-completion
+ :type 'function)
+
+;;; Functions and variables from their packages
+;; Declared here to avoid compiler warnings
+
+;; XEmacs only
+(defvar outline-mode-menu-heading)
+(defvar outline-mode-menu-show)
+(defvar outline-mode-menu-hide)
+(defvar zmacs-regions) ; XEmacs regions
+
+;; Emacs only
+(defvar mark-active)
+
+;; Various packages
+(declare-function calendar-absolute-from-iso "cal-iso" (date))
+(declare-function calendar-forward-day "cal-move" (arg))
+(declare-function calendar-goto-date "cal-move" (date))
+(declare-function calendar-goto-today "cal-move" ())
+(declare-function calendar-iso-from-absolute "cal-iso" (date))
+(defvar calc-embedded-close-formula)
+(defvar calc-embedded-open-formula)
+(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function cdlatex-compute-tables "ext:cdlatex" ())
+(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
+(defvar font-lock-unfontify-region-function)
+(declare-function iswitchb-read-buffer "iswitchb"
+ (prompt &optional default require-match start matches-set))
+(defvar iswitchb-temp-buflist)
+(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
+(defvar org-agenda-tags-todo-honor-ignore-options)
+(declare-function org-agenda-skip "org-agenda" ())
+(declare-function
+ org-agenda-format-item "org-agenda"
+ (extra txt &optional category tags dotime noprefix remove-re habitp))
+(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
+(declare-function org-agenda-change-all-lines "org-agenda"
+ (newhead hdmarker &optional fixface just-this))
+(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
+(declare-function org-agenda-maybe-redo "org-agenda" ())
+(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda"
+ (beg end))
+(declare-function org-agenda-copy-local-variable "org-agenda" (var))
+(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+ "org-agenda" (&optional end))
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-indent-mode "org-indent" (&optional arg))
+(declare-function parse-time-string "parse-time" (string))
+(declare-function org-attach-reveal "org-attach" (&optional if-exists))
+(declare-function org-export-latex-fix-inputenc "org-latex" ())
+(declare-function orgtbl-send-table "org-table" (&optional maybe))
+(defvar remember-data-file)
+(defvar texmathp-why)
+(declare-function speedbar-line-directory "speedbar" (&optional depth))
+(declare-function table--at-cell-p "table" (position &optional object at-column))
+
+(defvar w3m-current-url)
+(defvar w3m-current-title)
+
+(defvar org-latex-regexps)
+
+;;; Autoload and prepare some org modules
+
+;; Some table stuff that needs to be defined here, because it is used
+;; by the functions setting up org-mode or checking for table context.
+
+(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
+ "Detect an org-type or table-type table.")
+(defconst org-table-line-regexp "^[ \t]*|"
+ "Detect an org-type table line.")
+(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
+ "Detect an org-type table line.")
+(defconst org-table-hline-regexp "^[ \t]*|-"
+ "Detect an org-type table hline.")
+(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
+ "Detect a table-type table hline.")
+(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
+ "Detect the first line outside a table when searching from within it.
+This works for both table types.")
+
+;; Autoload the functions in org-table.el that are needed by functions here.
+
+(eval-and-compile
+ (org-autoload "org-table"
+ '(org-table-align org-table-begin org-table-blank-field
+ org-table-convert org-table-convert-region org-table-copy-down
+ org-table-copy-region org-table-create
+ org-table-create-or-convert-from-region
+ org-table-create-with-table.el org-table-current-dline
+ org-table-cut-region org-table-delete-column org-table-edit-field
+ org-table-edit-formulas org-table-end org-table-eval-formula
+ org-table-export org-table-field-info
+ org-table-get-stored-formulas org-table-goto-column
+ org-table-hline-and-move org-table-import org-table-insert-column
+ org-table-insert-hline org-table-insert-row org-table-iterate
+ org-table-justify-field-maybe org-table-kill-row
+ org-table-maybe-eval-formula org-table-maybe-recalculate-line
+ org-table-move-column org-table-move-column-left
+ org-table-move-column-right org-table-move-row
+ org-table-move-row-down org-table-move-row-up
+ org-table-next-field org-table-next-row org-table-paste-rectangle
+ org-table-previous-field org-table-recalculate
+ org-table-rotate-recalc-marks org-table-sort-lines org-table-sum
+ org-table-toggle-coordinate-overlays
+ org-table-toggle-formula-debugger org-table-wrap-region
+ orgtbl-mode turn-on-orgtbl org-table-to-lisp
+ orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex
+ orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo)))
+
+(defun org-at-table-p (&optional table-type)
+ "Return t if the cursor is inside an org-type table.
+If TABLE-TYPE is non-nil, also check for table.el-type tables."
+ (if org-enable-table-editor
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at (if table-type org-table-any-line-regexp
+ org-table-line-regexp)))
+ nil))
+(defsubst org-table-p () (org-at-table-p))
+
+(defun org-at-table.el-p ()
+ "Return t if and only if we are at a table.el table."
+ (and (org-at-table-p 'any)
+ (save-excursion
+ (goto-char (org-table-begin 'any))
+ (looking-at org-table1-hline-regexp))))
+(defun org-table-recognize-table.el ()
+ "If there is a table.el table nearby, recognize it and move into it."
+ (if org-table-tab-recognizes-table.el
+ (if (org-at-table.el-p)
+ (progn
+ (beginning-of-line 1)
+ (if (looking-at org-table-dataline-regexp)
+ nil
+ (if (looking-at org-table1-hline-regexp)
+ (progn
+ (beginning-of-line 2)
+ (if (looking-at org-table-any-border-regexp)
+ (beginning-of-line -1)))))
+ (if (re-search-forward "|" (org-table-end t) t)
+ (progn
+ (require 'table)
+ (if (table--at-cell-p (point))
+ t
+ (message "recognizing table.el table...")
+ (table-recognize-table)
+ (message "recognizing table.el table...done")))
+ (error "This should not happen"))
+ t)
+ nil)
+ nil))
+
+(defun org-at-table-hline-p ()
+ "Return t if the cursor is inside a hline in a table."
+ (if org-enable-table-editor
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-table-hline-regexp))
+ nil))
+
+(defvar org-table-clean-did-remove-column nil)
+
+(defun org-table-map-tables (function &optional quietly)
+ "Apply FUNCTION to the start of all tables in the buffer."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward org-table-any-line-regexp nil t)
+ (unless quietly
+ (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))))
+ (beginning-of-line 1)
+ (when (and (looking-at org-table-line-regexp)
+ ;; Exclude tables in src/example/verbatim/clocktable blocks
+ (not (org-in-block-p '("src" "example"))))
+ (save-excursion (funcall function))
+ (or (looking-at org-table-line-regexp)
+ (forward-char 1)))
+ (re-search-forward org-table-any-border-regexp nil 1))))
+ (unless quietly (message "Mapping tables: done")))
+
+;; Declare and autoload functions from org-exp.el & Co
+
+(declare-function org-default-export-plist "org-exp")
+(declare-function org-infile-export-plist "org-exp")
+(declare-function org-get-current-options "org-exp")
+(eval-and-compile
+ (org-autoload "org-exp"
+ '(org-export org-export-visible
+ org-insert-export-options-template
+ org-table-clean-before-export))
+ (org-autoload "org-ascii"
+ '(org-export-as-ascii org-export-ascii-preprocess
+ org-export-as-ascii-to-buffer org-replace-region-by-ascii
+ org-export-region-as-ascii))
+ (org-autoload "org-latex"
+ '(org-export-as-latex-batch org-export-as-latex-to-buffer
+ org-replace-region-by-latex org-export-region-as-latex
+ org-export-as-latex org-export-as-pdf
+ org-export-as-pdf-and-open))
+ (org-autoload "org-html"
+ '(org-export-as-html-and-open
+ org-export-as-html-batch org-export-as-html-to-buffer
+ org-replace-region-by-html org-export-region-as-html
+ org-export-as-html))
+ (org-autoload "org-docbook"
+ '(org-export-as-docbook-batch org-export-as-docbook-to-buffer
+ org-replace-region-by-docbook org-export-region-as-docbook
+ org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open
+ org-export-as-docbook))
+ (org-autoload "org-icalendar"
+ '(org-export-icalendar-this-file
+ org-export-icalendar-all-agenda-files
+ org-export-icalendar-combine-agenda-files))
+ (org-autoload "org-xoxo" '(org-export-as-xoxo))
+ (org-autoload "org-beamer" '(org-beamer-mode org-beamer-sectioning)))
+
+;; Declare and autoload functions from org-agenda.el
+
+(eval-and-compile
+ (org-autoload "org-agenda"
+ '(org-agenda org-agenda-list org-search-view
+ org-todo-list org-tags-view org-agenda-list-stuck-projects
+ org-diary org-agenda-to-appt
+ org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
+
+;; Autoload org-remember
+
+(eval-and-compile
+ (org-autoload "org-remember"
+ '(org-remember-insinuate org-remember-annotation
+ org-remember-apply-template org-remember org-remember-handler)))
+
+(eval-and-compile
+ (org-autoload "org-capture"
+ '(org-capture org-capture-insert-template-here
+ org-capture-import-remember-templates)))
+
+;; Autoload org-clock.el
+
+(declare-function org-clock-save-markers-for-cut-and-paste "org-clock"
+ (beg end))
+(declare-function org-clock-update-mode-line "org-clock" ())
+(declare-function org-resolve-clocks "org-clock"
+ (&optional also-non-dangling-p prompt last-valid))
+(defvar org-clock-start-time)
+(defvar org-clock-marker (make-marker)
+ "Marker recording the last clock-in.")
+(defvar org-clock-hd-marker (make-marker)
+ "Marker recording the last clock-in, but the headline position.")
+(defvar org-clock-heading ""
+ "The heading of the current clock entry.")
+(defun org-clock-is-active ()
+ "Return non-nil if clock is currently running.
+The return value is actually the clock marker."
+ (marker-buffer org-clock-marker))
+
+(eval-and-compile
+ (org-autoload
+ "org-clock"
+ '(org-clock-in org-clock-out org-clock-cancel
+ org-clock-goto org-clock-sum org-clock-display
+ org-clock-remove-overlays org-clock-report
+ org-clocktable-shift org-dblock-write:clocktable
+ org-get-clocktable org-resolve-clocks)))
+
+(defun org-clock-update-time-maybe ()
+ "If this is a CLOCK line, update it and return t.
+Otherwise, return nil."
+ (interactive)
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (when (looking-at org-clock-string)
+ (let ((re (concat "[ \t]*" org-clock-string
+ " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
+ "\\([ \t]*=>.*\\)?\\)?"))
+ ts te h m s neg)
+ (cond
+ ((not (looking-at re))
+ nil)
+ ((not (match-end 2))
+ (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
+ (> org-clock-marker (point))
+ (<= org-clock-marker (point-at-eol)))
+ ;; The clock is running here
+ (setq org-clock-start-time
+ (apply 'encode-time
+ (org-parse-time-string (match-string 1))))
+ (org-clock-update-mode-line)))
+ (t
+ (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
+ (end-of-line 1)
+ (setq ts (match-string 1)
+ te (match-string 3))
+ (setq s (- (org-float-time
+ (apply 'encode-time (org-parse-time-string te)))
+ (org-float-time
+ (apply 'encode-time (org-parse-time-string ts))))
+ neg (< s 0)
+ s (abs s)
+ h (floor (/ s 3600))
+ s (- s (* 3600 h))
+ m (floor (/ s 60))
+ s (- s (* 60 s)))
+ (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
+ t))))))
+
+(defun org-check-running-clock ()
+ "Check if the current buffer contains the running clock.
+If yes, offer to stop it and to save the buffer with the changes."
+ (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
+ (y-or-n-p (format "Clock-out in buffer %s before killing it? "
+ (buffer-name))))
+ (org-clock-out)
+ (when (y-or-n-p "Save changed buffer?")
+ (save-buffer))))
+
+(defun org-clocktable-try-shift (dir n)
+ "Check if this line starts a clock table, if yes, shift the time block."
+ (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
+ (org-clocktable-shift dir n)))
+
+;; Autoload org-timer.el
+
+(eval-and-compile
+ (org-autoload
+ "org-timer"
+ '(org-timer-start org-timer org-timer-item
+ org-timer-change-times-in-region
+ org-timer-set-timer
+ org-timer-reset-timers
+ org-timer-show-remaining-time)))
+
+;; Autoload org-feed.el
+
+(eval-and-compile
+ (org-autoload
+ "org-feed"
+ '(org-feed-update org-feed-update-all org-feed-goto-inbox)))
+
+
+;; Autoload org-indent.el
+
+;; Define the variable already here, to make sure we have it.
+(defvar org-indent-mode nil
+ "Non-nil if Org-Indent mode is enabled.
+Use the command `org-indent-mode' to change this variable.")
+
+(eval-and-compile
+ (org-autoload
+ "org-indent"
+ '(org-indent-mode)))
+
+;; Autoload org-mobile.el
+
+(eval-and-compile
+ (org-autoload
+ "org-mobile"
+ '(org-mobile-push org-mobile-pull org-mobile-create-sumo-agenda)))
+
+;; Autoload archiving code
+;; The stuff that is needed for cycling and tags has to be defined here.
+
+(defgroup org-archive nil
+ "Options concerning archiving in Org-mode."
+ :tag "Org Archive"
+ :group 'org-structure)
+
+(defcustom org-archive-location "%s_archive::"
+ "The location where subtrees should be archived.
+
+The value of this variable is a string, consisting of two parts,
+separated by a double-colon. The first part is a filename and
+the second part is a headline.
+
+When the filename is omitted, archiving happens in the same file.
+%s in the filename will be replaced by the current file
+name (without the directory part). Archiving to a different file
+is useful to keep archived entries from contributing to the
+Org-mode Agenda.
+
+The archived entries will be filed as subtrees of the specified
+headline. When the headline is omitted, the subtrees are simply
+filed away at the end of the file, as top-level entries. Also in
+the heading you can use %s to represent the file name, this can be
+useful when using the same archive for a number of different files.
+
+Here are a few examples:
+\"%s_archive::\"
+ If the current file is Projects.org, archive in file
+ Projects.org_archive, as top-level trees. This is the default.
+
+\"::* Archived Tasks\"
+ Archive in the current file, under the top-level headline
+ \"* Archived Tasks\".
+
+\"~/org/archive.org::\"
+ Archive in file ~/org/archive.org (absolute path), as top-level trees.
+
+\"~/org/archive.org::* From %s\"
+ Archive in file ~/org/archive.org (absolute path), under headlines
+ \"From FILENAME\" where file name is the current file name.
+
+\"~/org/datetree.org::datetree/* Finished Tasks\"
+ The \"datetree/\" string is special, signifying to archive
+ items to the datetree. Items are placed in either the CLOSED
+ date of the item, or the current date if there is no CLOSED date.
+ The heading will be a subentry to the current date. There doesn't
+ need to be a heading, but there always needs to be a slash after
+ datetree. For example, to store archived items directly in the
+ datetree, use \"~/org/datetree.org::datetree/\".
+
+\"basement::** Finished Tasks\"
+ Archive in file ./basement (relative path), as level 3 trees
+ below the level 2 heading \"** Finished Tasks\".
+
+You may set this option on a per-file basis by adding to the buffer a
+line like
+
+#+ARCHIVE: basement::** Finished Tasks
+
+You may also define it locally for a subtree by setting an ARCHIVE property
+in the entry. If such a property is found in an entry, or anywhere up
+the hierarchy, it will be used."
+ :group 'org-archive
+ :type 'string)
+
+(defcustom org-archive-tag "ARCHIVE"
+ "The tag that marks a subtree as archived.
+An archived subtree does not open during visibility cycling, and does
+not contribute to the agenda listings.
+After changing this, font-lock must be restarted in the relevant buffers to
+get the proper fontification."
+ :group 'org-archive
+ :group 'org-keywords
+ :type 'string)
+
+(defcustom org-agenda-skip-archived-trees t
+ "Non-nil means the agenda will skip any items located in archived trees.
+An archived tree is a tree marked with the tag ARCHIVE. The use of this
+variable is no longer recommended, you should leave it at the value t.
+Instead, use the key `v' to cycle the archives-mode in the agenda."
+ :group 'org-archive
+ :group 'org-agenda-skip
+ :type 'boolean)
+
+(defcustom org-columns-skip-archived-trees t
+ "Non-nil means ignore archived trees when creating column view."
+ :group 'org-archive
+ :group 'org-properties
+ :type 'boolean)
+
+(defcustom org-cycle-open-archived-trees nil
+ "Non-nil means `org-cycle' will open archived trees.
+An archived tree is a tree marked with the tag ARCHIVE.
+When nil, archived trees will stay folded. You can still open them with
+normal outline commands like `show-all', but not with the cycling commands."
+ :group 'org-archive
+ :group 'org-cycle
+ :type 'boolean)
+
+(defcustom org-sparse-tree-open-archived-trees nil
+ "Non-nil means sparse tree construction shows matches in archived trees.
+When nil, matches in these trees are highlighted, but the trees are kept in
+collapsed state."
+ :group 'org-archive
+ :group 'org-sparse-trees
+ :type 'boolean)
+
+(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline
+ "The default date type when building a sparse tree.
+When this is nil, a date is a scheduled or a deadline timestamp.
+Otherwise, these types are allowed:
+
+ all: all timestamps
+ active: only active timestamps (<...>)
+ inactive: only inactive timestamps (<...)
+ scheduled: only scheduled timestamps
+ deadline: only deadline timestamps"
+ :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+ (const :tag "All timestamps" all)
+ (const :tag "Only active timestamps" active)
+ (const :tag "Only inactive timestamps" inactive)
+ (const :tag "Only scheduled timestamps" scheduled)
+ (const :tag "Only deadline timestamps" deadline))
+ :version "24.3"
+ :group 'org-sparse-trees)
+
+(defun org-cycle-hide-archived-subtrees (state)
+ "Re-hide all archived subtrees after a visibility state change."
+ (when (and (not org-cycle-open-archived-trees)
+ (not (memq state '(overview folded))))
+ (save-excursion
+ (let* ((globalp (memq state '(contents all)))
+ (beg (if globalp (point-min) (point)))
+ (end (if globalp (point-max) (org-end-of-subtree t))))
+ (org-hide-archived-subtrees beg end)
+ (goto-char beg)
+ (if (looking-at (concat ".*:" org-archive-tag ":"))
+ (message "%s" (substitute-command-keys
+ "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
+
+(defun org-force-cycle-archived ()
+ "Cycle subtree even if it is archived."
+ (interactive)
+ (setq this-command 'org-cycle)
+ (let ((org-cycle-open-archived-trees t))
+ (call-interactively 'org-cycle)))
+
+(defun org-hide-archived-subtrees (beg end)
+ "Re-hide all archived subtrees after a visibility state change."
+ (save-excursion
+ (let* ((re (concat ":" org-archive-tag ":")))
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (when (org-at-heading-p)
+ (org-flag-subtree t)
+ (org-end-of-subtree t))))))
+
+(declare-function outline-end-of-heading "outline" ())
+(declare-function outline-flag-region "outline" (from to flag))
+(defun org-flag-subtree (flag)
+ (save-excursion
+ (org-back-to-heading t)
+ (outline-end-of-heading)
+ (outline-flag-region (point)
+ (progn (org-end-of-subtree t) (point))
+ flag)))
+
+(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
+
+(eval-and-compile
+ (org-autoload "org-archive"
+ '(org-add-archive-files org-archive-subtree
+ org-archive-to-archive-sibling org-toggle-archive-tag
+ org-archive-subtree-default
+ org-archive-subtree-default-with-confirmation)))
+
+;; Autoload Column View Code
+
+(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
+(declare-function org-columns-get-format-and-top-level "org-colview" ())
+(declare-function org-columns-compute "org-colview" (property))
+
+(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview")
+ '(org-columns-number-to-string org-columns-get-format-and-top-level
+ org-columns-compute org-agenda-columns org-columns-remove-overlays
+ org-columns org-insert-columns-dblock org-dblock-write:columnview))
+
+;; Autoload ID code
+
+(declare-function org-id-store-link "org-id")
+(declare-function org-id-locations-load "org-id")
+(declare-function org-id-locations-save "org-id")
+(defvar org-id-track-globally)
+(org-autoload "org-id"
+ '(org-id-get-create org-id-new org-id-copy org-id-get
+ org-id-get-with-outline-path-completion
+ org-id-get-with-outline-drilling org-id-store-link
+ org-id-goto org-id-find org-id-store-link))
+
+;; Autoload Plotting Code
+
+(org-autoload "org-plot"
+ '(org-plot/gnuplot))
+
+;;; Variables for pre-computed regular expressions, all buffer local
+
+(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$"
+ "Matches first line of a hidden block.")
+(make-variable-buffer-local 'org-drawer-regexp)
+(defvar org-todo-regexp nil
+ "Matches any of the TODO state keywords.")
+(make-variable-buffer-local 'org-todo-regexp)
+(defvar org-not-done-regexp nil
+ "Matches any of the TODO state keywords except the last one.")
+(make-variable-buffer-local 'org-not-done-regexp)
+(defvar org-not-done-heading-regexp nil
+ "Matches a TODO headline that is not done.")
+(make-variable-buffer-local 'org-not-done-regexp)
+(defvar org-todo-line-regexp nil
+ "Matches a headline and puts TODO state into group 2 if present.")
+(make-variable-buffer-local 'org-todo-line-regexp)
+(defvar org-complex-heading-regexp nil
+ "Matches a headline and puts everything into groups:
+group 1: the stars
+group 2: The todo keyword, maybe
+group 3: Priority cookie
+group 4: True headline
+group 5: Tags")
+(make-variable-buffer-local 'org-complex-heading-regexp)
+(defvar org-complex-heading-regexp-format nil
+ "Printf format to make regexp to match an exact headline.
+This regexp will match the headline of any node which has the
+exact headline text that is put into the format, but may have any
+TODO state, priority and tags.")
+(make-variable-buffer-local 'org-complex-heading-regexp-format)
+(defvar org-todo-line-tags-regexp nil
+ "Matches a headline and puts TODO state into group 2 if present.
+Also put tags into group 4 if tags are present.")
+(make-variable-buffer-local 'org-todo-line-tags-regexp)
+(defvar org-ds-keyword-length 12
+ "Maximum length of the DEADLINE and SCHEDULED keywords.")
+(make-variable-buffer-local 'org-ds-keyword-length)
+(defvar org-deadline-regexp nil
+ "Matches the DEADLINE keyword.")
+(make-variable-buffer-local 'org-deadline-regexp)
+(defvar org-deadline-time-regexp nil
+ "Matches the DEADLINE keyword together with a time stamp.")
+(make-variable-buffer-local 'org-deadline-time-regexp)
+(defvar org-deadline-line-regexp nil
+ "Matches the DEADLINE keyword and the rest of the line.")
+(make-variable-buffer-local 'org-deadline-line-regexp)
+(defvar org-scheduled-regexp nil
+ "Matches the SCHEDULED keyword.")
+(make-variable-buffer-local 'org-scheduled-regexp)
+(defvar org-scheduled-time-regexp nil
+ "Matches the SCHEDULED keyword together with a time stamp.")
+(make-variable-buffer-local 'org-scheduled-time-regexp)
+(defvar org-closed-time-regexp nil
+ "Matches the CLOSED keyword together with a time stamp.")
+(make-variable-buffer-local 'org-closed-time-regexp)
+
+(defvar org-keyword-time-regexp nil
+ "Matches any of the 4 keywords, together with the time stamp.")
+(make-variable-buffer-local 'org-keyword-time-regexp)
+(defvar org-keyword-time-not-clock-regexp nil
+ "Matches any of the 3 keywords, together with the time stamp.")
+(make-variable-buffer-local 'org-keyword-time-not-clock-regexp)
+(defvar org-maybe-keyword-time-regexp nil
+ "Matches a timestamp, possibly preceded by a keyword.")
+(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
+(defvar org-all-time-keywords nil
+ "List of time keywords.")
+(make-variable-buffer-local 'org-all-time-keywords)
+
+(defconst org-plain-time-of-day-regexp
+ (concat
+ "\\(\\<[012]?[0-9]"
+ "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
+ "\\(--?"
+ "\\(\\<[012]?[0-9]"
+ "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
+ "\\)?")
+ "Regular expression to match a plain time or time range.
+Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
+groups carry important information:
+0 the full match
+1 the first time, range or not
+8 the second time, if it is a range.")
+
+(defconst org-plain-time-extension-regexp
+ (concat
+ "\\(\\<[012]?[0-9]"
+ "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
+ "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?")
+ "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
+Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
+groups carry important information:
+0 the full match
+7 hours of duration
+9 minutes of duration")
+
+(defconst org-stamp-time-of-day-regexp
+ (concat
+ "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
+ "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>"
+ "\\(--?"
+ "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
+ "Regular expression to match a timestamp time or time range.
+After a match, the following groups carry important information:
+0 the full match
+1 date plus weekday, for back referencing to make sure both times are on the same day
+2 the first time, range or not
+4 the second time, if it is a range.")
+
+(defconst org-startup-options
+ '(("fold" org-startup-folded t)
+ ("overview" org-startup-folded t)
+ ("nofold" org-startup-folded nil)
+ ("showall" org-startup-folded nil)
+ ("showeverything" org-startup-folded showeverything)
+ ("content" org-startup-folded content)
+ ("indent" org-startup-indented t)
+ ("noindent" org-startup-indented nil)
+ ("hidestars" org-hide-leading-stars t)
+ ("showstars" org-hide-leading-stars nil)
+ ("odd" org-odd-levels-only t)
+ ("oddeven" org-odd-levels-only nil)
+ ("align" org-startup-align-all-tables t)
+ ("noalign" org-startup-align-all-tables nil)
+ ("inlineimages" org-startup-with-inline-images t)
+ ("noinlineimages" org-startup-with-inline-images nil)
+ ("customtime" org-display-custom-times t)
+ ("logdone" org-log-done time)
+ ("lognotedone" org-log-done note)
+ ("nologdone" org-log-done nil)
+ ("lognoteclock-out" org-log-note-clock-out t)
+ ("nolognoteclock-out" org-log-note-clock-out nil)
+ ("logrepeat" org-log-repeat state)
+ ("lognoterepeat" org-log-repeat note)
+ ("nologrepeat" org-log-repeat nil)
+ ("logreschedule" org-log-reschedule time)
+ ("lognotereschedule" org-log-reschedule note)
+ ("nologreschedule" org-log-reschedule nil)
+ ("logredeadline" org-log-redeadline time)
+ ("lognoteredeadline" org-log-redeadline note)
+ ("nologredeadline" org-log-redeadline nil)
+ ("logrefile" org-log-refile time)
+ ("lognoterefile" org-log-refile note)
+ ("nologrefile" org-log-refile nil)
+ ("fninline" org-footnote-define-inline t)
+ ("nofninline" org-footnote-define-inline nil)
+ ("fnlocal" org-footnote-section nil)
+ ("fnauto" org-footnote-auto-label t)
+ ("fnprompt" org-footnote-auto-label nil)
+ ("fnconfirm" org-footnote-auto-label confirm)
+ ("fnplain" org-footnote-auto-label plain)
+ ("fnadjust" org-footnote-auto-adjust t)
+ ("nofnadjust" org-footnote-auto-adjust nil)
+ ("constcgs" constants-unit-system cgs)
+ ("constSI" constants-unit-system SI)
+ ("noptag" org-tag-persistent-alist nil)
+ ("hideblocks" org-hide-block-startup t)
+ ("nohideblocks" org-hide-block-startup nil)
+ ("beamer" org-startup-with-beamer-mode t)
+ ("entitiespretty" org-pretty-entities t)
+ ("entitiesplain" org-pretty-entities nil))
+ "Variable associated with STARTUP options for org-mode.
+Each element is a list of three items: the startup options (as written
+in the #+STARTUP line), the corresponding variable, and the value to set
+this variable to if the option is found. An optional forth element PUSH
+means to push this value onto the list in the variable.")
+
+(defun org-update-property-plist (key val props)
+ "Update PROPS with KEY and VAL."
+ (let* ((appending (string= "+" (substring key (- (length key) 1))))
+ (key (if appending (substring key 0 (- (length key) 1)) key))
+ (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
+ (previous (cdr (assoc key props))))
+ (if appending
+ (cons (cons key (if previous (concat previous " " val) val)) remainder)
+ (cons (cons key val) remainder))))
+
+(defconst org-block-regexp
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+(defconst org-heading-keyword-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline with some keyword.
+This regexp will match the headline of any node which has the
+exact keyword that is put into the format. The keyword isn't in
+any group by default, but the stars and the body are.")
+(defconst org-heading-keyword-maybe-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching an headline, possibly with some keyword.
+This regexp can match any headline with the specified keyword, or
+without a keyword. The keyword isn't in any group by default,
+but the stars and the body are.")
+
+(defun org-set-regexps-and-options ()
+ "Precompute regular expressions for current buffer."
+ (when (derived-mode-p 'org-mode)
+ (org-set-local 'org-todo-kwd-alist nil)
+ (org-set-local 'org-todo-key-alist nil)
+ (org-set-local 'org-todo-key-trigger nil)
+ (org-set-local 'org-todo-keywords-1 nil)
+ (org-set-local 'org-done-keywords nil)
+ (org-set-local 'org-todo-heads nil)
+ (org-set-local 'org-todo-sets nil)
+ (org-set-local 'org-todo-log-states nil)
+ (org-set-local 'org-file-properties nil)
+ (org-set-local 'org-file-tags nil)
+ (let ((re (org-make-options-regexp
+ '("CATEGORY" "TODO" "COLUMNS"
+ "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
+ "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS"
+ "OPTIONS")
+ "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
+ (splitre "[ \t]+")
+ (scripts org-use-sub-superscripts)
+ kwds kws0 kwsa key log value cat arch tags const links hw dws
+ tail sep kws1 prio props ftags drawers beamer-p
+ ext-setup-or-nil setup-contents (start 0))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (or (and ext-setup-or-nil
+ (string-match re ext-setup-or-nil start)
+ (setq start (match-end 0)))
+ (and (setq ext-setup-or-nil nil start 0)
+ (re-search-forward re nil t)))
+ (setq key (upcase (match-string 1 ext-setup-or-nil))
+ value (org-match-string-no-properties 2 ext-setup-or-nil))
+ (if (stringp value) (setq value (org-trim value)))
+ (cond
+ ((equal key "CATEGORY")
+ (setq cat value))
+ ((member key '("SEQ_TODO" "TODO"))
+ (push (cons 'sequence (org-split-string value splitre)) kwds))
+ ((equal key "TYP_TODO")
+ (push (cons 'type (org-split-string value splitre)) kwds))
+ ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
+ ;; general TODO-like setup
+ (push (cons (intern (downcase (match-string 1 key)))
+ (org-split-string value splitre)) kwds))
+ ((equal key "TAGS")
+ (setq tags (append tags (if tags '("\\n") nil)
+ (org-split-string value splitre))))
+ ((equal key "COLUMNS")
+ (org-set-local 'org-columns-default-format value))
+ ((equal key "LINK")
+ (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
+ (push (cons (match-string 1 value)
+ (org-trim (match-string 2 value)))
+ links)))
+ ((equal key "PRIORITIES")
+ (setq prio (org-split-string value " +")))
+ ((equal key "PROPERTY")
+ (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props))))
+ ((equal key "FILETAGS")
+ (when (string-match "\\S-" value)
+ (setq ftags
+ (append
+ ftags
+ (apply 'append
+ (mapcar (lambda (x) (org-split-string x ":"))
+ (org-split-string value)))))))
+ ((equal key "DRAWERS")
+ (setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
+ ((equal key "CONSTANTS")
+ (setq const (append const (org-split-string value splitre))))
+ ((equal key "STARTUP")
+ (let ((opts (org-split-string value splitre))
+ l var val)
+ (while (setq l (pop opts))
+ (when (setq l (assoc l org-startup-options))
+ (setq var (nth 1 l) val (nth 2 l))
+ (if (not (nth 3 l))
+ (set (make-local-variable var) val)
+ (if (not (listp (symbol-value var)))
+ (set (make-local-variable var) nil))
+ (set (make-local-variable var) (symbol-value var))
+ (add-to-list var val))))))
+ ((equal key "ARCHIVE")
+ (setq arch value)
+ (remove-text-properties 0 (length arch)
+ '(face t fontified t) arch))
+ ((equal key "LATEX_CLASS")
+ (setq beamer-p (equal value "beamer")))
+ ((equal key "OPTIONS")
+ (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value)
+ (setq scripts (read (match-string 2 value)))))
+ ((equal key "SETUPFILE")
+ (setq setup-contents (org-file-contents
+ (expand-file-name
+ (org-remove-double-quotes value))
+ 'noerror))
+ (if (not ext-setup-or-nil)
+ (setq ext-setup-or-nil setup-contents start 0)
+ (setq ext-setup-or-nil
+ (concat (substring ext-setup-or-nil 0 start)
+ "\n" setup-contents "\n"
+ (substring ext-setup-or-nil start)))))))
+ ;; search for property blocks
+ (goto-char (point-min))
+ (while (re-search-forward org-block-regexp nil t)
+ (when (equal "PROPERTY" (upcase (match-string 1)))
+ (setq value (replace-regexp-in-string
+ "[\n\r]" " " (match-string 4)))
+ (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
+ (setq props (org-update-property-plist (match-string 1 value)
+ (match-string 2 value)
+ props)))))))
+ (org-set-local 'org-use-sub-superscripts scripts)
+ (when cat
+ (org-set-local 'org-category (intern cat))
+ (push (cons "CATEGORY" cat) props))
+ (when prio
+ (if (< (length prio) 3) (setq prio '("A" "C" "B")))
+ (setq prio (mapcar 'string-to-char prio))
+ (org-set-local 'org-highest-priority (nth 0 prio))
+ (org-set-local 'org-lowest-priority (nth 1 prio))
+ (org-set-local 'org-default-priority (nth 2 prio)))
+ (and props (org-set-local 'org-file-properties (nreverse props)))
+ (and ftags (org-set-local 'org-file-tags
+ (mapcar 'org-add-prop-inherited ftags)))
+ (and drawers (org-set-local 'org-drawers drawers))
+ (and arch (org-set-local 'org-archive-location arch))
+ (and links (setq org-link-abbrev-alist-local (nreverse links)))
+ ;; Process the TODO keywords
+ (unless kwds
+ ;; Use the global values as if they had been given locally.
+ (setq kwds (default-value 'org-todo-keywords))
+ (if (stringp (car kwds))
+ (setq kwds (list (cons org-todo-interpretation
+ (default-value 'org-todo-keywords)))))
+ (setq kwds (reverse kwds)))
+ (setq kwds (nreverse kwds))
+ (let (inter kws kw)
+ (while (setq kws (pop kwds))
+ (let ((kws (or
+ (run-hook-with-args-until-success
+ 'org-todo-setup-filter-hook kws)
+ kws)))
+ (setq inter (pop kws) sep (member "|" kws)
+ kws0 (delete "|" (copy-sequence kws))
+ kwsa nil
+ kws1 (mapcar
+ (lambda (x)
+ ;; 1 2
+ (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
+ (progn
+ (setq kw (match-string 1 x)
+ key (and (match-end 2) (match-string 2 x))
+ log (org-extract-log-state-settings x))
+ (push (cons kw (and key (string-to-char key))) kwsa)
+ (and log (push log org-todo-log-states))
+ kw)
+ (error "Invalid TODO keyword %s" x)))
+ kws0)
+ kwsa (if kwsa (append '((:startgroup))
+ (nreverse kwsa)
+ '((:endgroup))))
+ hw (car kws1)
+ dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
+ tail (list inter hw (car dws) (org-last dws))))
+ (add-to-list 'org-todo-heads hw 'append)
+ (push kws1 org-todo-sets)
+ (setq org-done-keywords (append org-done-keywords dws nil))
+ (setq org-todo-key-alist (append org-todo-key-alist kwsa))
+ (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1)
+ (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil)))
+ (setq org-todo-sets (nreverse org-todo-sets)
+ org-todo-kwd-alist (nreverse org-todo-kwd-alist)
+ org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
+ org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
+ ;; Process the constants
+ (when const
+ (let (e cst)
+ (while (setq e (pop const))
+ (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
+ (push (cons (match-string 1 e) (match-string 2 e)) cst)))
+ (setq org-table-formula-constants-local cst)))
+
+ ;; Process the tags.
+ (when tags
+ (let (e tgs)
+ (while (setq e (pop tags))
+ (cond
+ ((equal e "{") (push '(:startgroup) tgs))
+ ((equal e "}") (push '(:endgroup) tgs))
+ ((equal e "\\n") (push '(:newline) tgs))
+ ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
+ (push (cons (match-string 1 e)
+ (string-to-char (match-string 2 e)))
+ tgs))
+ (t (push (list e) tgs))))
+ (org-set-local 'org-tag-alist nil)
+ (while (setq e (pop tgs))
+ (or (and (stringp (car e))
+ (assoc (car e) org-tag-alist))
+ (push e org-tag-alist)))))
+
+ ;; Compute the regular expressions and other local variables.
+ ;; Using `org-outline-regexp-bol' would complicate them much,
+ ;; because of the fixed white space at the end of that string.
+ (if (not org-done-keywords)
+ (setq org-done-keywords (and org-todo-keywords-1
+ (list (org-last org-todo-keywords-1)))))
+ (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
+ (length org-scheduled-string)
+ (length org-clock-string)
+ (length org-closed-string)))
+ org-drawer-regexp
+ (concat "^[ \t]*:\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$")
+ org-not-done-keywords
+ (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
+ org-todo-regexp
+ (concat "\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)")
+ org-not-done-regexp
+ (concat "\\("
+ (mapconcat 'regexp-quote org-not-done-keywords "\\|")
+ "\\)")
+ org-not-done-heading-regexp
+ (format org-heading-keyword-regexp-format org-not-done-regexp)
+ org-todo-line-regexp
+ (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
+ org-complex-heading-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
+ "[ \t]*$")
+ org-complex-heading-regexp-format
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +"
+ ;; Stats cookies can be stuck to body.
+ "\\(?:\\[[0-9%%/]+\\] *\\)?"
+ "\\(%s\\)"
+ "\\(?: *\\[[0-9%%/]+\\]\\)?"
+ "\\)"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
+ "[ \t]*$")
+ org-todo-line-tags-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
+ "[ \t]*$")
+ org-deadline-regexp (concat "\\<" org-deadline-string)
+ org-deadline-time-regexp
+ (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+ org-deadline-line-regexp
+ (concat "\\<\\(" org-deadline-string "\\).*")
+ org-scheduled-regexp
+ (concat "\\<" org-scheduled-string)
+ org-scheduled-time-regexp
+ (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+ org-closed-time-regexp
+ (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
+ org-keyword-time-regexp
+ (concat "\\<\\(" org-scheduled-string
+ "\\|" org-deadline-string
+ "\\|" org-closed-string
+ "\\|" org-clock-string "\\)"
+ " *[[<]\\([^]>]+\\)[]>]")
+ org-keyword-time-not-clock-regexp
+ (concat "\\<\\(" org-scheduled-string
+ "\\|" org-deadline-string
+ "\\|" org-closed-string
+ "\\)"
+ " *[[<]\\([^]>]+\\)[]>]")
+ org-maybe-keyword-time-regexp
+ (concat "\\(\\<\\(" org-scheduled-string
+ "\\|" org-deadline-string
+ "\\|" org-closed-string
+ "\\|" org-clock-string "\\)\\)?"
+ " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
+ org-all-time-keywords
+ (mapcar (lambda (w) (substring w 0 -1))
+ (list org-scheduled-string org-deadline-string
+ org-clock-string org-closed-string))
+ )
+ (org-compute-latex-and-specials-regexp)
+ (org-set-font-lock-defaults))))
+
+(defun org-file-contents (file &optional noerror)
+ "Return the contents of FILE, as a string."
+ (if (or (not file)
+ (not (file-readable-p file)))
+ (if noerror
+ (progn
+ (message "Cannot read file \"%s\"" file)
+ (ding) (sit-for 2)
+ "")
+ (error "Cannot read file \"%s\"" file))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (buffer-string))))
+
+(defun org-extract-log-state-settings (x)
+ "Extract the log state setting from a TODO keyword string.
+This will extract info from a string like \"WAIT(w@/!)\"."
+ (let (kw key log1 log2)
+ (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
+ (setq kw (match-string 1 x)
+ key (and (match-end 2) (match-string 2 x))
+ log1 (and (match-end 3) (match-string 3 x))
+ log2 (and (match-end 4) (match-string 4 x)))
+ (and (or log1 log2)
+ (list kw
+ (and log1 (if (equal log1 "!") 'time 'note))
+ (and log2 (if (equal log2 "!") 'time 'note)))))))
+
+(defun org-remove-keyword-keys (list)
+ "Remove a pair of parenthesis at the end of each string in LIST."
+ (mapcar (lambda (x)
+ (if (string-match "(.*)$" x)
+ (substring x 0 (match-beginning 0))
+ x))
+ list))
+
+(defun org-assign-fast-keys (alist)
+ "Assign fast keys to a keyword-key alist.
+Respect keys that are already there."
+ (let (new e (alt ?0))
+ (while (setq e (pop alist))
+ (if (or (memq (car e) '(:newline :endgroup :startgroup))
+ (cdr e)) ;; Key already assigned.
+ (push e new)
+ (let ((clist (string-to-list (downcase (car e))))
+ (used (append new alist)))
+ (when (= (car clist) ?@)
+ (pop clist))
+ (while (and clist (rassoc (car clist) used))
+ (pop clist))
+ (unless clist
+ (while (rassoc alt used)
+ (incf alt)))
+ (push (cons (car e) (or (car clist) alt)) new))))
+ (nreverse new)))
+
+;;; Some variables used in various places
+
+(defvar org-window-configuration nil
+ "Used in various places to store a window configuration.")
+(defvar org-selected-window nil
+ "Used in various places to store a window configuration.")
+(defvar org-finish-function nil
+ "Function to be called when `C-c C-c' is used.
+This is for getting out of special buffers like capture.")
+
+
+;; FIXME: Occasionally check by commenting these, to make sure
+;; no other functions uses these, forgetting to let-bind them.
+(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(defvar org-last-state)
+(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+
+;; Defined somewhere in this file, but used before definition.
+(defvar org-entities) ;; defined in org-entities.el
+(defvar org-struct-menu)
+(defvar org-org-menu)
+(defvar org-tbl-menu)
+
+;;;; Define the Org-mode
+
+;; We use a before-change function to check if a table might need
+;; an update.
+(defvar org-table-may-need-update t
+ "Indicates that a table might need an update.
+This variable is set by `org-before-change-function'.
+`org-table-align' sets it back to nil.")
+(defun org-before-change-function (beg end)
+ "Every change indicates that a table might need an update."
+ (setq org-table-may-need-update t))
+(defvar org-mode-map)
+(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
+(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
+(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
+(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
+(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
+(defvar org-table-buffer-is-an nil)
+
+(defvar bidi-paragraph-direction)
+(defvar buffer-face-mode-face)
+
+(require 'outline)
+(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
+ (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22"))
+(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it
+
+;; Other stuff we need.
+(require 'time-date)
+(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
+(require 'easymenu)
+(require 'overlay)
+
+(require 'org-macs)
+(require 'org-entities)
+;; (require 'org-compat) moved higher up in the file before it is first used
+(require 'org-faces)
+(require 'org-list)
+(require 'org-pcomplete)
+(require 'org-src)
+(require 'org-footnote)
+
+;; babel
+(require 'ob)
+(require 'ob-table)
+(require 'ob-lob)
+(require 'ob-ref)
+(require 'ob-tangle)
+(require 'ob-comint)
+(require 'ob-keys)
+
+;;;###autoload
+(define-derived-mode org-mode outline-mode "Org"
+ "Outline-based notes management and organizer, alias
+\"Carsten's outline-mode for keeping track of everything.\"
+
+Org-mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org-mode is
+implemented on top of outline-mode, which is ideal to keep the content
+of large files well structured. It supports ToDo items, deadlines and
+time stamps, which magically appear in the diary listing of the Emacs
+calendar. Tables are easily created with a built-in table editor.
+Plain text URL-like links connect to websites, emails (VM), Usenet
+messages (Gnus), BBDB entries, and any files related to the project.
+For printing and sharing of notes, an Org-mode file (or a part of it)
+can be exported as a structured ASCII or HTML file.
+
+The following commands are available:
+
+\\{org-mode-map}"
+
+ ;; Get rid of Outline menus, they are not needed
+ ;; Need to do this here because define-derived-mode sets up
+ ;; the keymap so late. Still, it is a waste to call this each time
+ ;; we switch another buffer into org-mode.
+ (if (featurep 'xemacs)
+ (when (boundp 'outline-mode-menu-heading)
+ ;; Assume this is Greg's port, it uses easymenu
+ (easy-menu-remove outline-mode-menu-heading)
+ (easy-menu-remove outline-mode-menu-show)
+ (easy-menu-remove outline-mode-menu-hide))
+ (define-key org-mode-map [menu-bar headings] 'undefined)
+ (define-key org-mode-map [menu-bar hide] 'undefined)
+ (define-key org-mode-map [menu-bar show] 'undefined))
+
+ (org-load-modules-maybe)
+ (easy-menu-add org-org-menu)
+ (easy-menu-add org-tbl-menu)
+ (org-install-agenda-files-menu)
+ (if org-descriptive-links (add-to-invisibility-spec '(org-link)))
+ (add-to-invisibility-spec '(org-cwidth))
+ (add-to-invisibility-spec '(org-hide-block . t))
+ (when (featurep 'xemacs)
+ (org-set-local 'line-move-ignore-invisible t))
+ (org-set-local 'outline-regexp org-outline-regexp)
+ (org-set-local 'outline-level 'org-outline-level)
+ (setq bidi-paragraph-direction 'left-to-right)
+ (when (and org-ellipsis
+ (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
+ (fboundp 'make-glyph-code))
+ (unless org-display-table
+ (setq org-display-table (make-display-table)))
+ (set-display-table-slot
+ org-display-table 4
+ (vconcat (mapcar
+ (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
+ org-ellipsis)))
+ (if (stringp org-ellipsis) org-ellipsis "..."))))
+ (setq buffer-display-table org-display-table))
+ (org-set-regexps-and-options)
+ (when (and org-tag-faces (not org-tags-special-faces-re))
+ ;; tag faces set outside customize.... force initialization.
+ (org-set-tag-faces 'org-tag-faces org-tag-faces))
+ ;; Calc embedded
+ (org-set-local 'calc-embedded-open-mode "# ")
+ (modify-syntax-entry ?@ "w")
+ (if org-startup-truncated (setq truncate-lines t))
+ (org-set-local 'font-lock-unfontify-region-function
+ 'org-unfontify-region)
+ ;; Activate before-change-function
+ (org-set-local 'org-table-may-need-update t)
+ (org-add-hook 'before-change-functions 'org-before-change-function nil
+ 'local)
+ ;; Check for running clock before killing a buffer
+ (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ ;; Indentation.
+ (org-set-local 'indent-line-function 'org-indent-line)
+ (org-set-local 'indent-region-function 'org-indent-region)
+ ;; Initialize radio targets.
+ (org-update-radio-target-regexp)
+ ;; Filling and auto-filling.
+ (org-setup-filling)
+ ;; Comments.
+ (org-setup-comments-handling)
+ ;; Beginning/end of defun
+ (org-set-local 'beginning-of-defun-function 'org-back-to-heading)
+ (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t)))
+ ;; Next error for sparse trees
+ (org-set-local 'next-error-function 'org-occur-next-match)
+ ;; Make sure dependence stuff works reliably, even for users who set it
+ ;; too late :-(
+ (if org-enforce-todo-dependencies
+ (add-hook 'org-blocker-hook
+ 'org-block-todo-from-children-or-siblings-or-parent)
+ (remove-hook 'org-blocker-hook
+ 'org-block-todo-from-children-or-siblings-or-parent))
+ (if org-enforce-todo-checkbox-dependencies
+ (add-hook 'org-blocker-hook
+ 'org-block-todo-from-checkboxes)
+ (remove-hook 'org-blocker-hook
+ 'org-block-todo-from-checkboxes))
+
+ ;; Align options lines
+ (org-set-local
+ 'align-mode-rules-list
+ '((org-in-buffer-settings
+ (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
+ (modes . '(org-mode)))))
+
+ ;; Imenu
+ (org-set-local 'imenu-create-index-function
+ 'org-imenu-get-tree)
+
+ ;; Make isearch reveal context
+ (if (or (featurep 'xemacs)
+ (not (boundp 'outline-isearch-open-invisible-function)))
+ ;; Emacs 21 and XEmacs make use of the hook
+ (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
+ ;; Emacs 22 deals with this through a special variable
+ (org-set-local 'outline-isearch-open-invisible-function
+ (lambda (&rest ignore) (org-show-context 'isearch))))
+
+ ;; Turn on org-beamer-mode?
+ (and org-startup-with-beamer-mode (org-beamer-mode 1))
+
+ ;; Setup the pcomplete hooks
+ (set (make-local-variable 'pcomplete-command-completion-function)
+ 'org-pcomplete-initial)
+ (set (make-local-variable 'pcomplete-command-name-function)
+ 'org-command-at-point)
+ (set (make-local-variable 'pcomplete-default-completion-function)
+ 'ignore)
+ (set (make-local-variable 'pcomplete-parse-arguments-function)
+ 'org-parse-arguments)
+ (set (make-local-variable 'pcomplete-termination-string) "")
+ (when (>= emacs-major-version 23)
+ (set (make-local-variable 'buffer-face-mode-face) 'org-default))
+
+ ;; If empty file that did not turn on org-mode automatically, make it to.
+ (if (and org-insert-mode-line-in-empty-file
+ (org-called-interactively-p 'any)
+ (= (point-min) (point-max)))
+ (insert "# -*- mode: org -*-\n\n"))
+ (unless org-inhibit-startup
+ (when org-startup-align-all-tables
+ (let ((bmp (buffer-modified-p)))
+ (org-table-map-tables 'org-table-align 'quietly)
+ (set-buffer-modified-p bmp)))
+ (when org-startup-with-inline-images
+ (org-display-inline-images))
+ (when org-startup-indented
+ (require 'org-indent)
+ (org-indent-mode 1))
+ (unless org-inhibit-startup-visibility-stuff
+ (org-set-startup-visibility)))
+ ;; Try to set org-hide correctly
+ (set-face-foreground 'org-hide (org-find-invisible-foreground)))
+
+(when (fboundp 'abbrev-table-put)
+ (abbrev-table-put org-mode-abbrev-table
+ :parents (list text-mode-abbrev-table)))
+
+(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
+
+
+(defun org-find-invisible-foreground ()
+ (let ((candidates (remove
+ "unspecified-bg"
+ (list
+ (face-background 'default)
+ (face-background 'org-default)
+ (cdr (assoc 'background-color default-frame-alist))
+ (cdr (assoc 'background-color initial-frame-alist))
+ (cdr (assoc 'background-color window-system-default-frame-alist))
+ (face-foreground 'org-hide)))))
+ (car (remove nil candidates))))
+
+(defun org-current-time ()
+ "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
+ (if (> (car org-time-stamp-rounding-minutes) 1)
+ (let ((r (car org-time-stamp-rounding-minutes))
+ (time (decode-time)))
+ (apply 'encode-time
+ (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
+ (nthcdr 2 time))))
+ (current-time)))
+
+(defun org-today ()
+ "Return today date, considering `org-extend-today-until'."
+ (time-to-days
+ (time-subtract (current-time)
+ (list 0 (* 3600 org-extend-today-until) 0))))
+
+;;;; Font-Lock stuff, including the activators
+
+(defvar org-mouse-map (make-sparse-keymap))
+(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse)
+(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse)
+(when org-mouse-1-follows-link
+ (org-defkey org-mouse-map [follow-link] 'mouse-face))
+(when org-tab-follows-link
+ (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
+ (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
+
+(require 'font-lock)
+
+(defconst org-non-link-chars "]\t\n\r<>")
+(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
+ "shell" "elisp" "doi" "message"))
+(defvar org-link-types-re nil
+ "Matches a link that has a url-like prefix like \"http:\"")
+(defvar org-link-re-with-space nil
+ "Matches a link with spaces, optional angular brackets around it.")
+(defvar org-link-re-with-space2 nil
+ "Matches a link with spaces, optional angular brackets around it.")
+(defvar org-link-re-with-space3 nil
+ "Matches a link with spaces, only for internal part in bracket links.")
+(defvar org-angle-link-re nil
+ "Matches link with angular brackets, spaces are allowed.")
+(defvar org-plain-link-re nil
+ "Matches plain link, without spaces.")
+(defvar org-bracket-link-regexp nil
+ "Matches a link in double brackets.")
+(defvar org-bracket-link-analytic-regexp nil
+ "Regular expression used to analyze links.
+Here is what the match groups contain after a match:
+1: http:
+2: http
+3: path
+4: [desc]
+5: desc")
+(defvar org-bracket-link-analytic-regexp++ nil
+ "Like `org-bracket-link-analytic-regexp', but include coderef internal type.")
+(defvar org-any-link-re nil
+ "Regular expression matching any link.")
+
+(defcustom org-match-sexp-depth 3
+ "Number of stacked braces for sub/superscript matching.
+This has to be set before loading org.el to be effective."
+ :group 'org-export-translation ; ??????????????????????????/
+ :type 'integer)
+
+(defun org-create-multibrace-regexp (left right n)
+ "Create a regular expression which will match a balanced sexp.
+Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
+as single character strings.
+The regexp returned will match the entire expression including the
+delimiters. It will also define a single group which contains the
+match except for the outermost delimiters. The maximum depth of
+stacked delimiters is N. Escaping delimiters is not possible."
+ (let* ((nothing (concat "[^" left right "]*?"))
+ (or "\\|")
+ (re nothing)
+ (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
+ (while (> n 1)
+ (setq n (1- n)
+ re (concat re or next)
+ next (concat "\\(?:" nothing left next right "\\)+" nothing)))
+ (concat left "\\(" re "\\)" right)))
+
+(defvar org-match-substring-regexp
+ (concat
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
+ "\\|"
+ "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
+ "\\|"
+ "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
+ "The regular expression matching a sub- or superscript.")
+
+(defvar org-match-substring-with-braces-regexp
+ (concat
+ "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
+ "\\)")
+ "The regular expression matching a sub- or superscript, forcing braces.")
+
+(defun org-make-link-regexps ()
+ "Update the link regular expressions.
+This should be called after the variable `org-link-types' has changed."
+ (setq org-link-types-re
+ (concat
+ "\\`\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):")
+ org-link-re-with-space
+ (concat
+ "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
+ "\\([^" org-non-link-chars " ]"
+ "[^" org-non-link-chars "]*"
+ "[^" org-non-link-chars " ]\\)>?")
+ org-link-re-with-space2
+ (concat
+ "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
+ "\\([^" org-non-link-chars " ]"
+ "[^\t\n\r]*"
+ "[^" org-non-link-chars " ]\\)>?")
+ org-link-re-with-space3
+ (concat
+ "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
+ "\\([^" org-non-link-chars " ]"
+ "[^\t\n\r]*\\)")
+ org-angle-link-re
+ (concat
+ "<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
+ "\\([^" org-non-link-chars " ]"
+ "[^" org-non-link-chars "]*"
+ "\\)>")
+ org-plain-link-re
+ (concat
+ "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
+ (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
+ ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
+ org-bracket-link-regexp
+ "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
+ org-bracket-link-analytic-regexp
+ (concat
+ "\\[\\["
+ "\\(\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):\\)?"
+ "\\([^]]+\\)"
+ "\\]"
+ "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
+ "\\]")
+ org-bracket-link-analytic-regexp++
+ (concat
+ "\\[\\["
+ "\\(\\(" (mapconcat 'regexp-quote (cons "coderef" org-link-types) "\\|") "\\):\\)?"
+ "\\([^]]+\\)"
+ "\\]"
+ "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
+ "\\]")
+ org-any-link-re
+ (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
+ org-angle-link-re "\\)\\|\\("
+ org-plain-link-re "\\)")))
+
+(org-make-link-regexps)
+
+(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+ "Regular expression for fast time stamp matching.")
+(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]"
+ "Regular expression for fast time stamp matching.")
+(defconst org-ts-regexp0
+ "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.
+This one does not require the space after the date, so it can be used
+on a string that terminates immediately after the date.")
+(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
+ "Regular expression matching time strings for analysis.")
+(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
+ "Regular expression matching time stamps, with groups.")
+(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
+ "Regular expression matching time stamps (also [..]), with groups.")
+(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
+ "Regular expression matching a time stamp range.")
+(defconst org-tr-regexp-both
+ (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
+ "Regular expression matching a time stamp range.")
+(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
+ org-ts-regexp "\\)?")
+ "Regular expression matching a time stamp or time stamp range.")
+(defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?"
+ org-ts-regexp-both "\\)?")
+ "Regular expression matching a time stamp or time stamp range.
+The time stamps may be either active or inactive.")
+
+(defvar org-emph-face nil)
+
+(defun org-do-emphasis-faces (limit)
+ "Run through the buffer and add overlays to emphasized strings."
+ (let (rtn a)
+ (while (and (not rtn) (re-search-forward org-emph-re limit t))
+ (if (not (= (char-after (match-beginning 3))
+ (char-after (match-beginning 4))))
+ (progn
+ (setq rtn t)
+ (setq a (assoc (match-string 3) org-emphasis-alist))
+ (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
+ 'face
+ (nth 1 a))
+ (and (nth 4 a)
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(font-lock-multiline t org-emphasis t))
+ (when org-hide-emphasis-markers
+ (add-text-properties (match-end 4) (match-beginning 5)
+ '(invisible org-link))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible org-link)))))
+ (backward-char 1))
+ rtn))
+
+(defun org-emphasize (&optional char)
+ "Insert or change an emphasis, i.e. a font like bold or italic.
+If there is an active region, change that region to a new emphasis.
+If there is no region, just insert the marker characters and position
+the cursor between them.
+CHAR should be either the marker character, or the first character of the
+HTML tag associated with that emphasis. If CHAR is a space, the means
+to remove the emphasis of the selected region.
+If char is not given (for example in an interactive call) it
+will be prompted for."
+ (interactive)
+ (let ((eal org-emphasis-alist) e det
+ (erc org-emphasis-regexp-components)
+ (prompt "")
+ (string "") beg end move tag c s)
+ (if (org-region-active-p)
+ (setq beg (region-beginning) end (region-end)
+ string (buffer-substring beg end))
+ (setq move t))
+
+ (while (setq e (pop eal))
+ (setq tag (car (org-split-string (nth 2 e) "[ <>/]+"))
+ c (aref tag 0))
+ (push (cons c (string-to-char (car e))) det)
+ (setq prompt (concat prompt (format " [%s%c]%s" (car e) c
+ (substring tag 1)))))
+ (setq det (nreverse det))
+ (unless char
+ (message "%s" (concat "Emphasis marker or tag:" prompt))
+ (setq char (read-char-exclusive)))
+ (setq char (or (cdr (assoc char det)) char))
+ (if (equal char ?\ )
+ (setq s "" move nil)
+ (unless (assoc (char-to-string char) org-emphasis-alist)
+ (error "No such emphasis marker: \"%c\"" char))
+ (setq s (char-to-string char)))
+ (while (and (> (length string) 1)
+ (equal (substring string 0 1) (substring string -1))
+ (assoc (substring string 0 1) org-emphasis-alist))
+ (setq string (substring string 1 -1)))
+ (setq string (concat s string s))
+ (if beg (delete-region beg end))
+ (unless (or (bolp)
+ (string-match (concat "[" (nth 0 erc) "\n]")
+ (char-to-string (char-before (point)))))
+ (insert " "))
+ (unless (or (eobp)
+ (string-match (concat "[" (nth 1 erc) "\n]")
+ (char-to-string (char-after (point)))))
+ (insert " ") (backward-char 1))
+ (insert string)
+ (and move (backward-char 1))))
+
+(defconst org-nonsticky-props
+ '(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
+
+(defsubst org-rear-nonsticky-at (pos)
+ (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
+
+(defun org-activate-plain-links (limit)
+ "Run through the buffer and add overlays to links."
+ (catch 'exit
+ (let (f)
+ (when (re-search-forward (concat org-plain-link-re) limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (setq f (get-text-property (match-beginning 0) 'face))
+ (if (or (eq f 'org-tag)
+ (and (listp f) (memq 'org-tag f)))
+ nil
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'face 'org-link
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0)))
+ t))))
+
+(defun org-activate-code (limit)
+ (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ t)))
+
+(defcustom org-src-fontify-natively nil
+ "When non-nil, fontify code in code blocks."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-appearance
+ :group 'org-babel)
+
+(defcustom org-allow-promoting-top-level-subtree nil
+ "When non-nil, allow promoting a top level subtree.
+The leading star of the top level headline will be replaced
+by a #."
+ :type 'boolean
+ :version "24.1"
+ :group 'org-appearance)
+
+(defun org-fontify-meta-lines-and-blocks (limit)
+ (condition-case nil
+ (org-fontify-meta-lines-and-blocks-1 limit)
+ (error (message "org-mode fontification error"))))
+
+(defun org-fontify-meta-lines-and-blocks-1 (limit)
+ "Fontify #+ lines and blocks, in the correct ways."
+ (let ((case-fold-search t))
+ (if (re-search-forward
+ "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+ limit t)
+ (let ((beg (match-beginning 0))
+ (block-start (match-end 0))
+ (block-end nil)
+ (lang (match-string 7))
+ (beg1 (line-beginning-position 2))
+ (dc1 (downcase (match-string 2)))
+ (dc3 (downcase (match-string 3)))
+ end end1 quoting block-type ovl)
+ (cond
+ ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:"))
+ ;; a single line of backend-specific content
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(display t invisible t intangible t))
+ (add-text-properties (match-beginning 1) (match-end 3)
+ '(font-lock-fontified t face org-meta-line))
+ (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
+ '(font-lock-fontified t face org-block))
+ ; for backend-specific code
+ t)
+ ((and (match-end 4) (equal dc3 "+begin"))
+ ;; Truly a block
+ (setq block-type (downcase (match-string 5))
+ quoting (member block-type org-protecting-blocks))
+ (when (re-search-forward
+ (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
+ nil t) ;; on purpose, we look further than LIMIT
+ (setq end (min (point-max) (match-end 0))
+ end1 (min (point-max) (1- (match-beginning 0))))
+ (setq block-end (match-beginning 0))
+ (when quoting
+ (remove-text-properties beg end
+ '(display t invisible t intangible t)))
+ (add-text-properties
+ beg end
+ '(font-lock-fontified t font-lock-multiline t))
+ (add-text-properties beg beg1 '(face org-meta-line))
+ (add-text-properties end1 (min (point-max) (1+ end))
+ '(face org-meta-line)) ; for end_src
+ (cond
+ ((and lang (not (string= lang "")) org-src-fontify-natively)
+ (org-src-font-lock-fontify-block lang block-start block-end)
+ ;; remove old background overlays
+ (mapc (lambda (ov)
+ (if (eq (overlay-get ov 'face) 'org-block-background)
+ (delete-overlay ov)))
+ (overlays-at (/ (+ beg1 block-end) 2)))
+ ;; add a background overlay
+ (setq ovl (make-overlay beg1 block-end))
+ (overlay-put ovl 'face 'org-block-background)
+ (overlay-put ovl 'evaporate t)) ;; make it go away when empty
+ (quoting
+ (add-text-properties beg1 (min (point-max) (1+ end1))
+ '(face org-block))) ; end of source block
+ ((not org-fontify-quote-and-verse-blocks))
+ ((string= block-type "quote")
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
+ ((string= block-type "verse")
+ (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
+ (add-text-properties beg beg1 '(face org-block-begin-line))
+ (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
+ '(face org-block-end-line))
+ t))
+ ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
+ (add-text-properties
+ beg (match-end 3)
+ (if (member (intern (substring dc1 0 -1)) org-hidden-keywords)
+ '(font-lock-fontified t invisible t)
+ '(font-lock-fontified t face org-document-info-keyword)))
+ (add-text-properties
+ (match-beginning 6) (match-end 6)
+ (if (string-equal dc1 "+title:")
+ '(font-lock-fontified t face org-document-title)
+ '(font-lock-fontified t face org-document-info))))
+ ((or (equal dc1 "+results")
+ (member dc1 '("+begin:" "+end:" "+caption:" "+label:"
+ "+orgtbl:" "+tblfm:" "+tblname:" "+results:"
+ "+call:" "+header:" "+headers:" "+name:"))
+ (and (match-end 4) (equal dc3 "+attr")))
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t)
+ ((member dc3 '(" " ""))
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face font-lock-comment-face)))
+ ((not (member (char-after beg) '(?\ ?\t)))
+ ;; just any other in-buffer setting, but not indented
+ (add-text-properties
+ beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t)
+ (t nil))))))
+
+(defun org-strip-protective-commas (beg end)
+ "Strip protective commas between BEG and END in the current buffer."
+ (interactive "r")
+ (save-excursion
+ (save-match-data
+ (goto-char beg)
+ (let ((front-line (save-excursion
+ (re-search-forward
+ "[^[:space:]]" end t)
+ (goto-char (match-beginning 0))
+ (current-column))))
+ (while (re-search-forward "^[ \t]*\\(,\\)\\([*]\\|#\\)" end t)
+ (goto-char (match-beginning 1))
+ (when (= (current-column) front-line)
+ (replace-match "" nil nil nil 1)))))))
+
+(defun org-activate-angle-links (limit)
+ "Run through the buffer and add overlays to links."
+ (if (re-search-forward org-angle-link-re limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
+ t)))
+
+(defun org-activate-footnote-links (limit)
+ "Run through the buffer and add overlays to footnotes."
+ (let ((fn (org-footnote-next-reference-or-definition limit)))
+ (when fn
+ (let ((beg (nth 1 fn)) (end (nth 2 fn)))
+ (org-remove-flyspell-overlays-in beg end)
+ (add-text-properties beg end
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map
+ 'help-echo
+ (if (= (point-at-bol) beg)
+ "Footnote definition"
+ "Footnote reference")
+ 'font-lock-fontified t
+ 'font-lock-multiline t
+ 'face 'org-footnote))))))
+
+(defun org-activate-bracket-links (limit)
+ "Run through the buffer and add overlays to bracketed links."
+ (if (re-search-forward org-bracket-link-regexp limit t)
+ (let* ((help (concat "LINK: "
+ (org-match-string-no-properties 1)))
+ ;; FIXME: above we should remove the escapes.
+ ;; but that requires another match, protecting match data,
+ ;; a lot of overhead for font-lock.
+ (ip (org-maybe-intangible
+ (list 'invisible 'org-link
+ 'keymap org-mouse-map 'mouse-face 'highlight
+ 'font-lock-multiline t 'help-echo help)))
+ (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
+ 'font-lock-multiline t 'help-echo help)))
+ ;; We need to remove the invisible property here. Table narrowing
+ ;; may have made some of this invisible.
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (remove-text-properties (match-beginning 0) (match-end 0)
+ '(invisible nil))
+ (if (match-end 3)
+ (progn
+ (add-text-properties (match-beginning 0) (match-beginning 3) ip)
+ (org-rear-nonsticky-at (match-beginning 3))
+ (add-text-properties (match-beginning 3) (match-end 3) vp)
+ (org-rear-nonsticky-at (match-end 3))
+ (add-text-properties (match-end 3) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
+ (add-text-properties (match-beginning 0) (match-beginning 1) ip)
+ (org-rear-nonsticky-at (match-beginning 1))
+ (add-text-properties (match-beginning 1) (match-end 1) vp)
+ (org-rear-nonsticky-at (match-end 1))
+ (add-text-properties (match-end 1) (match-end 0) ip)
+ (org-rear-nonsticky-at (match-end 0)))
+ t)))
+
+(defun org-activate-dates (limit)
+ "Run through the buffer and add overlays to dates."
+ (if (re-search-forward org-tsr-regexp-both limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
+ (when org-display-custom-times
+ (if (match-end 3)
+ (org-display-custom-time (match-beginning 3) (match-end 3)))
+ (org-display-custom-time (match-beginning 1) (match-end 1)))
+ t)))
+
+(defvar org-target-link-regexp nil
+ "Regular expression matching radio targets in plain text.")
+(make-variable-buffer-local 'org-target-link-regexp)
+(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>"
+ "Regular expression matching a link target.")
+(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>"
+ "Regular expression matching a radio target.")
+(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target.
+ "Regular expression matching any target.")
+
+(defun org-activate-target-links (limit)
+ "Run through the buffer and add overlays to target matches."
+ (when org-target-link-regexp
+ (let ((case-fold-search t))
+ (if (re-search-forward org-target-link-regexp limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map
+ 'help-echo "Radio target link"
+ 'org-linked-text t))
+ (org-rear-nonsticky-at (match-end 0))
+ t)))))
+
+(defun org-update-radio-target-regexp ()
+ "Find all radio targets in this file and update the regular expression."
+ (interactive)
+ (when (memq 'radio org-activate-links)
+ (setq org-target-link-regexp
+ (org-make-target-link-regexp (org-all-targets 'radio)))
+ (org-restart-font-lock)))
+
+(defun org-hide-wide-columns (limit)
+ (let (s e)
+ (setq s (text-property-any (point) (or limit (point-max))
+ 'org-cwidth t))
+ (when s
+ (setq e (next-single-property-change s 'org-cwidth))
+ (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
+ (goto-char e)
+ t)))
+
+(defvar org-latex-and-specials-regexp nil
+ "Regular expression for highlighting export special stuff.")
+(defvar org-match-substring-regexp)
+(defvar org-match-substring-with-braces-regexp)
+
+;; This should be with the exporter code, but we also use if for font-locking
+(defconst org-export-html-special-string-regexps
+ '(("\\\\-" . "&shy;")
+ ("---\\([^-]\\)" . "&mdash;\\1")
+ ("--\\([^-]\\)" . "&ndash;\\1")
+ ("\\.\\.\\." . "&hellip;"))
+ "Regular expressions for special string conversion.")
+
+
+(defun org-compute-latex-and-specials-regexp ()
+ "Compute regular expression for stuff treated specially by exporters."
+ (if (not org-highlight-latex-fragments-and-specials)
+ (org-set-local 'org-latex-and-specials-regexp nil)
+ (require 'org-exp)
+ (let*
+ ((matchers (plist-get org-format-latex-options :matchers))
+ (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
+ org-latex-regexps)))
+ (org-export-allow-BIND nil)
+ (options (org-combine-plists (org-default-export-plist)
+ (org-infile-export-plist)))
+ (org-export-with-sub-superscripts (plist-get options :sub-superscript))
+ (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
+ (org-export-with-TeX-macros (plist-get options :TeX-macros))
+ (org-export-html-expand (plist-get options :expand-quoted-html))
+ (org-export-with-special-strings (plist-get options :special-strings))
+ (re-sub
+ (cond
+ ((equal org-export-with-sub-superscripts '{})
+ (list org-match-substring-with-braces-regexp))
+ (org-export-with-sub-superscripts
+ (list org-match-substring-regexp))))
+ (re-latex
+ (if org-export-with-LaTeX-fragments
+ (mapcar (lambda (x) (nth 1 x)) latexs)))
+ (re-macros
+ (if org-export-with-TeX-macros
+ (list (concat "\\\\"
+ (regexp-opt
+ (append
+
+ (delq nil
+ (mapcar 'car-safe
+ (append org-entities-user
+ org-entities)))
+ (if (boundp 'org-latex-entities)
+ (mapcar (lambda (x)
+ (or (car-safe x) x))
+ org-latex-entities)
+ nil))
+ 'words))) ; FIXME
+ ))
+ ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
+ (re-special (if org-export-with-special-strings
+ (mapcar (lambda (x) (car x))
+ org-export-html-special-string-regexps)))
+ (re-rest
+ (delq nil
+ (list
+ (if org-export-html-expand "@<[^>\n]+>")
+ ))))
+ (org-set-local
+ 'org-latex-and-specials-regexp
+ (mapconcat 'identity (append re-latex re-sub re-macros re-special
+ re-rest) "\\|")))))
+
+(defun org-do-latex-and-special-faces (limit)
+ "Run through the buffer and add overlays to links."
+ (when org-latex-and-specials-regexp
+ (let (rtn d)
+ (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
+ limit t))
+ (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
+ 'face))
+ '(org-code org-verbatim underline)))
+ (progn
+ (setq rtn t
+ d (cond ((member (char-after (1+ (match-beginning 0)))
+ '(?_ ?^)) 1)
+ (t 0)))
+ (font-lock-prepend-text-property
+ (+ d (match-beginning 0)) (match-end 0)
+ 'face 'org-latex-and-export-specials)
+ (add-text-properties (+ d (match-beginning 0)) (match-end 0)
+ '(font-lock-multiline t)))))
+ rtn)))
+
+(defun org-restart-font-lock ()
+ "Restart `font-lock-mode', to force refontification."
+ (when (and (boundp 'font-lock-mode) font-lock-mode)
+ (font-lock-mode -1)
+ (font-lock-mode 1)))
+
+(defun org-all-targets (&optional radio)
+ "Return a list of all targets in this file.
+With optional argument RADIO, only find radio targets."
+ (let ((re (if radio org-radio-target-regexp org-target-regexp))
+ rtn)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
+ rtn)))
+
+(defun org-make-target-link-regexp (targets)
+ "Make regular expression matching all strings in TARGETS.
+The regular expression finds the targets also if there is a line break
+between words."
+ (and targets
+ (concat
+ "\\<\\("
+ (mapconcat
+ (lambda (x)
+ (setq x (regexp-quote x))
+ (while (string-match " +" x)
+ (setq x (replace-match "\\s-+" t t x)))
+ x)
+ targets
+ "\\|")
+ "\\)\\>")))
+
+(defun org-activate-tags (limit)
+ (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t)
+ (progn
+ (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 1))
+ t)))
+
+(defun org-outline-level ()
+ "Compute the outline level of the heading at point.
+This function assumes that the cursor is at the beginning of a line matched
+by `outline-regexp'. Otherwise it returns garbage.
+If this is called at a normal headline, the level is the number of stars.
+Use `org-reduced-level' to remove the effect of `org-odd-levels'."
+ (save-excursion
+ (looking-at org-outline-regexp)
+ (1- (- (match-end 0) (match-beginning 0)))))
+
+(defvar org-font-lock-keywords nil)
+
+(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
+ "Regular expression matching a property line.")
+
+(defvar org-font-lock-hook nil
+ "Functions to be called for special font lock stuff.")
+
+(defvar org-font-lock-set-keywords-hook nil
+ "Functions that can manipulate `org-font-lock-extra-keywords'.
+This is called after `org-font-lock-extra-keywords' is defined, but before
+it is installed to be used by font lock. This can be useful if something
+needs to be inserted at a specific position in the font-lock sequence.")
+
+(defun org-font-lock-hook (limit)
+ "Run `org-font-lock-hook' within LIMIT."
+ (run-hook-with-args 'org-font-lock-hook limit))
+
+(defun org-set-font-lock-defaults ()
+ "Set font lock defaults for the current buffer."
+ (let* ((em org-fontify-emphasized-text)
+ (lk org-activate-links)
+ (org-font-lock-extra-keywords
+ (list
+ ;; Call the hook
+ '(org-font-lock-hook)
+ ;; Headlines
+ `(,(if org-fontify-whole-heading-line
+ "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
+ "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
+ (1 (org-get-level-face 1))
+ (2 (org-get-level-face 2))
+ (3 (org-get-level-face 3)))
+ ;; Table lines
+ '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
+ (1 'org-table t))
+ ;; Table internals
+ '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
+ '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
+ '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
+ '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
+ ;; Drawers
+ (list org-drawer-regexp '(0 'org-special-keyword t))
+ (list "^[ \t]*:END:" '(0 'org-special-keyword t))
+ ;; Properties
+ (list org-property-re
+ '(1 'org-special-keyword t)
+ '(3 'org-property-value t))
+ ;; Links
+ (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
+ (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
+ (if (memq 'plain lk) '(org-activate-plain-links))
+ (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
+ (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
+ (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
+ (if (memq 'footnote lk) '(org-activate-footnote-links))
+ '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
+ '(org-hide-wide-columns (0 nil append))
+ ;; TODO keyword
+ (list (format org-heading-keyword-regexp-format
+ org-todo-regexp)
+ '(2 (org-get-todo-face 2) t))
+ ;; DONE
+ (if org-fontify-done-headline
+ (list (format org-heading-keyword-regexp-format
+ (concat
+ "\\(?:"
+ (mapconcat 'regexp-quote org-done-keywords "\\|")
+ "\\)"))
+ '(2 'org-headline-done t))
+ nil)
+ ;; Priorities
+ '(org-font-lock-add-priority-faces)
+ ;; Tags
+ '(org-font-lock-add-tag-faces)
+ ;; Special keywords
+ (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
+ (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
+ ;; Emphasis
+ (if em
+ (if (featurep 'xemacs)
+ '(org-do-emphasis-faces (0 nil append))
+ '(org-do-emphasis-faces)))
+ ;; Checkboxes
+ '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
+ 1 'org-checkbox prepend)
+ (if (cdr (assq 'checkbox org-list-automatic-rules))
+ '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
+ (0 (org-get-checkbox-statistics-face) t)))
+ ;; Description list items
+ '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
+ 1 'org-list-dt prepend)
+ ;; ARCHIVEd headings
+ (list (concat
+ org-outline-regexp-bol
+ "\\(.*:" org-archive-tag ":.*\\)")
+ '(1 'org-archived prepend))
+ ;; Specials
+ '(org-do-latex-and-special-faces)
+ '(org-fontify-entities)
+ '(org-raise-scripts)
+ ;; Code
+ '(org-activate-code (1 'org-code t))
+ ;; COMMENT
+ (list (format org-heading-keyword-regexp-format
+ (concat "\\("
+ org-comment-string "\\|" org-quote-string
+ "\\)"))
+ '(2 'org-special-keyword t))
+ ;; Blocks and meta lines
+ '(org-fontify-meta-lines-and-blocks)
+ )))
+ (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
+ (run-hooks 'org-font-lock-set-keywords-hook)
+ ;; Now set the full font-lock-keywords
+ (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
+ (org-set-local 'font-lock-defaults
+ '(org-font-lock-keywords t nil nil backward-paragraph))
+ (kill-local-variable 'font-lock-keywords) nil))
+
+(defun org-toggle-pretty-entities ()
+ "Toggle the composition display of entities as UTF8 characters."
+ (interactive)
+ (org-set-local 'org-pretty-entities (not org-pretty-entities))
+ (org-restart-font-lock)
+ (if org-pretty-entities
+ (message "Entities are displayed as UTF8 characters")
+ (save-restriction
+ (widen)
+ (org-decompose-region (point-min) (point-max))
+ (message "Entities are displayed plain"))))
+
+(defvar org-custom-properties-overlays nil
+ "List of overlays used for custom properties.")
+(make-variable-buffer-local 'org-custom-properties-overlays)
+
+(defun org-toggle-custom-properties-visibility ()
+ "Display or hide properties in `org-custom-properties'."
+ (interactive)
+ (if org-custom-properties-overlays
+ (progn (mapc 'delete-overlay org-custom-properties-overlays)
+ (setq org-custom-properties-overlays nil))
+ (unless (not org-custom-properties)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward org-property-re nil t)
+ (mapc (lambda(p)
+ (when (equal p (substring (match-string 1) 1 -1))
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays))))
+ org-custom-properties)))))))
+
+(defun org-fontify-entities (limit)
+ "Find an entity to fontify."
+ (let (ee)
+ (when org-pretty-entities
+ (catch 'match
+ (while (re-search-forward
+ "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
+ limit t)
+ (if (and (not (org-in-indented-comment-line))
+ (setq ee (org-entity-get (match-string 1)))
+ (= (length (nth 6 ee)) 1))
+ (let*
+ ((end (if (equal (match-string 2) "{}")
+ (match-end 2)
+ (match-end 1))))
+ (add-text-properties
+ (match-beginning 0) end
+ (list 'font-lock-fontified t))
+ (compose-region (match-beginning 0) end
+ (nth 6 ee) nil)
+ (backward-char 1)
+ (throw 'match t))))
+ nil))))
+
+(defun org-fontify-like-in-org-mode (s &optional odd-levels)
+ "Fontify string S like in Org-mode."
+ (with-temp-buffer
+ (insert s)
+ (let ((org-odd-levels-only odd-levels))
+ (org-mode)
+ (font-lock-fontify-buffer)
+ (buffer-string))))
+
+(defvar org-m nil)
+(defvar org-l nil)
+(defvar org-f nil)
+(defun org-get-level-face (n)
+ "Get the right face for match N in font-lock matching of headlines."
+ (setq org-l (- (match-end 2) (match-beginning 1) 1))
+ (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
+ (if org-cycle-level-faces
+ (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
+ (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
+ (cond
+ ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
+ ((eq n 2) org-f)
+ (t (if org-level-color-stars-only nil org-f))))
+
+
+(defun org-get-todo-face (kwd)
+ "Get the right face for a TODO keyword KWD.
+If KWD is a number, get the corresponding match group."
+ (if (numberp kwd) (setq kwd (match-string kwd)))
+ (or (org-face-from-face-or-color
+ 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
+ (and (member kwd org-done-keywords) 'org-done)
+ 'org-todo))
+
+(defun org-face-from-face-or-color (context inherit face-or-color)
+ "Create a face list that inherits INHERIT, but sets the foreground color.
+When FACE-OR-COLOR is not a string, just return it."
+ (if (stringp face-or-color)
+ (list :inherit inherit
+ (cdr (assoc context org-faces-easy-properties))
+ face-or-color)
+ face-or-color))
+
+(defun org-font-lock-add-tag-faces (limit)
+ "Add the special tag faces."
+ (when (and org-tag-faces org-tags-special-faces-re)
+ (while (re-search-forward org-tags-special-faces-re limit t)
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'face (org-get-tag-face 1)
+ 'font-lock-fontified t))
+ (backward-char 1))))
+
+(defun org-font-lock-add-priority-faces (limit)
+ "Add the special priority faces."
+ (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
+ (when (save-match-data (org-at-heading-p))
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (list 'face (or (org-face-from-face-or-color
+ 'priority 'org-special-keyword
+ (cdr (assoc (char-after (match-beginning 1))
+ org-priority-faces)))
+ 'org-special-keyword)
+ 'font-lock-fontified t)))))
+
+(defun org-get-tag-face (kwd)
+ "Get the right face for a TODO keyword KWD.
+If KWD is a number, get the corresponding match group."
+ (if (numberp kwd) (setq kwd (match-string kwd)))
+ (or (org-face-from-face-or-color
+ 'tag 'org-tag (cdr (assoc kwd org-tag-faces)))
+ 'org-tag))
+
+(defun org-unfontify-region (beg end &optional maybe_loudly)
+ "Remove fontification and activation overlays from links."
+ (font-lock-default-unfontify-region beg end)
+ (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)
+ (org-decompose-region beg end)
+ (remove-text-properties beg end
+ '(mouse-face t keymap t org-linked-text t
+ invisible t intangible t
+ org-no-flyspell t org-emphasis t))
+ (org-remove-font-lock-display-properties beg end)))
+
+(defconst org-script-display '(((raise -0.3) (height 0.7))
+ ((raise 0.3) (height 0.7))
+ ((raise -0.5))
+ ((raise 0.5)))
+ "Display properties for showing superscripts and subscripts.")
+
+(defun org-remove-font-lock-display-properties (beg end)
+ "Remove specific display properties that have been added by font lock.
+The will remove the raise properties that are used to show superscripts
+and subscripts."
+ (let (next prop)
+ (while (< beg end)
+ (setq next (next-single-property-change beg 'display nil end)
+ prop (get-text-property beg 'display))
+ (if (member prop org-script-display)
+ (put-text-property beg next 'display nil))
+ (setq beg next))))
+
+(defun org-raise-scripts (limit)
+ "Add raise properties to sub/superscripts."
+ (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts)
+ (if (re-search-forward
+ (if (eq org-use-sub-superscripts t)
+ org-match-substring-regexp
+ org-match-substring-with-braces-regexp)
+ limit t)
+ (let* ((pos (point)) table-p comment-p
+ (mpos (match-beginning 3))
+ (emph-p (get-text-property mpos 'org-emphasis))
+ (link-p (get-text-property mpos 'mouse-face))
+ (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
+ (goto-char (point-at-bol))
+ (setq table-p (org-looking-at-p org-table-dataline-regexp)
+ comment-p (org-looking-at-p "[ \t]*#"))
+ (goto-char pos)
+ ;; FIXME: Should we go back one character here, for a_b^c
+ ;; (goto-char (1- pos)) ;????????????????????
+ (if (or comment-p emph-p link-p keyw-p)
+ t
+ (put-text-property (match-beginning 3) (match-end 0)
+ 'display
+ (if (equal (char-after (match-beginning 2)) ?^)
+ (nth (if table-p 3 1) org-script-display)
+ (nth (if table-p 2 0) org-script-display)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ (list 'invisible t
+ 'org-dwidth t 'org-dwidth-n 1))
+ (if (and (eq (char-after (match-beginning 3)) ?{)
+ (eq (char-before (match-end 3)) ?}))
+ (progn
+ (add-text-properties
+ (match-beginning 3) (1+ (match-beginning 3))
+ (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
+ (add-text-properties
+ (1- (match-end 3)) (match-end 3)
+ (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))
+ t)))))
+
+;;;; Visibility cycling, including org-goto and indirect buffer
+
+;;; Cycling
+
+(defvar org-cycle-global-status nil)
+(make-variable-buffer-local 'org-cycle-global-status)
+(defvar org-cycle-subtree-status nil)
+(make-variable-buffer-local 'org-cycle-subtree-status)
+
+;;;###autoload
+
+(defvar org-inlinetask-min-level)
+
+(defun org-cycle (&optional arg)
+ "TAB-action and visibility cycling for Org-mode.
+
+This is the command invoked in Org-mode by the TAB key. Its main purpose
+is outline visibility cycling, but it also invokes other actions
+in special contexts.
+
+- When this function is called with a prefix argument, rotate the entire
+ buffer through 3 states (global cycling)
+ 1. OVERVIEW: Show only top-level headlines.
+ 2. CONTENTS: Show all headlines of all levels, but no body text.
+ 3. SHOW ALL: Show everything.
+ When called with two `C-u C-u' prefixes, switch to the startup visibility,
+ determined by the variable `org-startup-folded', and by any VISIBILITY
+ properties in the buffer.
+ When called with three `C-u C-u C-u' prefixed, show the entire buffer,
+ including any drawers.
+
+- When inside a table, re-align the table and move to the next field.
+
+- When point is at the beginning of a headline, rotate the subtree started
+ by this line through 3 different states (local cycling)
+ 1. FOLDED: Only the main headline is shown.
+ 2. CHILDREN: The main headline and the direct children are shown.
+ From this state, you can move to one of the children
+ and zoom in further.
+ 3. SUBTREE: Show the entire subtree, including body text.
+ If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+- When point is at the beginning of an empty headline and the variable
+ `org-cycle-level-after-item/entry-creation' is set, cycle the level
+ of the headline by demoting and promoting it to likely levels. This
+ speeds up creation document structure by pressing TAB once or several
+ times right after creating a new headline.
+
+- When there is a numeric prefix, go up to a heading with level ARG, do
+ a `show-subtree' and return to the previous cursor position. If ARG
+ is negative, go up that many levels.
+
+- When point is not at the beginning of a headline, execute the global
+ binding for TAB, which is re-indenting the line. See the option
+ `org-cycle-emulate-tab' for details.
+
+- Special case: if point is at the beginning of the buffer and there is
+ no headline in line 1, this function will act as if called with prefix arg
+ (C-u TAB, same as S-TAB) also when called without prefix arg.
+ But only if also the variable `org-cycle-global-at-bob' is t."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
+ (and org-cycle-level-after-item/entry-creation
+ (or (org-cycle-level)
+ (org-cycle-item-indentation))))
+ (let* ((limit-level
+ (or org-cycle-max-level
+ (and (boundp 'org-inlinetask-min-level)
+ org-inlinetask-min-level
+ (1- org-inlinetask-min-level))))
+ (nstars (and limit-level
+ (if org-odd-levels-only
+ (and limit-level (1- (* limit-level 2)))
+ limit-level)))
+ (org-outline-regexp
+ (if (not (derived-mode-p 'org-mode))
+ outline-regexp
+ (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
+ (bob-special (and org-cycle-global-at-bob (not arg) (bobp)
+ (not (looking-at org-outline-regexp))))
+ (org-cycle-hook
+ (if bob-special
+ (delq 'org-optimize-window-after-visibility-change
+ (copy-sequence org-cycle-hook))
+ org-cycle-hook))
+ (pos (point)))
+
+ (if (or bob-special (equal arg '(4)))
+ ;; special case: use global cycling
+ (setq arg t))
+
+ (cond
+
+ ((equal arg '(16))
+ (setq last-command 'dummy)
+ (org-set-startup-visibility)
+ (message "Startup visibility, plus VISIBILITY properties"))
+
+ ((equal arg '(64))
+ (show-all)
+ (message "Entire buffer visible, including drawers"))
+
+ ;; Table: enter it or move to the next field.
+ ((org-at-table-p 'any)
+ (if (org-at-table.el-p)
+ (message "Use C-c ' to edit table.el tables")
+ (if arg (org-table-edit-field t)
+ (org-table-justify-field-maybe)
+ (call-interactively 'org-table-next-field))))
+
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-table-hook))
+
+ ;; Global cycling: delegate to `org-cycle-internal-global'.
+ ((eq arg t) (org-cycle-internal-global))
+
+ ;; Drawers: delegate to `org-flag-drawer'.
+ ((and org-drawers org-drawer-regexp
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-drawer-regexp)))
+ (org-flag-drawer ; toggle block visibility
+ (not (get-char-property (match-end 0) 'invisible))))
+
+ ;; Show-subtree, ARG levels up from here.
+ ((integerp arg)
+ (save-excursion
+ (org-back-to-heading)
+ (outline-up-heading (if (< arg 0) (- arg)
+ (- (funcall outline-level) arg)))
+ (org-show-subtree)))
+
+ ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
+ ((and (featurep 'org-inlinetask)
+ (org-inlinetask-at-task-p)
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-inlinetask-toggle-visibility))
+
+ ((org-try-cdlatex-tab))
+
+ ;; At an item/headline: delegate to `org-cycle-internal-local'.
+ ((and (or (and org-cycle-include-plain-lists (org-at-item-p))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-outline-regexp)))
+ (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
+ (org-cycle-internal-local))
+
+ ;; From there: TAB emulation and template completion.
+ (buffer-read-only (org-back-to-heading))
+
+ ((run-hook-with-args-until-success
+ 'org-tab-after-check-for-cycling-hook))
+
+ ((org-try-structure-completion))
+
+ ((run-hook-with-args-until-success
+ 'org-tab-before-tab-emulation-hook))
+
+ ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
+ (or (not (bolp))
+ (not (looking-at org-outline-regexp))))
+ (call-interactively (global-key-binding "\t")))
+
+ ((if (and (memq org-cycle-emulate-tab '(white whitestart))
+ (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
+ (or (and (eq org-cycle-emulate-tab 'white)
+ (= (match-end 0) (point-at-eol)))
+ (and (eq org-cycle-emulate-tab 'whitestart)
+ (>= (match-end 0) pos))))
+ t
+ (eq org-cycle-emulate-tab t))
+ (call-interactively (global-key-binding "\t")))
+
+ (t (save-excursion
+ (org-back-to-heading)
+ (org-cycle)))))))
+
+(defun org-cycle-internal-global ()
+ "Do the global cycling action."
+ ;; Hack to avoid display of messages for .org attachments in Gnus
+ (let ((ga (string-match "\\*fontification" (buffer-name))))
+ (cond
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'overview))
+ ;; We just created the overview - now do table of contents
+ ;; This can be slow in very large buffers, so indicate action
+ (run-hook-with-args 'org-pre-cycle-hook 'contents)
+ (unless ga (message "CONTENTS..."))
+ (org-content)
+ (unless ga (message "CONTENTS...done"))
+ (setq org-cycle-global-status 'contents)
+ (run-hook-with-args 'org-cycle-hook 'contents))
+
+ ((and (eq last-command this-command)
+ (eq org-cycle-global-status 'contents))
+ ;; We just showed the table of contents - now show everything
+ (run-hook-with-args 'org-pre-cycle-hook 'all)
+ (show-all)
+ (unless ga (message "SHOW ALL"))
+ (setq org-cycle-global-status 'all)
+ (run-hook-with-args 'org-cycle-hook 'all))
+
+ (t
+ ;; Default action: go to overview
+ (run-hook-with-args 'org-pre-cycle-hook 'overview)
+ (org-overview)
+ (unless ga (message "OVERVIEW"))
+ (setq org-cycle-global-status 'overview)
+ (run-hook-with-args 'org-cycle-hook 'overview)))))
+
+(defun org-cycle-internal-local ()
+ "Do the local cycling action."
+ (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+ ;; First, determine end of headline (EOH), end of subtree or item
+ ;; (EOS), and if item or heading has children (HAS-CHILDREN).
+ (save-excursion
+ (if (org-at-item-p)
+ (progn
+ (beginning-of-line)
+ (setq struct (org-list-struct))
+ (setq eoh (point-at-eol))
+ (setq eos (org-list-get-item-end-before-blank (point) struct))
+ (setq has-children (org-list-has-child-p (point) struct)))
+ (org-back-to-heading)
+ (setq eoh (save-excursion (outline-end-of-heading) (point)))
+ (setq eos (save-excursion
+ (org-end-of-subtree t)
+ (unless (eobp)
+ (skip-chars-forward " \t\n"))
+ (if (eobp) (point) (1- (point)))))
+ (setq has-children
+ (or (save-excursion
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (and (org-at-heading-p t)
+ (> (funcall outline-level) level))))
+ (save-excursion
+ (org-list-search-forward (org-item-beginning-re) eos t)))))
+ ;; Determine end invisible part of buffer (EOL)
+ (beginning-of-line 2)
+ ;; XEmacs doesn't have `next-single-char-property-change'
+ (if (featurep 'xemacs)
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (beginning-of-line 2))
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (goto-char (next-single-char-property-change (point) 'invisible))
+ (and (eolp) (beginning-of-line 2))))
+ (setq eol (point)))
+ ;; Find out what to do next and set `this-command'
+ (cond
+ ((= eos eoh)
+ ;; Nothing is hidden behind this heading
+ (run-hook-with-args 'org-pre-cycle-hook 'empty)
+ (message "EMPTY ENTRY")
+ (setq org-cycle-subtree-status nil)
+ (save-excursion
+ (goto-char eos)
+ (outline-next-heading)
+ (if (outline-invisible-p) (org-flag-heading nil))))
+ ((and (or (>= eol eos)
+ (not (string-match "\\S-" (buffer-substring eol eos))))
+ (or has-children
+ (not (setq children-skipped
+ org-cycle-skip-children-state-if-no-children))))
+ ;; Entire subtree is hidden in one line: children view
+ (run-hook-with-args 'org-pre-cycle-hook 'children)
+ (if (org-at-item-p)
+ (org-list-set-item-visibility (point-at-bol) struct 'children)
+ (org-show-entry)
+ (org-with-limited-levels (show-children))
+ ;; FIXME: This slows down the func way too much.
+ ;; How keep drawers hidden in subtree anyway?
+ ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
+ ;; (org-cycle-hide-drawers 'subtree))
+
+ ;; Fold every list in subtree to top-level items.
+ (when (eq org-cycle-include-plain-lists 'integrate)
+ (save-excursion
+ (org-back-to-heading)
+ (while (org-list-search-forward (org-item-beginning-re) eos t)
+ (beginning-of-line 1)
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (end (org-list-get-bottom-point struct)))
+ (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
+ (org-list-get-all-items (point) struct prevs))
+ (goto-char end))))))
+ (message "CHILDREN")
+ (save-excursion
+ (goto-char eos)
+ (outline-next-heading)
+ (if (outline-invisible-p) (org-flag-heading nil)))
+ (setq org-cycle-subtree-status 'children)
+ (run-hook-with-args 'org-cycle-hook 'children))
+ ((or children-skipped
+ (and (eq last-command this-command)
+ (eq org-cycle-subtree-status 'children)))
+ ;; We just showed the children, or no children are there,
+ ;; now show everything.
+ (run-hook-with-args 'org-pre-cycle-hook 'subtree)
+ (outline-flag-region eoh eos nil)
+ (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (setq org-cycle-subtree-status 'subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))
+ (t
+ ;; Default action: hide the subtree.
+ (run-hook-with-args 'org-pre-cycle-hook 'folded)
+ (outline-flag-region eoh eos t)
+ (message "FOLDED")
+ (setq org-cycle-subtree-status 'folded)
+ (run-hook-with-args 'org-cycle-hook 'folded)))))
+
+;;;###autoload
+(defun org-global-cycle (&optional arg)
+ "Cycle the global visibility. For details see `org-cycle'.
+With \\[universal-argument] prefix arg, switch to startup visibility.
+With a numeric prefix, show all headlines up to that level."
+ (interactive "P")
+ (let ((org-cycle-include-plain-lists
+ (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil)))
+ (cond
+ ((integerp arg)
+ (show-all)
+ (hide-sublevels arg)
+ (setq org-cycle-global-status 'contents))
+ ((equal arg '(4))
+ (org-set-startup-visibility)
+ (message "Startup visibility, plus VISIBILITY properties."))
+ (t
+ (org-cycle '(4))))))
+
+(defun org-set-startup-visibility ()
+ "Set the visibility required by startup options and properties."
+ (cond
+ ((eq org-startup-folded t)
+ (org-cycle '(4)))
+ ((eq org-startup-folded 'content)
+ (let ((this-command 'org-cycle) (last-command 'org-cycle))
+ (org-cycle '(4)) (org-cycle '(4)))))
+ (unless (eq org-startup-folded 'showeverything)
+ (if org-hide-block-startup (org-hide-block-all))
+ (org-set-visibility-according-to-property 'no-cleanup)
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines t)))
+
+(defun org-set-visibility-according-to-property (&optional no-cleanup)
+ "Switch subtree visibilities according to :VISIBILITY: property."
+ (interactive)
+ (let (org-show-entry-below state)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)"
+ nil t)
+ (setq state (match-string 1))
+ (save-excursion
+ (org-back-to-heading t)
+ (hide-subtree)
+ (org-reveal)
+ (cond
+ ((equal state '("fold" "folded"))
+ (hide-subtree))
+ ((equal state "children")
+ (org-show-hidden-entry)
+ (show-children))
+ ((equal state "content")
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-content))))
+ ((member state '("all" "showall"))
+ (show-subtree)))))
+ (unless no-cleanup
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'all)))))
+
+;; This function uses outline-regexp instead of the more fundamental
+;; org-outline-regexp so that org-cycle-global works outside of Org
+;; buffers, where outline-regexp is needed.
+(defun org-overview ()
+ "Switch to overview mode, showing only top-level headlines.
+Really, this shows all headlines with level equal or greater than the level
+of the first headline in the buffer. This is important, because if the
+first headline is not level one, then (hide-sublevels 1) gives confusing
+results."
+ (interactive)
+ (let ((level (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" outline-regexp) nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (funcall outline-level))))))
+ (and level (hide-sublevels level))))
+
+(defun org-content (&optional arg)
+ "Show all headlines in the buffer, like a table of contents.
+With numerical argument N, show content up to level N."
+ (interactive "P")
+ (save-excursion
+ ;; Visit all headings and show their offspring
+ (and (integerp arg) (org-overview))
+ (goto-char (point-max))
+ (catch 'exit
+ (while (and (progn (condition-case nil
+ (outline-previous-visible-heading 1)
+ (error (goto-char (point-min))))
+ t)
+ (looking-at org-outline-regexp))
+ (if (integerp arg)
+ (show-children (1- arg))
+ (show-branches))
+ (if (bobp) (throw 'exit nil))))))
+
+
+(defun org-optimize-window-after-visibility-change (state)
+ "Adjust the window after a change in outline visibility.
+This function is the default value of the hook `org-cycle-hook'."
+ (when (get-buffer-window (current-buffer))
+ (cond
+ ((eq state 'content) nil)
+ ((eq state 'all) nil)
+ ((eq state 'folded) nil)
+ ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
+ ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
+
+(defun org-remove-empty-overlays-at (pos)
+ "Remove outline overlays that do not contain non-white stuff."
+ (mapc
+ (lambda (o)
+ (and (eq 'outline (overlay-get o 'invisible))
+ (not (string-match "\\S-" (buffer-substring (overlay-start o)
+ (overlay-end o))))
+ (delete-overlay o)))
+ (overlays-at pos)))
+
+(defun org-clean-visibility-after-subtree-move ()
+ "Fix visibility issues after moving a subtree."
+ ;; First, find a reasonable region to look at:
+ ;; Start two siblings above, end three below
+ (let* ((beg (save-excursion
+ (and (org-get-last-sibling)
+ (org-get-last-sibling))
+ (point)))
+ (end (save-excursion
+ (and (org-get-next-sibling)
+ (org-get-next-sibling)
+ (org-get-next-sibling))
+ (if (org-at-heading-p)
+ (point-at-eol)
+ (point))))
+ (level (looking-at "\\*+"))
+ (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (when re
+ ;; Properly fold already folded siblings
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (if (and (not (outline-invisible-p))
+ (save-excursion
+ (goto-char (point-at-eol)) (outline-invisible-p)))
+ (hide-entry))))
+ (org-cycle-show-empty-lines 'overview)
+ (org-cycle-hide-drawers 'overview)))))
+
+(defun org-cycle-show-empty-lines (state)
+ "Show empty lines above all visible headlines.
+The region to be covered depends on STATE when called through
+`org-cycle-hook'. Lisp program can use t for STATE to get the
+entire buffer covered. Note that an empty line is only shown if there
+are at least `org-cycle-separator-lines' empty lines before the headline."
+ (when (not (= org-cycle-separator-lines 0))
+ (save-excursion
+ (let* ((n (abs org-cycle-separator-lines))
+ (re (cond
+ ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
+ ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
+ (t (let ((ns (number-to-string (- n 2))))
+ (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
+ "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
+ beg end b e)
+ (cond
+ ((memq state '(overview contents t))
+ (setq beg (point-min) end (point-max)))
+ ((memq state '(children folded))
+ (setq beg (point) end (progn (org-end-of-subtree t t)
+ (beginning-of-line 2)
+ (point)))))
+ (when beg
+ (goto-char beg)
+ (while (re-search-forward re end t)
+ (unless (get-char-property (match-end 1) 'invisible)
+ (setq e (match-end 1))
+ (if (< org-cycle-separator-lines 0)
+ (setq b (save-excursion
+ (goto-char (match-beginning 0))
+ (org-back-over-empty-lines)
+ (if (save-excursion
+ (goto-char (max (point-min) (1- (point))))
+ (org-at-heading-p))
+ (1- (point))
+ (point))))
+ (setq b (match-beginning 1)))
+ (outline-flag-region b e nil)))))))
+ ;; Never hide empty lines at the end of the file.
+ (save-excursion
+ (goto-char (point-max))
+ (outline-previous-heading)
+ (outline-end-of-heading)
+ (if (and (looking-at "[ \t\n]+")
+ (= (match-end 0) (point-max)))
+ (outline-flag-region (point) (match-end 0) nil))))
+
+(defun org-show-empty-lines-in-parent ()
+ "Move to the parent and re-show empty lines before visible headlines."
+ (save-excursion
+ (let ((context (if (org-up-heading-safe) 'children 'overview)))
+ (org-cycle-show-empty-lines context))))
+
+(defun org-files-list ()
+ "Return `org-agenda-files' list, plus all open org-mode files.
+This is useful for operations that need to scan all of a user's
+open and agenda-wise Org files."
+ (let ((files (mapcar 'expand-file-name (org-agenda-files))))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if (and (derived-mode-p 'org-mode) (buffer-file-name))
+ (let ((file (expand-file-name (buffer-file-name))))
+ (unless (member file files)
+ (push file files))))))
+ files))
+
+(defsubst org-entry-beginning-position ()
+ "Return the beginning position of the current entry."
+ (save-excursion (outline-back-to-heading t) (point)))
+
+(defsubst org-entry-end-position ()
+ "Return the end position of the current entry."
+ (save-excursion (outline-next-heading) (point)))
+
+(defun org-cycle-hide-drawers (state)
+ "Re-hide all drawers after a visibility state change."
+ (when (and (derived-mode-p 'org-mode)
+ (not (memq state '(overview folded contents))))
+ (save-excursion
+ (let* ((globalp (memq state '(contents all)))
+ (beg (if globalp (point-min) (point)))
+ (end (if globalp (point-max)
+ (if (eq state 'children)
+ (save-excursion (outline-next-heading) (point))
+ (org-end-of-subtree t)))))
+ (goto-char beg)
+ (while (re-search-forward org-drawer-regexp end t)
+ (org-flag-drawer t))))))
+
+(defun org-flag-drawer (flag)
+ "When FLAG is non-nil, hide the drawer we are within.
+Otherwise make it visible."
+ (save-excursion
+ (beginning-of-line 1)
+ (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
+ (let ((b (match-end 0)))
+ (if (re-search-forward
+ "^[ \t]*:END:"
+ (save-excursion (outline-next-heading) (point)) t)
+ (outline-flag-region b (point-at-eol) flag)
+ (error ":END: line missing at position %s" b))))))
+
+(defun org-subtree-end-visible-p ()
+ "Is the end of the current subtree visible?"
+ (pos-visible-in-window-p
+ (save-excursion (org-end-of-subtree t) (point))))
+
+(defun org-first-headline-recenter (&optional N)
+ "Move cursor to the first headline and recenter the headline.
+Optional argument N means put the headline into the Nth line of the window."
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
+ (beginning-of-line)
+ (recenter (prefix-numeric-value N))))
+
+;;; Saving and restoring visibility
+
+(defun org-outline-overlay-data (&optional use-markers)
+ "Return a list of the locations of all outline overlays.
+These are overlays with the `invisible' property value `outline'.
+The return value is a list of cons cells, with start and stop
+positions for each overlay.
+If USE-MARKERS is set, return the positions as markers."
+ (let (beg end)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (delq nil
+ (mapcar (lambda (o)
+ (when (eq (overlay-get o 'invisible) 'outline)
+ (setq beg (overlay-start o)
+ end (overlay-end o))
+ (and beg end (> end beg)
+ (if use-markers
+ (cons (move-marker (make-marker) beg)
+ (move-marker (make-marker) end))
+ (cons beg end)))))
+ (overlays-in (point-min) (point-max))))))))
+
+(defun org-set-outline-overlay-data (data)
+ "Create visibility overlays for all positions in DATA.
+DATA should have been made by `org-outline-overlay-data'."
+ (let (o)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (show-all)
+ (mapc (lambda (c)
+ (outline-flag-region (car c) (cdr c) t))
+ data)))))
+
+;;; Folding of blocks
+
+(defvar org-hide-block-overlays nil
+ "Overlays hiding blocks.")
+(make-variable-buffer-local 'org-hide-block-overlays)
+
+(defun org-block-map (function &optional start end)
+ "Call FUNCTION at the head of all source blocks in the current buffer.
+Optional arguments START and END can be used to limit the range."
+ (let ((start (or start (point-min)))
+ (end (or end (point-max))))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end) (re-search-forward org-block-regexp end t))
+ (save-excursion
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (funcall function)))))))
+
+(defun org-hide-block-toggle-all ()
+ "Toggle the visibility of all blocks in the current buffer."
+ (org-block-map #'org-hide-block-toggle))
+
+(defun org-hide-block-all ()
+ "Fold all blocks in the current buffer."
+ (interactive)
+ (org-show-block-all)
+ (org-block-map #'org-hide-block-toggle-maybe))
+
+(defun org-show-block-all ()
+ "Unfold all blocks in the current buffer."
+ (interactive)
+ (mapc 'delete-overlay org-hide-block-overlays)
+ (setq org-hide-block-overlays nil))
+
+(defun org-hide-block-toggle-maybe ()
+ "Toggle visibility of block at point."
+ (interactive)
+ (let ((case-fold-search t))
+ (if (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-block-regexp))
+ (progn (org-hide-block-toggle)
+ t) ;; to signal that we took action
+ nil))) ;; to signal that we did not
+
+(defun org-hide-block-toggle (&optional force)
+ "Toggle the visibility of the current block."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward org-block-regexp nil t)
+ (let ((start (- (match-beginning 4) 1)) ;; beginning of body
+ (end (match-end 0)) ;; end of entire body
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-hide-block))
+ (overlays-at start)))
+ (if (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-hide-block-overlays)
+ (setq org-hide-block-overlays
+ (delq ov org-hide-block-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-hide-block)
+ (delete-overlay ov)))
+ (overlays-at start)))
+ (setq ov (make-overlay start end))
+ (overlay-put ov 'invisible 'org-hide-block)
+ ;; make the block accessible to isearch
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-hide-block-overlays)
+ (setq org-hide-block-overlays
+ (delq ov org-hide-block-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-hide-block)
+ (delete-overlay ov))))
+ (push ov org-hide-block-overlays)))
+ (error "Not looking at a source block"))))
+
+;; org-tab-after-check-for-cycling-hook
+(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
+;; Remove overlays when changing major mode
+(add-hook 'org-mode-hook
+ (lambda () (org-add-hook 'change-major-mode-hook
+ 'org-show-block-all 'append 'local)))
+
+;;; Org-goto
+
+(defvar org-goto-window-configuration nil)
+(defvar org-goto-marker nil)
+(defvar org-goto-map
+ (let ((map (make-sparse-keymap)))
+ (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd)
+ (while (setq cmd (pop cmds))
+ (substitute-key-definition cmd cmd map global-map)))
+ (suppress-keymap map)
+ (org-defkey map "\C-m" 'org-goto-ret)
+ (org-defkey map [(return)] 'org-goto-ret)
+ (org-defkey map [(left)] 'org-goto-left)
+ (org-defkey map [(right)] 'org-goto-right)
+ (org-defkey map [(control ?g)] 'org-goto-quit)
+ (org-defkey map "\C-i" 'org-cycle)
+ (org-defkey map [(tab)] 'org-cycle)
+ (org-defkey map [(down)] 'outline-next-visible-heading)
+ (org-defkey map [(up)] 'outline-previous-visible-heading)
+ (if org-goto-auto-isearch
+ (if (fboundp 'define-key-after)
+ (define-key-after map [t] 'org-goto-local-auto-isearch)
+ nil)
+ (org-defkey map "q" 'org-goto-quit)
+ (org-defkey map "n" 'outline-next-visible-heading)
+ (org-defkey map "p" 'outline-previous-visible-heading)
+ (org-defkey map "f" 'outline-forward-same-level)
+ (org-defkey map "b" 'outline-backward-same-level)
+ (org-defkey map "u" 'outline-up-heading))
+ (org-defkey map "/" 'org-occur)
+ (org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
+ (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
+ (org-defkey map "\C-c\C-f" 'outline-forward-same-level)
+ (org-defkey map "\C-c\C-b" 'outline-backward-same-level)
+ (org-defkey map "\C-c\C-u" 'outline-up-heading)
+ map))
+
+(defconst org-goto-help
+ "Browse buffer copy, to find location or copy text. Just type for auto-isearch.
+RET=jump to location [Q]uit and return to previous location
+\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
+
+(defvar org-goto-start-pos) ; dynamically scoped parameter
+
+;; FIXME: Docstring does not mention both interfaces
+(defun org-goto (&optional alternative-interface)
+ "Look up a different location in the current file, keeping current visibility.
+
+When you want look-up or go to a different location in a
+document, the fastest way is often to fold the entire buffer and
+then dive into the tree. This method has the disadvantage, that
+the previous location will be folded, which may not be what you
+want.
+
+This command works around this by showing a copy of the current
+buffer in an indirect buffer, in overview mode. You can dive
+into the tree in that copy, use org-occur and incremental search
+to find a location. When pressing RET or `Q', the command
+returns to the original buffer in which the visibility is still
+unchanged. After RET it will also jump to the location selected
+in the indirect buffer and expose the headline hierarchy above.
+
+With a prefix argument, use the alternative interface: e.g. if
+`org-goto-interface' is 'outline use 'outline-path-completion."
+ (interactive "P")
+ (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
+ (org-refile-use-outline-path t)
+ (org-refile-target-verify-function nil)
+ (interface
+ (if (not alternative-interface)
+ org-goto-interface
+ (if (eq org-goto-interface 'outline)
+ 'outline-path-completion
+ 'outline)))
+ (org-goto-start-pos (point))
+ (selected-point
+ (if (eq interface 'outline)
+ (car (org-get-location (current-buffer) org-goto-help))
+ (let ((pa (org-refile-get-location "Goto" nil nil t)))
+ (org-refile-check-position pa)
+ (nth 3 pa)))))
+ (if selected-point
+ (progn
+ (org-mark-ring-push org-goto-start-pos)
+ (goto-char selected-point)
+ (if (or (outline-invisible-p) (org-invisible-p2))
+ (org-show-context 'org-goto)))
+ (message "Quit"))))
+
+(defvar org-goto-selected-point nil) ; dynamically scoped parameter
+(defvar org-goto-exit-command nil) ; dynamically scoped parameter
+(defvar org-goto-local-auto-isearch-map) ; defined below
+
+(defun org-get-location (buf help)
+ "Let the user select a location in the Org-mode buffer BUF.
+This function uses a recursive edit. It returns the selected position
+or nil."
+ (let ((isearch-mode-map org-goto-local-auto-isearch-map)
+ (isearch-hide-immediately nil)
+ (isearch-search-fun-function
+ (lambda () 'org-goto-local-search-headings))
+ (org-goto-selected-point org-goto-exit-command)
+ (pop-up-frames nil)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (special-display-function nil))
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
+ (org-pop-to-buffer-same-window
+ (condition-case nil
+ (make-indirect-buffer (current-buffer) "*org-goto*")
+ (error (make-indirect-buffer (current-buffer) "*org-goto*"))))
+ (with-output-to-temp-buffer "*Help*"
+ (princ help))
+ (org-fit-window-to-buffer (get-buffer-window "*Help*"))
+ (setq buffer-read-only nil)
+ (let ((org-startup-truncated t)
+ (org-startup-folded nil)
+ (org-startup-align-all-tables nil))
+ (org-mode)
+ (org-overview))
+ (setq buffer-read-only t)
+ (if (and (boundp 'org-goto-start-pos)
+ (integer-or-marker-p org-goto-start-pos))
+ (let ((org-show-hierarchy-above t)
+ (org-show-siblings t)
+ (org-show-following-heading t))
+ (goto-char org-goto-start-pos)
+ (and (outline-invisible-p) (org-show-context)))
+ (goto-char (point-min)))
+ (let (org-special-ctrl-a/e) (org-beginning-of-line))
+ (message "Select location and press RET")
+ (use-local-map org-goto-map)
+ (recursive-edit)
+ ))
+ (kill-buffer "*org-goto*")
+ (cons org-goto-selected-point org-goto-exit-command)))
+
+(defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
+(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
+(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
+(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)
+
+(defun org-goto-local-search-headings (string bound noerror)
+ "Search and make sure that any matches are in headlines."
+ (catch 'return
+ (while (if isearch-forward
+ (search-forward string bound noerror)
+ (search-backward string bound noerror))
+ (when (let ((context (mapcar 'car (save-match-data (org-context)))))
+ (and (member :headline context)
+ (not (member :tags context))))
+ (throw 'return (point))))))
+
+(defun org-goto-local-auto-isearch ()
+ "Start isearch."
+ (interactive)
+ (goto-char (point-min))
+ (let ((keys (this-command-keys)))
+ (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
+ (isearch-mode t)
+ (isearch-process-search-char (string-to-char keys)))))
+
+(defun org-goto-ret (&optional arg)
+ "Finish `org-goto' by going to the new location."
+ (interactive "P")
+ (setq org-goto-selected-point (point)
+ org-goto-exit-command 'return)
+ (throw 'exit nil))
+
+(defun org-goto-left ()
+ "Finish `org-goto' by going to the new location."
+ (interactive)
+ (if (org-at-heading-p)
+ (progn
+ (beginning-of-line 1)
+ (setq org-goto-selected-point (point)
+ org-goto-exit-command 'left)
+ (throw 'exit nil))
+ (error "Not on a heading")))
+
+(defun org-goto-right ()
+ "Finish `org-goto' by going to the new location."
+ (interactive)
+ (if (org-at-heading-p)
+ (progn
+ (setq org-goto-selected-point (point)
+ org-goto-exit-command 'right)
+ (throw 'exit nil))
+ (error "Not on a heading")))
+
+(defun org-goto-quit ()
+ "Finish `org-goto' without cursor motion."
+ (interactive)
+ (setq org-goto-selected-point nil)
+ (setq org-goto-exit-command 'quit)
+ (throw 'exit nil))
+
+;;; Indirect buffer display of subtrees
+
+(defvar org-indirect-dedicated-frame nil
+ "This is the frame being used for indirect tree display.")
+(defvar org-last-indirect-buffer nil)
+
+(defun org-tree-to-indirect-buffer (&optional arg)
+ "Create indirect buffer and narrow it to current subtree.
+With a numerical prefix ARG, go up to this level and then take that tree.
+If ARG is negative, go up that many levels.
+
+If `org-indirect-buffer-display' is not `new-frame', the command removes the
+indirect buffer previously made with this command, to avoid proliferation of
+indirect buffers. However, when you call the command with a \
+\\[universal-argument] prefix, or
+when `org-indirect-buffer-display' is `new-frame', the last buffer
+is kept so that you can work with several indirect buffers at the same time.
+If `org-indirect-buffer-display' is `dedicated-frame', the \
+\\[universal-argument] prefix also
+requests that a new frame be made for the new buffer, so that the dedicated
+frame is not changed."
+ (interactive "P")
+ (let ((cbuf (current-buffer))
+ (cwin (selected-window))
+ (pos (point))
+ beg end level heading ibuf)
+ (save-excursion
+ (org-back-to-heading t)
+ (when (numberp arg)
+ (setq level (org-outline-level))
+ (if (< arg 0) (setq arg (+ level arg)))
+ (while (> (setq level (org-outline-level)) arg)
+ (org-up-heading-safe)))
+ (setq beg (point)
+ heading (org-get-heading))
+ (org-end-of-subtree t t)
+ (if (org-at-heading-p) (backward-char 1))
+ (setq end (point)))
+ (if (and (buffer-live-p org-last-indirect-buffer)
+ (not (eq org-indirect-buffer-display 'new-frame))
+ (not arg))
+ (kill-buffer org-last-indirect-buffer))
+ (setq ibuf (org-get-indirect-buffer cbuf)
+ org-last-indirect-buffer ibuf)
+ (cond
+ ((or (eq org-indirect-buffer-display 'new-frame)
+ (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
+ (select-frame (make-frame))
+ (delete-other-windows)
+ (org-pop-to-buffer-same-window ibuf)
+ (org-set-frame-title heading))
+ ((eq org-indirect-buffer-display 'dedicated-frame)
+ (raise-frame
+ (select-frame (or (and org-indirect-dedicated-frame
+ (frame-live-p org-indirect-dedicated-frame)
+ org-indirect-dedicated-frame)
+ (setq org-indirect-dedicated-frame (make-frame)))))
+ (delete-other-windows)
+ (org-pop-to-buffer-same-window ibuf)
+ (org-set-frame-title (concat "Indirect: " heading)))
+ ((eq org-indirect-buffer-display 'current-window)
+ (org-pop-to-buffer-same-window ibuf))
+ ((eq org-indirect-buffer-display 'other-window)
+ (pop-to-buffer ibuf))
+ (t (error "Invalid value")))
+ (if (featurep 'xemacs)
+ (save-excursion (org-mode) (turn-on-font-lock)))
+ (narrow-to-region beg end)
+ (show-all)
+ (goto-char pos)
+ (run-hook-with-args 'org-cycle-hook 'all)
+ (and (window-live-p cwin) (select-window cwin))))
+
+(defun org-get-indirect-buffer (&optional buffer)
+ (setq buffer (or buffer (current-buffer)))
+ (let ((n 1) (base (buffer-name buffer)) bname)
+ (while (buffer-live-p
+ (get-buffer (setq bname (concat base "-" (number-to-string n)))))
+ (setq n (1+ n)))
+ (condition-case nil
+ (make-indirect-buffer buffer bname 'clone)
+ (error (make-indirect-buffer buffer bname)))))
+
+(defun org-set-frame-title (title)
+ "Set the title of the current frame to the string TITLE."
+ ;; FIXME: how to name a single frame in XEmacs???
+ (unless (featurep 'xemacs)
+ (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
+
+;;;; Structure editing
+
+;;; Inserting headlines
+
+(defun org-previous-line-empty-p ()
+ (save-excursion
+ (and (not (bobp))
+ (or (beginning-of-line 0) t)
+ (save-match-data
+ (looking-at "[ \t]*$")))))
+
+(defun org-insert-heading (&optional force-heading invisible-ok)
+ "Insert a new heading or item with same depth at point.
+If point is in a plain list and FORCE-HEADING is nil, create a new list item.
+If point is at the beginning of a headline, insert a sibling before the
+current headline. If point is not at the beginning, split the line,
+create the new headline with the text in the current line after point
+\(but see also the variable `org-M-RET-may-split-line').
+
+When INVISIBLE-OK is set, stop at invisible headlines when going back.
+This is important for non-interactive uses of the command."
+ (interactive "P")
+ (if (or (= (buffer-size) 0)
+ (and (not (save-excursion
+ (and (ignore-errors (org-back-to-heading invisible-ok))
+ (org-at-heading-p))))
+ (or force-heading (not (org-in-item-p)))))
+ (progn
+ (insert "\n* ")
+ (run-hooks 'org-insert-heading-hook))
+ (when (or force-heading (not (org-insert-item)))
+ (let* ((empty-line-p nil)
+ (level nil)
+ (on-heading (org-at-heading-p))
+ (head (save-excursion
+ (condition-case nil
+ (progn
+ (org-back-to-heading invisible-ok)
+ (when (and (not on-heading)
+ (featurep 'org-inlinetask)
+ (integerp org-inlinetask-min-level)
+ (>= (length (match-string 0))
+ org-inlinetask-min-level))
+ ;; Find a heading level before the inline task
+ (while (and (setq level (org-up-heading-safe))
+ (>= level org-inlinetask-min-level)))
+ (if (org-at-heading-p)
+ (org-back-to-heading invisible-ok)
+ (error "This should not happen")))
+ (setq empty-line-p (org-previous-line-empty-p))
+ (match-string 0))
+ (error "*"))))
+ (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
+ (blank (if (eq blank-a 'auto) empty-line-p blank-a))
+ pos hide-previous previous-pos)
+ (cond
+ ((and (org-at-heading-p) (bolp)
+ (or (bobp)
+ (save-excursion (backward-char 1) (not (outline-invisible-p)))))
+ ;; insert before the current line
+ (open-line (if blank 2 1)))
+ ((and (bolp)
+ (not org-insert-heading-respect-content)
+ (or (bobp)
+ (save-excursion
+ (backward-char 1) (not (outline-invisible-p)))))
+ ;; insert right here
+ nil)
+ (t
+ ;; somewhere in the line
+ (save-excursion
+ (setq previous-pos (point-at-bol))
+ (end-of-line)
+ (setq hide-previous (outline-invisible-p)))
+ (and org-insert-heading-respect-content (org-show-subtree))
+ (let ((split
+ (and (org-get-alist-option org-M-RET-may-split-line 'headline)
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-at-bol))
+ (and (looking-at org-complex-heading-regexp)
+ (match-beginning 4)
+ (> p (match-beginning 4)))))))
+ tags pos)
+ (cond
+ (org-insert-heading-respect-content
+ (org-end-of-subtree nil t)
+ (when (featurep 'org-inlinetask)
+ (while (and (not (eobp))
+ (looking-at "\\(\\*+\\)[ \t]+")
+ (>= (length (match-string 1))
+ org-inlinetask-min-level))
+ (org-end-of-subtree nil t)))
+ (or (bolp) (newline))
+ (or (org-previous-line-empty-p)
+ (and blank (newline)))
+ (open-line 1))
+ ((org-at-heading-p)
+ (when hide-previous
+ (show-children)
+ (org-show-entry))
+ (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
+ (setq tags (and (match-end 2) (match-string 2)))
+ (and (match-end 1)
+ (delete-region (match-beginning 1) (match-end 1)))
+ (setq pos (point-at-bol))
+ (or split (end-of-line 1))
+ (delete-horizontal-space)
+ (if (string-match "\\`\\*+\\'"
+ (buffer-substring (point-at-bol) (point)))
+ (insert " "))
+ (newline (if blank 2 1))
+ (when tags
+ (save-excursion
+ (goto-char pos)
+ (end-of-line 1)
+ (insert " " tags)
+ (org-set-tags nil 'align))))
+ (t
+ (or split (end-of-line 1))
+ (newline (if blank 2 1)))))))
+ (insert head) (just-one-space)
+ (setq pos (point))
+ (end-of-line 1)
+ (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
+ (when (and org-insert-heading-respect-content hide-previous)
+ (save-excursion
+ (goto-char previous-pos)
+ (hide-subtree)))
+ (run-hooks 'org-insert-heading-hook)))))
+
+(defun org-get-heading (&optional no-tags no-todo)
+ "Return the heading of the current entry, without the stars.
+When NO-TAGS is non-nil, don't include tags.
+When NO-TODO is non-nil, don't include TODO keywords."
+ (save-excursion
+ (org-back-to-heading t)
+ (cond
+ ((and no-tags no-todo)
+ (looking-at org-complex-heading-regexp)
+ (match-string 4))
+ (no-tags
+ (looking-at (concat org-outline-regexp
+ "\\(.*?\\)"
+ "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
+ (match-string 1))
+ (no-todo
+ (looking-at org-todo-line-regexp)
+ (match-string 3))
+ (t (looking-at org-heading-regexp)
+ (match-string 2)))))
+
+(defun org-heading-components ()
+ "Return the components of the current heading.
+This is a list with the following elements:
+- the level as an integer
+- the reduced level, different if `org-odd-levels-only' is set.
+- the TODO keyword, or nil
+- the priority character, like ?A, or nil if no priority is given
+- the headline text itself, or the tags string if no headline text
+- the tags string, or nil."
+ (save-excursion
+ (org-back-to-heading t)
+ (if (let (case-fold-search) (looking-at org-complex-heading-regexp))
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ (org-match-string-no-properties 2)
+ (and (match-end 3) (aref (match-string 3) 2))
+ (org-match-string-no-properties 4)
+ (org-match-string-no-properties 5)))))
+
+(defun org-get-entry ()
+ "Get the entry text, after heading, entire subtree."
+ (save-excursion
+ (org-back-to-heading t)
+ (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+
+(defun org-insert-heading-after-current ()
+ "Insert a new heading with same level as current, after current subtree."
+ (interactive)
+ (org-back-to-heading)
+ (org-insert-heading)
+ (org-move-subtree-down)
+ (end-of-line 1))
+
+(defun org-insert-heading-respect-content ()
+ (interactive)
+ (let ((org-insert-heading-respect-content t))
+ (org-insert-heading t)))
+
+(defun org-insert-todo-heading-respect-content (&optional force-state)
+ (interactive "P")
+ (let ((org-insert-heading-respect-content t))
+ (org-insert-todo-heading force-state t)))
+
+(defun org-insert-todo-heading (arg &optional force-heading)
+ "Insert a new heading with the same level and TODO state as current heading.
+If the heading has no TODO state, or if the state is DONE, use the first
+state (TODO by default). Also with prefix arg, force first state."
+ (interactive "P")
+ (when (or force-heading (not (org-insert-item 'checkbox)))
+ (org-insert-heading force-heading)
+ (save-excursion
+ (org-back-to-heading)
+ (outline-previous-heading)
+ (looking-at org-todo-line-regexp))
+ (let*
+ ((new-mark-x
+ (if (or arg
+ (not (match-beginning 2))
+ (member (match-string 2) org-done-keywords))
+ (car org-todo-keywords-1)
+ (match-string 2)))
+ (new-mark
+ (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook new-mark-x nil)
+ new-mark-x)))
+ (beginning-of-line 1)
+ (and (looking-at org-outline-regexp) (goto-char (match-end 0))
+ (if org-treat-insert-todo-heading-as-state-change
+ (org-todo new-mark)
+ (insert new-mark " "))))
+ (when org-provide-todo-statistics
+ (org-update-parent-todo-statistics))))
+
+(defun org-insert-subheading (arg)
+ "Insert a new subheading and demote it.
+Works for outline headings and for plain lists alike."
+ (interactive "P")
+ (org-insert-heading arg)
+ (cond
+ ((org-at-heading-p) (org-do-demote))
+ ((org-at-item-p) (org-indent-item))))
+
+(defun org-insert-todo-subheading (arg)
+ "Insert a new subheading with TODO keyword or checkbox and demote it.
+Works for outline headings and for plain lists alike."
+ (interactive "P")
+ (org-insert-todo-heading arg)
+ (cond
+ ((org-at-heading-p) (org-do-demote))
+ ((org-at-item-p) (org-indent-item))))
+
+;;; Promotion and Demotion
+
+(defvar org-after-demote-entry-hook nil
+ "Hook run after an entry has been demoted.
+The cursor will be at the beginning of the entry.
+When a subtree is being demoted, the hook will be called for each node.")
+
+(defvar org-after-promote-entry-hook nil
+ "Hook run after an entry has been promoted.
+The cursor will be at the beginning of the entry.
+When a subtree is being promoted, the hook will be called for each node.")
+
+(defun org-promote-subtree ()
+ "Promote the entire subtree.
+See also `org-promote'."
+ (interactive)
+ (save-excursion
+ (org-with-limited-levels (org-map-tree 'org-promote)))
+ (org-fix-position-after-promote))
+
+(defun org-demote-subtree ()
+ "Demote the entire subtree. See `org-demote'.
+See also `org-promote'."
+ (interactive)
+ (save-excursion
+ (org-with-limited-levels (org-map-tree 'org-demote)))
+ (org-fix-position-after-promote))
+
+
+(defun org-do-promote ()
+ "Promote the current heading higher up the tree.
+If the region is active in `transient-mark-mode', promote all headings
+in the region."
+ (interactive)
+ (save-excursion
+ (if (org-region-active-p)
+ (org-map-region 'org-promote (region-beginning) (region-end))
+ (org-promote)))
+ (org-fix-position-after-promote))
+
+(defun org-do-demote ()
+ "Demote the current heading lower down the tree.
+If the region is active in `transient-mark-mode', demote all headings
+in the region."
+ (interactive)
+ (save-excursion
+ (if (org-region-active-p)
+ (org-map-region 'org-demote (region-beginning) (region-end))
+ (org-demote)))
+ (org-fix-position-after-promote))
+
+(defun org-fix-position-after-promote ()
+ "Make sure that after pro/demotion cursor position is right."
+ (let ((pos (point)))
+ (when (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-todo-line-regexp)
+ (or (equal pos (match-end 1)) (equal pos (match-end 2))))
+ (cond ((eobp) (insert " "))
+ ((eolp) (insert " "))
+ ((equal (char-after) ?\ ) (forward-char 1))))))
+
+(defun org-current-level ()
+ "Return the level of the current entry, or nil if before the first headline.
+The level is the number of stars at the beginning of the headline."
+ (save-excursion
+ (org-with-limited-levels
+ (if (ignore-errors (org-back-to-heading t))
+ (funcall outline-level)))))
+
+(defun org-get-previous-line-level ()
+ "Return the outline depth of the last headline before the current line.
+Returns 0 for the first headline in the buffer, and nil if before the
+first headline."
+ (let ((current-level (org-current-level))
+ (prev-level (when (> (line-number-at-pos) 1)
+ (save-excursion
+ (beginning-of-line 0)
+ (org-current-level)))))
+ (cond ((null current-level) nil) ; Before first headline
+ ((null prev-level) 0) ; At first headline
+ (prev-level))))
+
+(defun org-reduced-level (l)
+ "Compute the effective level of a heading.
+This takes into account the setting of `org-odd-levels-only'."
+ (cond
+ ((zerop l) 0)
+ (org-odd-levels-only (1+ (floor (/ l 2))))
+ (t l)))
+
+(defun org-level-increment ()
+ "Return the number of stars that will be added or removed at a
+time to headlines when structure editing, based on the value of
+`org-odd-levels-only'."
+ (if org-odd-levels-only 2 1))
+
+(defun org-get-valid-level (level &optional change)
+ "Rectify a level change under the influence of `org-odd-levels-only'
+LEVEL is a current level, CHANGE is by how much the level should be
+modified. Even if CHANGE is nil, LEVEL may be returned modified because
+even level numbers will become the next higher odd number."
+ (if org-odd-levels-only
+ (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
+ ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
+ ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
+ (max 1 (+ level (or change 0)))))
+
+(if (boundp 'define-obsolete-function-alias)
+ (if (or (featurep 'xemacs) (< emacs-major-version 23))
+ (define-obsolete-function-alias 'org-get-legal-level
+ 'org-get-valid-level)
+ (define-obsolete-function-alias 'org-get-legal-level
+ 'org-get-valid-level "23.1")))
+
+(defvar org-called-with-limited-levels nil) ;; Dynamically bound in
+;; ̀org-with-limited-levels'
+(defun org-promote ()
+ "Promote the current heading higher up the tree.
+If the region is active in `transient-mark-mode', promote all headings
+in the region."
+ (org-back-to-heading t)
+ (let* ((level (save-match-data (funcall outline-level)))
+ (after-change-functions (remove 'flyspell-after-change-function
+ after-change-functions))
+ (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
+ (diff (abs (- level (length up-head) -1))))
+ (cond ((and (= level 1) org-called-with-limited-levels
+ org-allow-promoting-top-level-subtree)
+ (replace-match "# " nil t))
+ ((= level 1)
+ (error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (t (replace-match up-head nil t)))
+ ;; Fixup tag positioning
+ (unless (= level 1)
+ (and org-auto-align-tags (org-set-tags nil t))
+ (if org-adapt-indentation (org-fixup-indentation (- diff))))
+ (run-hooks 'org-after-promote-entry-hook)))
+
+(defun org-demote ()
+ "Demote the current heading lower down the tree.
+If the region is active in `transient-mark-mode', demote all headings
+in the region."
+ (org-back-to-heading t)
+ (let* ((level (save-match-data (funcall outline-level)))
+ (after-change-functions (remove 'flyspell-after-change-function
+ after-change-functions))
+ (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
+ (diff (abs (- level (length down-head) -1))))
+ (replace-match down-head nil t)
+ ;; Fixup tag positioning
+ (and org-auto-align-tags (org-set-tags nil t))
+ (if org-adapt-indentation (org-fixup-indentation diff))
+ (run-hooks 'org-after-demote-entry-hook)))
+
+(defun org-cycle-level ()
+ "Cycle the level of an empty headline through possible states.
+This goes first to child, then to parent, level, then up the hierarchy.
+After top level, it switches back to sibling level."
+ (interactive)
+ (let ((org-adapt-indentation nil))
+ (when (org-point-at-end-of-empty-headline)
+ (setq this-command 'org-cycle-level) ; Only needed for caching
+ (let ((cur-level (org-current-level))
+ (prev-level (org-get-previous-line-level)))
+ (cond
+ ;; If first headline in file, promote to top-level.
+ ((= prev-level 0)
+ (loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
+ ;; If same level as prev, demote one.
+ ((= prev-level cur-level)
+ (org-do-demote))
+ ;; If parent is top-level, promote to top level if not already.
+ ((= prev-level 1)
+ (loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
+ ;; If top-level, return to prev-level.
+ ((= cur-level 1)
+ (loop repeat (/ (- prev-level 1) (org-level-increment))
+ do (org-do-demote)))
+ ;; If less than prev-level, promote one.
+ ((< cur-level prev-level)
+ (org-do-promote))
+ ;; If deeper than prev-level, promote until higher than
+ ;; prev-level.
+ ((> cur-level prev-level)
+ (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
+ do (org-do-promote))))
+ t))))
+
+(defun org-map-tree (fun)
+ "Call FUN for every heading underneath the current one."
+ (org-back-to-heading)
+ (let ((level (funcall outline-level)))
+ (save-excursion
+ (funcall fun)
+ (while (and (progn
+ (outline-next-heading)
+ (> (funcall outline-level) level))
+ (not (eobp)))
+ (funcall fun)))))
+
+(defun org-map-region (fun beg end)
+ "Call FUN for every heading between BEG and END."
+ (let ((org-ignore-region t))
+ (save-excursion
+ (setq end (copy-marker end))
+ (goto-char beg)
+ (if (and (re-search-forward org-outline-regexp-bol nil t)
+ (< (point) end))
+ (funcall fun))
+ (while (and (progn
+ (outline-next-heading)
+ (< (point) end))
+ (not (eobp)))
+ (funcall fun)))))
+
+(defvar org-property-end-re) ; silence byte-compiler
+(defun org-fixup-indentation (diff)
+ "Change the indentation in the current entry by DIFF.
+However, if any line in the current entry has no indentation, or if it
+would end up with no indentation after the change, nothing at all is done."
+ (save-excursion
+ (let ((end (save-excursion (outline-next-heading)
+ (point-marker)))
+ (prohibit (if (> diff 0)
+ "^\\S-"
+ (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
+ col)
+ (unless (save-excursion (end-of-line 1)
+ (re-search-forward prohibit end t))
+ (while (and (< (point) end)
+ (re-search-forward "^[ \t]+" end t))
+ (goto-char (match-end 0))
+ (setq col (current-column))
+ (if (< diff 0) (replace-match ""))
+ (org-indent-to-column (+ diff col))))
+ (move-marker end nil))))
+
+(defun org-convert-to-odd-levels ()
+ "Convert an org-mode file with all levels allowed to one with odd levels.
+This will leave level 1 alone, convert level 2 to level 3, level 3 to
+level 5 etc."
+ (interactive)
+ (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
+ (let ((outline-level 'org-outline-level)
+ (org-odd-levels-only nil) n)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^\\*\\*+ " nil t)
+ (setq n (- (length (match-string 0)) 2))
+ (while (>= (setq n (1- n)) 0)
+ (org-demote))
+ (end-of-line 1))))))
+
+(defun org-convert-to-oddeven-levels ()
+ "Convert an org-mode file with only odd levels to one with odd/even levels.
+This promotes level 3 to level 2, level 5 to level 3 etc. If the
+file contains a section with an even level, conversion would
+destroy the structure of the file. An error is signaled in this
+case."
+ (interactive)
+ (goto-char (point-min))
+ ;; First check if there are no even levels
+ (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
+ (org-show-context t)
+ (error "Not all levels are odd in this file. Conversion not possible"))
+ (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
+ (let ((outline-regexp org-outline-regexp)
+ (outline-level 'org-outline-level)
+ (org-odd-levels-only nil) n)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^\\*\\*+ " nil t)
+ (setq n (/ (1- (length (match-string 0))) 2))
+ (while (>= (setq n (1- n)) 0)
+ (org-promote))
+ (end-of-line 1))))))
+
+(defun org-tr-level (n)
+ "Make N odd if required."
+ (if org-odd-levels-only (1+ (/ n 2)) n))
+
+;;; Vertical tree motion, cutting and pasting of subtrees
+
+(defun org-move-subtree-up (&optional arg)
+ "Move the current subtree up past ARG headlines of the same level."
+ (interactive "p")
+ (org-move-subtree-down (- (prefix-numeric-value arg))))
+
+(defun org-move-subtree-down (&optional arg)
+ "Move the current subtree down past ARG headlines of the same level."
+ (interactive "p")
+ (setq arg (prefix-numeric-value arg))
+ (let ((movfunc (if (> arg 0) 'org-get-next-sibling
+ 'org-get-last-sibling))
+ (ins-point (make-marker))
+ (cnt (abs arg))
+ (col (current-column))
+ beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
+ ;; Select the tree
+ (org-back-to-heading)
+ (setq beg0 (point))
+ (save-excursion
+ (setq ne-beg (org-back-over-empty-lines))
+ (setq beg (point)))
+ (save-match-data
+ (save-excursion (outline-end-of-heading)
+ (setq folded (outline-invisible-p)))
+ (outline-end-of-subtree))
+ (outline-next-heading)
+ (setq ne-end (org-back-over-empty-lines))
+ (setq end (point))
+ (goto-char beg0)
+ (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
+ ;; include less whitespace
+ (save-excursion
+ (goto-char beg)
+ (forward-line (- ne-beg ne-end))
+ (setq beg (point))))
+ ;; Find insertion point, with error handling
+ (while (> cnt 0)
+ (or (and (funcall movfunc) (looking-at org-outline-regexp))
+ (progn (goto-char beg0)
+ (error "Cannot move past superior level or buffer limit")))
+ (setq cnt (1- cnt)))
+ (if (> arg 0)
+ ;; Moving forward - still need to move over subtree
+ (progn (org-end-of-subtree t t)
+ (save-excursion
+ (org-back-over-empty-lines)
+ (or (bolp) (newline)))))
+ (setq ne-ins (org-back-over-empty-lines))
+ (move-marker ins-point (point))
+ (setq txt (buffer-substring beg end))
+ (org-save-markers-in-region beg end)
+ (delete-region beg end)
+ (org-remove-empty-overlays-at beg)
+ (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
+ (or (bobp) (outline-flag-region (1- (point)) (point) nil))
+ (and (not (bolp)) (looking-at "\n") (forward-char 1))
+ (let ((bbb (point)))
+ (insert-before-markers txt)
+ (org-reinstall-markers-in-region bbb)
+ (move-marker ins-point bbb))
+ (or (bolp) (insert "\n"))
+ (setq ins-end (point))
+ (goto-char ins-point)
+ (org-skip-whitespace)
+ (when (and (< arg 0)
+ (org-first-sibling-p)
+ (> ne-ins ne-beg))
+ ;; Move whitespace back to beginning
+ (save-excursion
+ (goto-char ins-end)
+ (let ((kill-whole-line t))
+ (kill-line (- ne-ins ne-beg)) (point)))
+ (insert (make-string (- ne-ins ne-beg) ?\n)))
+ (move-marker ins-point nil)
+ (if folded
+ (hide-subtree)
+ (org-show-entry)
+ (show-children)
+ (org-cycle-hide-drawers 'children))
+ (org-clean-visibility-after-subtree-move)
+ ;; move back to the initial column we were at
+ (move-to-column col)))
+
+(defvar org-subtree-clip ""
+ "Clipboard for cut and paste of subtrees.
+This is actually only a copy of the kill, because we use the normal kill
+ring. We need it to check if the kill was created by `org-copy-subtree'.")
+
+(defvar org-subtree-clip-folded nil
+ "Was the last copied subtree folded?
+This is used to fold the tree back after pasting.")
+
+(defun org-cut-subtree (&optional n)
+ "Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
+This is a short-hand for marking the subtree and then cutting it."
+ (interactive "p")
+ (org-copy-subtree n 'cut))
+
+(defun org-copy-subtree (&optional n cut force-store-markers)
+ "Cut the current subtree into the clipboard.
+With prefix arg N, cut this many sequential subtrees.
+This is a short-hand for marking the subtree and then copying it.
+If CUT is non-nil, actually cut the subtree.
+If FORCE-STORE-MARKERS is non-nil, store the relative locations
+of some markers in the region, even if CUT is non-nil. This is
+useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
+ (interactive "p")
+ (let (beg end folded (beg0 (point)))
+ (if (org-called-interactively-p 'any)
+ (org-back-to-heading nil) ; take what looks like a subtree
+ (org-back-to-heading t)) ; take what is really there
+ (org-back-over-empty-lines)
+ (setq beg (point))
+ (skip-chars-forward " \t\r\n")
+ (save-match-data
+ (save-excursion (outline-end-of-heading)
+ (setq folded (outline-invisible-p)))
+ (condition-case nil
+ (org-forward-heading-same-level (1- n) t)
+ (error nil))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (setq end (point))
+ (goto-char beg0)
+ (when (> end beg)
+ (setq org-subtree-clip-folded folded)
+ (when (or cut force-store-markers)
+ (org-save-markers-in-region beg end))
+ (if cut (kill-region beg end) (copy-region-as-kill beg end))
+ (setq org-subtree-clip (current-kill 0))
+ (message "%s: Subtree(s) with %d characters"
+ (if cut "Cut" "Copied")
+ (length org-subtree-clip)))))
+
+(defun org-paste-subtree (&optional level tree for-yank)
+ "Paste the clipboard as a subtree, with modification of headline level.
+The entire subtree is promoted or demoted in order to match a new headline
+level.
+
+If the cursor is at the beginning of a headline, the same level as
+that headline is used to paste the tree
+
+If not, the new level is derived from the *visible* headings
+before and after the insertion point, and taken to be the inferior headline
+level of the two. So if the previous visible heading is level 3 and the
+next is level 4 (or vice versa), level 4 will be used for insertion.
+This makes sure that the subtree remains an independent subtree and does
+not swallow low level entries.
+
+You can also force a different level, either by using a numeric prefix
+argument, or by inserting the heading marker by hand. For example, if the
+cursor is after \"*****\", then the tree will be shifted to level 5.
+
+If optional TREE is given, use this text instead of the kill ring.
+
+When FOR-YANK is set, this is called by `org-yank'. In this case, do not
+move back over whitespace before inserting, and move point to the end of
+the inserted text when done."
+ (interactive "P")
+ (setq tree (or tree (and kill-ring (current-kill 0))))
+ (unless (org-kill-is-subtree-p tree)
+ (error "%s"
+ (substitute-command-keys
+ "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
+ (org-with-limited-levels
+ (let* ((visp (not (outline-invisible-p)))
+ (txt tree)
+ (^re_ "\\(\\*+\\)[ \t]*")
+ (old-level (if (string-match org-outline-regexp-bol txt)
+ (- (match-end 0) (match-beginning 0) 1)
+ -1))
+ (force-level (cond (level (prefix-numeric-value level))
+ ((and (looking-at "[ \t]*$")
+ (string-match
+ "^\\*+$" (buffer-substring
+ (point-at-bol) (point))))
+ (- (match-end 1) (match-beginning 1)))
+ ((and (bolp)
+ (looking-at org-outline-regexp))
+ (- (match-end 0) (point) 1))))
+ (previous-level (save-excursion
+ (condition-case nil
+ (progn
+ (outline-previous-visible-heading 1)
+ (if (looking-at ^re_)
+ (- (match-end 0) (match-beginning 0) 1)
+ 1))
+ (error 1))))
+ (next-level (save-excursion
+ (condition-case nil
+ (progn
+ (or (looking-at org-outline-regexp)
+ (outline-next-visible-heading 1))
+ (if (looking-at ^re_)
+ (- (match-end 0) (match-beginning 0) 1)
+ 1))
+ (error 1))))
+ (new-level (or force-level (max previous-level next-level)))
+ (shift (if (or (= old-level -1)
+ (= new-level -1)
+ (= old-level new-level))
+ 0
+ (- new-level old-level)))
+ (delta (if (> shift 0) -1 1))
+ (func (if (> shift 0) 'org-demote 'org-promote))
+ (org-odd-levels-only nil)
+ beg end newend)
+ ;; Remove the forced level indicator
+ (if force-level
+ (delete-region (point-at-bol) (point)))
+ ;; Paste
+ (beginning-of-line (if (bolp) 1 2))
+ (unless for-yank (org-back-over-empty-lines))
+ (setq beg (point))
+ (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+ (insert-before-markers txt)
+ (unless (string-match "\n\\'" txt) (insert "\n"))
+ (setq newend (point))
+ (org-reinstall-markers-in-region beg)
+ (setq end (point))
+ (goto-char beg)
+ (skip-chars-forward " \t\n\r")
+ (setq beg (point))
+ (if (and (outline-invisible-p) visp)
+ (save-excursion (outline-show-heading)))
+ ;; Shift if necessary
+ (unless (= shift 0)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (not (= shift 0))
+ (org-map-region func (point-min) (point-max))
+ (setq shift (+ delta shift)))
+ (goto-char (point-min))
+ (setq newend (point-max))))
+ (when (or (org-called-interactively-p 'interactive) for-yank)
+ (message "Clipboard pasted as level %d subtree" new-level))
+ (if (and (not for-yank) ; in this case, org-yank will decide about folding
+ kill-ring
+ (eq org-subtree-clip (current-kill 0))
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (hide-subtree))
+ (and for-yank (goto-char newend)))))
+
+(defun org-kill-is-subtree-p (&optional txt)
+ "Check if the current kill is an outline subtree, or a set of trees.
+Returns nil if kill does not start with a headline, or if the first
+headline level is not the largest headline level in the tree.
+So this will actually accept several entries of equal levels as well,
+which is OK for `org-paste-subtree'.
+If optional TXT is given, check this string instead of the current kill."
+ (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
+ (re (org-get-limited-outline-regexp))
+ (^re (concat "^" re))
+ (start-level (and kill
+ (string-match
+ (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)")
+ kill)
+ (- (match-end 2) (match-beginning 2) 1)))
+ (start (1+ (or (match-beginning 2) -1))))
+ (if (not start-level)
+ (progn
+ nil) ;; does not even start with a heading
+ (catch 'exit
+ (while (setq start (string-match ^re kill (1+ start)))
+ (when (< (- (match-end 0) (match-beginning 0) 1) start-level)
+ (throw 'exit nil)))
+ t))))
+
+(defvar org-markers-to-move nil
+ "Markers that should be moved with a cut-and-paste operation.
+Those markers are stored together with their positions relative to
+the start of the region.")
+
+(defun org-save-markers-in-region (beg end)
+ "Check markers in region.
+If these markers are between BEG and END, record their position relative
+to BEG, so that after moving the block of text, we can put the markers back
+into place.
+This function gets called just before an entry or tree gets cut from the
+buffer. After re-insertion, `org-reinstall-markers-in-region' must be
+called immediately, to move the markers with the entries."
+ (setq org-markers-to-move nil)
+ (when (featurep 'org-clock)
+ (org-clock-save-markers-for-cut-and-paste beg end))
+ (when (featurep 'org-agenda)
+ (org-agenda-save-markers-for-cut-and-paste beg end)))
+
+(defun org-check-and-save-marker (marker beg end)
+ "Check if MARKER is between BEG and END.
+If yes, remember the marker and the distance to BEG."
+ (when (and (marker-buffer marker)
+ (equal (marker-buffer marker) (current-buffer)))
+ (if (and (>= marker beg) (< marker end))
+ (push (cons marker (- marker beg)) org-markers-to-move))))
+
+(defun org-reinstall-markers-in-region (beg)
+ "Move all remembered markers to their position relative to BEG."
+ (mapc (lambda (x)
+ (move-marker (car x) (+ beg (cdr x))))
+ org-markers-to-move)
+ (setq org-markers-to-move nil))
+
+(defun org-narrow-to-subtree ()
+ "Narrow buffer to the current subtree."
+ (interactive)
+ (save-excursion
+ (save-match-data
+ (org-with-limited-levels
+ (narrow-to-region
+ (progn (org-back-to-heading t) (point))
+ (progn (org-end-of-subtree t t)
+ (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
+ (point)))))))
+
+(defun org-narrow-to-block ()
+ "Narrow buffer to the current block."
+ (interactive)
+ (let* ((case-fold-search t)
+ (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*"
+ "^[ \t]*#\\+end_.*")))
+ (if blockp
+ (narrow-to-region (car blockp) (cdr blockp))
+ (error "Not in a block"))))
+
+(eval-when-compile
+ (defvar org-property-drawer-re))
+
+(defvar org-property-start-re) ;; defined below
+(defun org-clone-subtree-with-time-shift (n &optional shift)
+ "Clone the task (subtree) at point N times.
+The clones will be inserted as siblings.
+
+In interactive use, the user will be prompted for the number of
+clones to be produced, and for a time SHIFT, which may be a
+repeater as used in time stamps, for example `+3d'.
+
+When a valid repeater is given and the entry contains any time
+stamps, the clones will become a sequence in time, with time
+stamps in the subtree shifted for each clone produced. If SHIFT
+is nil or the empty string, time stamps will be left alone. The
+ID property of the original subtree is removed.
+
+If the original subtree did contain time stamps with a repeater,
+the following will happen:
+- the repeater will be removed in each clone
+- an additional clone will be produced, with the current, unshifted
+ date(s) in the entry.
+- the original entry will be placed *after* all the clones, with
+ repeater intact.
+- the start days in the repeater in the original entry will be shifted
+ to past the last clone.
+In this way you can spell out a number of instances of a repeating task,
+and still retain the repeater to cover future instances of the task."
+ (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
+ (let (beg end template task idprop
+ shift-n shift-what doshift nmin nmax (n-no-remove -1)
+ (drawer-re org-drawer-regexp))
+ (if (not (and (integerp n) (> n 0)))
+ (error "Invalid number of replications %s" n))
+ (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
+ (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
+ shift)))
+ (error "Invalid shift specification %s" shift))
+ (when doshift
+ (setq shift-n (string-to-number (match-string 1 shift))
+ shift-what (cdr (assoc (match-string 2 shift)
+ '(("d" . day) ("w" . week)
+ ("m" . month) ("y" . year))))))
+ (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
+ (setq nmin 1 nmax n)
+ (org-back-to-heading t)
+ (setq beg (point))
+ (setq idprop (org-entry-get nil "ID"))
+ (org-end-of-subtree t t)
+ (or (bolp) (insert "\n"))
+ (setq end (point))
+ (setq template (buffer-substring beg end))
+ (when (and doshift
+ (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template))
+ (delete-region beg end)
+ (setq end beg)
+ (setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
+ (goto-char end)
+ (loop for n from nmin to nmax do
+ ;; prepare clone
+ (with-temp-buffer
+ (insert template)
+ (org-mode)
+ (goto-char (point-min))
+ (org-show-subtree)
+ (and idprop (if org-clone-delete-id
+ (org-entry-delete nil "ID")
+ (org-id-get-create t)))
+ (unless (= n 0)
+ (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t)
+ (kill-whole-line))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (mapc (lambda (d)
+ (org-remove-empty-drawer-at d (point))) org-drawers)))
+ (goto-char (point-min))
+ (when doshift
+ (while (re-search-forward org-ts-regexp-both nil t)
+ (org-timestamp-change (* n shift-n) shift-what))
+ (unless (= n n-no-remove)
+ (goto-char (point-min))
+ (while (re-search-forward org-ts-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
+ (delete-region (match-beginning 1) (match-end 1)))))))
+ (setq task (buffer-string)))
+ (insert task))
+ (goto-char beg)))
+
+;;; Outline Sorting
+
+(defun org-sort (with-case)
+ "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
+Optional argument WITH-CASE means sort case-sensitively."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
+ ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case))
+ (t
+ (org-call-with-arg 'org-sort-entries with-case))))
+
+(defun org-sort-remove-invisible (s)
+ (remove-text-properties 0 (length s) org-rm-props s)
+ (while (string-match org-bracket-link-regexp s)
+ (setq s (replace-match (if (match-end 2)
+ (match-string 3 s)
+ (match-string 1 s)) t t s)))
+ s)
+
+(defvar org-priority-regexp) ; defined later in the file
+
+(defvar org-after-sorting-entries-or-items-hook nil
+ "Hook that is run after a bunch of entries or items have been sorted.
+When children are sorted, the cursor is in the parent line when this
+hook gets called. When a region or a plain list is sorted, the cursor
+will be in the first entry of the sorted region/list.")
+
+(defun org-sort-entries
+ (&optional with-case sorting-type getkey-func compare-func property)
+ "Sort entries on a certain level of an outline tree.
+If there is an active region, the entries in the region are sorted.
+Else, if the cursor is before the first entry, sort the top-level items.
+Else, the children of the entry at point are sorted.
+
+Sorting can be alphabetically, numerically, by date/time as given by
+a time stamp, by a property or by priority.
+
+The command prompts for the sorting type unless it has been given to the
+function through the SORTING-TYPE argument, which needs to be a character,
+\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the
+precise meaning of each character:
+
+n Numerically, by converting the beginning of the entry/item to a number.
+a Alphabetically, ignoring the TODO keyword and the priority, if any.
+t By date/time, either the first active time stamp in the entry, or, if
+ none exist, by the first inactive one.
+s By the scheduled date/time.
+d By deadline date/time.
+c By creation time, which is assumed to be the first inactive time stamp
+ at the beginning of a line.
+p By priority according to the cookie.
+r By the value of a property.
+
+Capital letters will reverse the sort order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
+called with point at the beginning of the record. It must return either
+a string or a number that should serve as the sorting key for that record.
+
+Comparing entries ignores case by default. However, with an optional argument
+WITH-CASE, the sorting considers case as well."
+ (interactive "P")
+ (let ((case-func (if with-case 'identity 'downcase))
+ start beg end stars re re2
+ txt what tmp)
+ ;; Find beginning and end of region to sort
+ (cond
+ ((org-region-active-p)
+ ;; we will sort the region
+ (setq end (region-end)
+ what "region")
+ (goto-char (region-beginning))
+ (if (not (org-at-heading-p)) (outline-next-heading))
+ (setq start (point)))
+ ((or (org-at-heading-p)
+ (condition-case nil (progn (org-back-to-heading) t) (error nil)))
+ ;; we will sort the children of the current headline
+ (org-back-to-heading)
+ (setq start (point)
+ end (progn (org-end-of-subtree t t)
+ (or (bolp) (insert "\n"))
+ (org-back-over-empty-lines)
+ (point))
+ what "children")
+ (goto-char start)
+ (show-subtree)
+ (outline-next-heading))
+ (t
+ ;; we will sort the top-level entries in this file
+ (goto-char (point-min))
+ (or (org-at-heading-p) (outline-next-heading))
+ (setq start (point))
+ (goto-char (point-max))
+ (beginning-of-line 1)
+ (when (looking-at ".*?\\S-")
+ ;; File ends in a non-white line
+ (end-of-line 1)
+ (insert "\n"))
+ (setq end (point-max))
+ (setq what "top-level")
+ (goto-char start)
+ (show-all)))
+
+ (setq beg (point))
+ (if (>= beg end) (error "Nothing to sort"))
+
+ (looking-at "\\(\\*+\\)")
+ (setq stars (match-string 1)
+ re (concat "^" (regexp-quote stars) " +")
+ re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
+ txt (buffer-substring beg end))
+ (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
+ (if (and (not (equal stars "*")) (string-match re2 txt))
+ (error "Region to sort contains a level above the first entry"))
+
+ (unless sorting-type
+ (message
+ "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
+ [t]ime [s]cheduled [d]eadline [c]reated
+ A/N/T/S/D/C/P/O/F means reversed:"
+ what)
+ (setq sorting-type (read-char-exclusive))
+
+ (and (= (downcase sorting-type) ?f)
+ (setq getkey-func
+ (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil))
+ (setq getkey-func (intern getkey-func)))
+
+ (and (= (downcase sorting-type) ?r)
+ (setq property
+ (org-icompleting-read "Property: "
+ (mapcar 'list (org-buffer-property-keys t))
+ nil t))))
+
+ (message "Sorting entries...")
+
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((dcst (downcase sorting-type))
+ (case-fold-search nil)
+ (now (current-time)))
+ (sort-subr
+ (/= dcst sorting-type)
+ ;; This function moves to the beginning character of the "record" to
+ ;; be sorted.
+ (lambda nil
+ (if (re-search-forward re nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))))
+ ;; This function moves to the last character of the "record" being
+ ;; sorted.
+ (lambda nil
+ (save-match-data
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error
+ (goto-char (point-max))))))
+ ;; This function returns the value that gets sorted against.
+ (lambda nil
+ (cond
+ ((= dcst ?n)
+ (if (looking-at org-complex-heading-regexp)
+ (string-to-number (match-string 4))
+ nil))
+ ((= dcst ?a)
+ (if (looking-at org-complex-heading-regexp)
+ (funcall case-func (match-string 4))
+ nil))
+ ((= dcst ?t)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (or (re-search-forward org-ts-regexp end t)
+ (re-search-forward org-ts-regexp-both end t))
+ (org-time-string-to-seconds (match-string 0))
+ (org-float-time now))))
+ ((= dcst ?c)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward
+ (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
+ end t)
+ (org-time-string-to-seconds (match-string 0))
+ (org-float-time now))))
+ ((= dcst ?s)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward org-scheduled-time-regexp end t)
+ (org-time-string-to-seconds (match-string 1))
+ (org-float-time now))))
+ ((= dcst ?d)
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (if (re-search-forward org-deadline-time-regexp end t)
+ (org-time-string-to-seconds (match-string 1))
+ (org-float-time now))))
+ ((= dcst ?p)
+ (if (re-search-forward org-priority-regexp (point-at-eol) t)
+ (string-to-char (match-string 2))
+ org-default-priority))
+ ((= dcst ?r)
+ (or (org-entry-get nil property) ""))
+ ((= dcst ?o)
+ (if (looking-at org-complex-heading-regexp)
+ (- 9999 (length (member (match-string 2)
+ org-todo-keywords-1)))))
+ ((= dcst ?f)
+ (if getkey-func
+ (progn
+ (setq tmp (funcall getkey-func))
+ (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ tmp)
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type))))
+ nil
+ (cond
+ ((= dcst ?a) 'string<)
+ ((= dcst ?f) compare-func)
+ ((member dcst '(?p ?t ?s ?d ?c)) '<)))))
+ (run-hooks 'org-after-sorting-entries-or-items-hook)
+ (message "Sorting entries...done")))
+
+(defun org-do-sort (table what &optional with-case sorting-type)
+ "Sort TABLE of WHAT according to SORTING-TYPE.
+The user will be prompted for the SORTING-TYPE if the call to this
+function does not specify it. WHAT is only for the prompt, to indicate
+what is being sorted. The sorting key will be extracted from
+the car of the elements of the table.
+If WITH-CASE is non-nil, the sorting will be case-sensitive."
+ (unless sorting-type
+ (message
+ "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:"
+ what)
+ (setq sorting-type (read-char-exclusive)))
+ (let ((dcst (downcase sorting-type))
+ extractfun comparefun)
+ ;; Define the appropriate functions
+ (cond
+ ((= dcst ?n)
+ (setq extractfun 'string-to-number
+ comparefun (if (= dcst sorting-type) '< '>)))
+ ((= dcst ?a)
+ (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
+ (lambda(x) (downcase (org-sort-remove-invisible x))))
+ comparefun (if (= dcst sorting-type)
+ 'string<
+ (lambda (a b) (and (not (string< a b))
+ (not (string= a b)))))))
+ ((= dcst ?t)
+ (setq extractfun
+ (lambda (x)
+ (if (or (string-match org-ts-regexp x)
+ (string-match org-ts-regexp-both x))
+ (org-float-time
+ (org-time-string-to-time (match-string 0 x)))
+ 0))
+ comparefun (if (= dcst sorting-type) '< '>)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))
+
+ (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
+ table)
+ (lambda (a b) (funcall comparefun (car a) (car b))))))
+
+
+;;; The orgstruct minor mode
+
+;; Define a minor mode which can be used in other modes in order to
+;; integrate the org-mode structure editing commands.
+
+;; This is really a hack, because the org-mode structure commands use
+;; keys which normally belong to the major mode. Here is how it
+;; works: The minor mode defines all the keys necessary to operate the
+;; structure commands, but wraps the commands into a function which
+;; tests if the cursor is currently at a headline or a plain list
+;; item. If that is the case, the structure command is used,
+;; temporarily setting many Org-mode variables like regular
+;; expressions for filling etc. However, when any of those keys is
+;; used at a different location, function uses `key-binding' to look
+;; up if the key has an associated command in another currently active
+;; keymap (minor modes, major mode, global), and executes that
+;; command. There might be problems if any of the keys is otherwise
+;; used as a prefix key.
+
+;; Another challenge is that the key binding for TAB can be tab or \C-i,
+;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
+;; addresses this by checking explicitly for both bindings.
+
+(defvar orgstruct-mode-map (make-sparse-keymap)
+ "Keymap for the minor `orgstruct-mode'.")
+
+(defvar org-local-vars nil
+ "List of local variables, for use by `orgstruct-mode'.")
+
+;;;###autoload
+(define-minor-mode orgstruct-mode
+ "Toggle the minor mode `orgstruct-mode'.
+This mode is for using Org-mode structure commands in other
+modes. The following keys behave as if Org-mode were active, if
+the cursor is on a headline, or on a plain list item (both as
+defined by Org-mode).
+
+M-up Move entry/item up
+M-down Move entry/item down
+M-left Promote
+M-right Demote
+M-S-up Move entry/item up
+M-S-down Move entry/item down
+M-S-left Promote subtree
+M-S-right Demote subtree
+M-q Fill paragraph and items like in Org-mode
+C-c ^ Sort entries
+C-c - Cycle list bullet
+TAB Cycle item visibility
+M-RET Insert new heading/item
+S-M-RET Insert new TODO heading / Checkbox item
+C-c C-c Set tags / toggle checkbox"
+ nil " OrgStruct" nil
+ (org-load-modules-maybe)
+ (and (orgstruct-setup) (defun orgstruct-setup () nil)))
+
+;;;###autoload
+(defun turn-on-orgstruct ()
+ "Unconditionally turn on `orgstruct-mode'."
+ (orgstruct-mode 1))
+
+(defvar org-fb-vars nil)
+(make-variable-buffer-local 'org-fb-vars)
+(defun orgstruct++-mode (&optional arg)
+ "Toggle `orgstruct-mode', the enhanced version of it.
+In addition to setting orgstruct-mode, this also exports all
+indentation and autofilling variables from org-mode into the
+buffer. It will also recognize item context in multiline items."
+ (interactive "P")
+ (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
+ (if (< arg 1)
+ (progn (orgstruct-mode -1)
+ (mapc (lambda(v)
+ (org-set-local (car v)
+ (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v))))
+ org-fb-vars))
+ (orgstruct-mode 1)
+ (setq org-fb-vars nil)
+ (let (var val)
+ (mapc
+ (lambda (x)
+ (when (string-match
+ "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)"
+ (symbol-name (car x)))
+ (setq var (car x) val (nth 1 x))
+ (push (list var `(quote ,(eval var))) org-fb-vars)
+ (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
+ org-local-vars)
+ (org-set-local 'orgstruct-is-++ t))))
+
+(defvar orgstruct-is-++ nil
+ "Is `orgstruct-mode' in ++ version in the current-buffer?")
+(make-variable-buffer-local 'orgstruct-is-++)
+
+;;;###autoload
+(defun turn-on-orgstruct++ ()
+ "Unconditionally turn on `orgstruct++-mode'."
+ (orgstruct++-mode 1))
+
+(defun orgstruct-error ()
+ "Error when there is no default binding for a structure key."
+ (interactive)
+ (error "This key has no function outside structure elements"))
+
+(defun orgstruct-setup ()
+ "Setup orgstruct keymaps."
+ (let ((nfunc 0)
+ (bindings
+ (list
+ '([(meta up)] org-metaup)
+ '([(meta down)] org-metadown)
+ '([(meta left)] org-metaleft)
+ '([(meta right)] org-metaright)
+ '([(meta shift up)] org-shiftmetaup)
+ '([(meta shift down)] org-shiftmetadown)
+ '([(meta shift left)] org-shiftmetaleft)
+ '([(meta shift right)] org-shiftmetaright)
+ '([?\e (up)] org-metaup)
+ '([?\e (down)] org-metadown)
+ '([?\e (left)] org-metaleft)
+ '([?\e (right)] org-metaright)
+ '([?\e (shift up)] org-shiftmetaup)
+ '([?\e (shift down)] org-shiftmetadown)
+ '([?\e (shift left)] org-shiftmetaleft)
+ '([?\e (shift right)] org-shiftmetaright)
+ '([(shift up)] org-shiftup)
+ '([(shift down)] org-shiftdown)
+ '([(shift left)] org-shiftleft)
+ '([(shift right)] org-shiftright)
+ '("\C-c\C-c" org-ctrl-c-ctrl-c)
+ '("\M-q" fill-paragraph)
+ '("\C-c^" org-sort)
+ '("\C-c-" org-cycle-list-bullet)))
+ elt key fun cmd)
+ (while (setq elt (pop bindings))
+ (setq nfunc (1+ nfunc))
+ (setq key (org-key (car elt))
+ fun (nth 1 elt)
+ cmd (orgstruct-make-binding fun nfunc key))
+ (org-defkey orgstruct-mode-map key cmd))
+
+ ;; Prevent an error for users who forgot to make autoloads
+ (require 'org-element)
+
+ ;; Special treatment needed for TAB and RET
+ (org-defkey orgstruct-mode-map [(tab)]
+ (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
+ (org-defkey orgstruct-mode-map "\C-i"
+ (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)]))
+
+ (org-defkey orgstruct-mode-map "\M-\C-m"
+ (orgstruct-make-binding 'org-insert-heading 105
+ "\M-\C-m" [(meta return)]))
+ (org-defkey orgstruct-mode-map [(meta return)]
+ (orgstruct-make-binding 'org-insert-heading 106
+ [(meta return)] "\M-\C-m"))
+
+ (org-defkey orgstruct-mode-map [(shift meta return)]
+ (orgstruct-make-binding 'org-insert-todo-heading 107
+ [(meta return)] "\M-\C-m"))
+
+ (org-defkey orgstruct-mode-map "\e\C-m"
+ (orgstruct-make-binding 'org-insert-heading 108
+ "\e\C-m" [?\e (return)]))
+ (org-defkey orgstruct-mode-map [?\e (return)]
+ (orgstruct-make-binding 'org-insert-heading 109
+ [?\e (return)] "\e\C-m"))
+ (org-defkey orgstruct-mode-map [?\e (shift return)]
+ (orgstruct-make-binding 'org-insert-todo-heading 110
+ [?\e (return)] "\e\C-m"))
+
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
+
+ t))
+
+(defun orgstruct-make-binding (fun n &rest keys)
+ "Create a function for binding in the structure minor mode.
+FUN is the command to call inside a table. N is used to create a unique
+command name. KEYS are keys that should be checked in for a command
+to execute outside of tables."
+ (eval
+ (list 'defun
+ (intern (concat "orgstruct-hijacker-command-" (int-to-string n)))
+ '(arg)
+ (concat "In Structure, run `" (symbol-name fun) "'.\n"
+ "Outside of structure, run the binding of `"
+ (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
+ "'.")
+ '(interactive "p")
+ (list 'if
+ `(org-context-p 'headline 'item
+ (and orgstruct-is-++
+ ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
+ 'item-body))
+ (list 'org-run-like-in-org-mode (list 'quote fun))
+ (list 'let '(orgstruct-mode)
+ (list 'call-interactively
+ (append '(or)
+ (mapcar (lambda (k)
+ (list 'key-binding k))
+ keys)
+ '('orgstruct-error))))))))
+
+(defun org-contextualize-keys (alist contexts)
+ "Return valid elements in ALIST depending on CONTEXTS.
+
+`org-agenda-custom-commands' or `org-capture-templates' are the
+values used for ALIST, and `org-agenda-custom-commands-contexts'
+or `org-capture-templates-contexts' are the associated contexts
+definitions."
+ (let ((contexts
+ ;; normalize contexts
+ (mapcar
+ (lambda(c) (cond ((listp (cadr c))
+ (list (car c) (car c) (cadr c)))
+ ((string= "" (cadr c))
+ (list (car c) (car c) (caddr c)))
+ (t c))) contexts))
+ (a alist) c r s)
+ ;; loop over all commands or templates
+ (while (setq c (pop a))
+ (let (vrules repl)
+ (cond
+ ((not (assoc (car c) contexts))
+ (push c r))
+ ((and (assoc (car c) contexts)
+ (setq vrules (org-contextualize-validate-key
+ (car c) contexts)))
+ (mapc (lambda (vr)
+ (when (not (equal (car vr) (cadr vr)))
+ (setq repl vr))) vrules)
+ (if (not repl) (push c r)
+ (push (cadr repl) s)
+ (push
+ (cons (car c)
+ (cdr (or (assoc (cadr repl) alist)
+ (error "Undefined key `%s' as contextual replacement for `%s'"
+ (cadr repl) (car c)))))
+ r))))))
+ ;; Return limited ALIST, possibly with keys modified, and deduplicated
+ (delq
+ nil
+ (delete-dups
+ (mapcar (lambda (x)
+ (let ((tpl (car x)))
+ (when (not (delq
+ nil
+ (mapcar (lambda(y)
+ (equal y tpl)) s))) x)))
+ (reverse r))))))
+
+(defun org-contextualize-validate-key (key contexts)
+ "Check CONTEXTS for agenda or capture KEY."
+ (let (r rr res)
+ (while (setq r (pop contexts))
+ (mapc
+ (lambda (rr)
+ (when
+ (and (equal key (car r))
+ (if (functionp rr) (funcall rr)
+ (or (and (eq (car rr) 'in-file)
+ (buffer-file-name)
+ (string-match (cdr rr) (buffer-file-name)))
+ (and (eq (car rr) 'in-mode)
+ (string-match (cdr rr) (symbol-name major-mode)))
+ (when (and (eq (car rr) 'not-in-file)
+ (buffer-file-name))
+ (not (string-match (cdr rr) (buffer-file-name))))
+ (when (eq (car rr) 'not-in-mode)
+ (not (string-match (cdr rr) (symbol-name major-mode)))))))
+ (push r res)))
+ (car (last r))))
+ (delete-dups (delq nil res))))
+
+(defun org-context-p (&rest contexts)
+ "Check if local context is any of CONTEXTS.
+Possible values in the list of contexts are `table', `headline', and `item'."
+ (let ((pos (point)))
+ (goto-char (point-at-bol))
+ (prog1 (or (and (memq 'table contexts)
+ (looking-at "[ \t]*|"))
+ (and (memq 'headline contexts)
+ (looking-at org-outline-regexp))
+ (and (memq 'item contexts)
+ (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
+ (and (memq 'item-body contexts)
+ (org-in-item-p)))
+ (goto-char pos))))
+
+(defun org-get-local-variables ()
+ "Return a list of all local variables in an Org mode buffer."
+ (let (varlist)
+ (with-current-buffer (get-buffer-create "*Org tmp*")
+ (erase-buffer)
+ (org-mode)
+ (setq varlist (buffer-local-variables)))
+ (kill-buffer "*Org tmp*")
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (setq x
+ (if (symbolp x)
+ (list x)
+ (list (car x) (list 'quote (cdr x)))))
+ (if (string-match
+ "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
+ (symbol-name (car x)))
+ x nil))
+ varlist))))
+
+(defun org-clone-local-variables (from-buffer &optional regexp)
+ "Clone local variables from FROM-BUFFER.
+Optional argument REGEXP selects variables to clone."
+ (mapc
+ (lambda (pair)
+ (and (symbolp (car pair))
+ (or (null regexp)
+ (string-match regexp (symbol-name (car pair))))
+ (set (make-local-variable (car pair))
+ (cdr pair))))
+ (buffer-local-variables from-buffer)))
+
+;;;###autoload
+(defun org-run-like-in-org-mode (cmd)
+ "Run a command, pretending that the current buffer is in Org-mode.
+This will temporarily bind local variables that are typically bound in
+Org-mode to the values they have in Org-mode, and then interactively
+call CMD."
+ (org-load-modules-maybe)
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
+ (eval (list 'let org-local-vars
+ (list 'call-interactively (list 'quote cmd)))))
+
+;;;; Archiving
+
+(defun org-get-category (&optional pos force-refresh)
+ "Get the category applying to position POS."
+ (save-match-data
+ (if force-refresh (org-refresh-category-properties))
+ (let ((pos (or pos (point))))
+ (or (get-text-property pos 'org-category)
+ (progn (org-refresh-category-properties)
+ (get-text-property pos 'org-category))))))
+
+(defun org-refresh-category-properties ()
+ "Refresh category text properties in the buffer."
+ (let ((case-fold-search t)
+ (inhibit-read-only t)
+ (def-cat (cond
+ ((null org-category)
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "???"))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category)))
+ beg end cat pos optionp)
+ (org-unmodified
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (put-text-property (point) (point-max) 'org-category def-cat)
+ (while (re-search-forward
+ "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
+ (setq pos (match-end 0)
+ optionp (equal (char-after (match-beginning 0)) ?#)
+ cat (org-trim (match-string 2)))
+ (if optionp
+ (setq beg (point-at-bol) end (point-max))
+ (org-back-to-heading t)
+ (setq beg (point) end (org-end-of-subtree t t)))
+ (put-text-property beg end 'org-category cat)
+ (put-text-property beg end 'org-category-position beg)
+ (goto-char pos)))))))
+
+
+;;;; Link Stuff
+
+;;; Link abbreviations
+
+(defun org-link-expand-abbrev (link)
+ "Apply replacements as defined in `org-link-abbrev-alist'."
+ (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
+ (let* ((key (match-string 1 link))
+ (as (or (assoc key org-link-abbrev-alist-local)
+ (assoc key org-link-abbrev-alist)))
+ (tag (and (match-end 2) (match-string 3 link)))
+ rpl)
+ (if (not as)
+ link
+ (setq rpl (cdr as))
+ (cond
+ ((symbolp rpl) (funcall rpl tag))
+ ((string-match "%(\\([^)]+\\))" rpl)
+ (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl))
+ ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
+ ((string-match "%h" rpl)
+ (replace-match (url-hexify-string (or tag "")) t t rpl))
+ (t (concat rpl tag)))))
+ link))
+
+;;; Storing and inserting links
+
+(defvar org-insert-link-history nil
+ "Minibuffer history for links inserted with `org-insert-link'.")
+
+(defvar org-stored-links nil
+ "Contains the links stored with `org-store-link'.")
+
+(defvar org-store-link-plist nil
+ "Plist with info about the most recently link created with `org-store-link'.")
+
+(defvar org-link-protocols nil
+ "Link protocols added to Org-mode using `org-add-link-type'.")
+
+(defvar org-store-link-functions nil
+ "List of functions that are called to create and store a link.
+Each function will be called in turn until one returns a non-nil
+value. Each function should check if it is responsible for creating
+this link (for example by looking at the major mode).
+If not, it must exit and return nil.
+If yes, it should return a non-nil value after a calling
+`org-store-link-props' with a list of properties and values.
+Special properties are:
+
+:type The link prefix, like \"http\". This must be given.
+:link The link, like \"http://www.astro.uva.nl/~dominik\".
+ This is obligatory as well.
+:description Optional default description for the second pair
+ of brackets in an Org-mode link. The user can still change
+ this when inserting this link into an Org-mode buffer.
+
+In addition to these, any additional properties can be specified
+and then used in capture templates.")
+
+(defun org-add-link-type (type &optional follow export)
+ "Add TYPE to the list of `org-link-types'.
+Re-compute all regular expressions depending on `org-link-types'
+
+FOLLOW and EXPORT are two functions.
+
+FOLLOW should take the link path as the single argument and do whatever
+is necessary to follow the link, for example find a file or display
+a mail message.
+
+EXPORT should format the link path for export to one of the export formats.
+It should be a function accepting three arguments:
+
+ path the path of the link, the text after the prefix (like \"http:\")
+ desc the description of the link, if any, or a description added by
+ org-export-normalize-links if there is none
+ format the export format, a symbol like `html' or `latex' or `ascii'..
+
+The function may use the FORMAT information to return different values
+depending on the format. The return value will be put literally into
+the exported file. If the return value is nil, this means Org should
+do what it normally does with links which do not have EXPORT defined.
+
+Org-mode has a built-in default for exporting links. If you are happy with
+this default, there is no need to define an export function for the link
+type. For a simple example of an export function, see `org-bbdb.el'."
+ (add-to-list 'org-link-types type t)
+ (org-make-link-regexps)
+ (if (assoc type org-link-protocols)
+ (setcdr (assoc type org-link-protocols) (list follow export))
+ (push (list type follow export) org-link-protocols)))
+
+(defvar org-agenda-buffer-name) ; Defined in org-agenda.el
+(defvar org-link-to-org-use-id) ; Defined in org-id.el
+
+;;;###autoload
+(defun org-store-link (arg)
+ "\\<org-mode-map>Store an org-link to the current location.
+This link is added to `org-stored-links' and can later be inserted
+into an org-buffer with \\[org-insert-link].
+
+For some link types, a prefix arg is interpreted:
+For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
+For file links, arg negates `org-context-in-file-links'."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (setq org-store-link-plist nil) ; reset
+ (org-with-limited-levels
+ (let (link cpltxt desc description search txt custom-id agenda-link)
+ (cond
+
+ ((run-hook-with-args-until-success 'org-store-link-functions)
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist :description) link)))
+
+ ((org-src-edit-buffer-p)
+ (let (label gc)
+ (while (or (not label)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (regexp-quote (format org-coderef-label-format label))
+ nil t))))
+ (when label (message "Label exists already") (sit-for 2))
+ (setq label (read-string "Code line label: " label)))
+ (end-of-line 1)
+ (setq link (format org-coderef-label-format label))
+ (setq gc (- 79 (length link)))
+ (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
+ (insert link)
+ (setq link (concat "(" label ")") desc nil)))
+
+ ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ ;; We are in the agenda, link to referenced location
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (setq agenda-link
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-props :type "calendar" :date cd)))
+
+ ((eq major-mode 'help-mode)
+ (setq link (concat "help:" (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0))))
+ (org-store-link-props :type "help"))
+
+ ((eq major-mode 'w3-mode)
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (url-view-url t))
+ (org-store-link-props :type "w3" :url (url-view-url t)))
+
+ ((eq major-mode 'w3m-mode)
+ (setq cpltxt (or w3m-current-title w3m-current-url)
+ link w3m-current-url)
+ (org-store-link-props :type "w3m" :url (url-view-url t)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ((eq major-mode 'dired-mode)
+ ;; link to the file in the current line
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link cpltxt)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ((org-in-regexp "<<\\(.*?\\)>>")
+ (setq cpltxt
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))
+ "::" (match-string 1))
+ link cpltxt))
+ ((and (featurep 'org-id)
+ (or (eq org-link-to-org-use-id t)
+ (and (org-called-interactively-p 'any)
+ (or (eq org-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not custom-id))))
+ (and org-link-to-org-use-id (org-entry-get nil "ID"))))
+ ;; We can make a link using the ID.
+ (setq link (condition-case nil
+ (prog1 (org-id-store-link)
+ (setq desc (plist-get org-store-link-plist :description)))
+ (error
+ ;; probably before first headline, link to file only
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))))))
+ (t
+ ;; Just link to current headline
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context search string
+ (when (org-xor org-context-in-file-links arg)
+ (setq txt (cond
+ ((org-at-heading-p) nil)
+ ((org-region-active-p)
+ (buffer-substring (region-beginning) (region-end)))))
+ (when (or (null txt) (string-match "\\S-" txt))
+ (setq cpltxt
+ (concat cpltxt "::"
+ (condition-case nil
+ (org-make-org-heading-search-string txt)
+ (error "")))
+ desc (or (nth 4 (ignore-errors
+ (org-heading-components))) "NONE"))))
+ (if (string-match "::\\'" cpltxt)
+ (setq cpltxt (substring cpltxt 0 -2)))
+ (setq link cpltxt))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context string
+ (when (org-xor org-context-in-file-links arg)
+ (setq txt (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ ;; Only use search option if there is some text.
+ (when (string-match "\\S-" txt)
+ (setq cpltxt
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((org-called-interactively-p 'interactive)
+ (error "Cannot link to a buffer which is not visiting a file"))
+
+ (t (setq link nil)))
+
+ (if (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (if (equal desc "NONE") (setq desc nil))
+
+ (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
+ (progn
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links))
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
+ "::#" custom-id))
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links))))
+ (or agenda-link (and link (org-make-link-string link desc)))))))
+
+(defun org-store-link-props (&rest plist)
+ "Store link properties, extract names and addresses."
+ (let (x adr)
+ (when (setq x (plist-get plist :from))
+ (setq adr (mail-extract-address-components x))
+ (setq plist (plist-put plist :fromname (car adr)))
+ (setq plist (plist-put plist :fromaddress (nth 1 adr))))
+ (when (setq x (plist-get plist :to))
+ (setq adr (mail-extract-address-components x))
+ (setq plist (plist-put plist :toname (car adr)))
+ (setq plist (plist-put plist :toaddress (nth 1 adr)))))
+ (let ((from (plist-get plist :from))
+ (to (plist-get plist :to)))
+ (when (and from to org-from-is-user-regexp)
+ (setq plist
+ (plist-put plist :fromto
+ (if (string-match org-from-is-user-regexp from)
+ (concat "to %t")
+ (concat "from %f"))))))
+ (setq org-store-link-plist plist))
+
+(defun org-add-link-props (&rest plist)
+ "Add these properties to the link property list."
+ (let (key value)
+ (while plist
+ (setq key (pop plist) value (pop plist))
+ (setq org-store-link-plist
+ (plist-put org-store-link-plist key value)))))
+
+(defun org-email-link-description (&optional fmt)
+ "Return the description part of an email link.
+This takes information from `org-store-link-plist' and formats it
+according to FMT (default from `org-email-link-description-format')."
+ (setq fmt (or fmt org-email-link-description-format))
+ (let* ((p org-store-link-plist)
+ (to (plist-get p :toaddress))
+ (from (plist-get p :fromaddress))
+ (table
+ (list
+ (cons "%c" (plist-get p :fromto))
+ (cons "%F" (plist-get p :from))
+ (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
+ (cons "%T" (plist-get p :to))
+ (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
+ (cons "%s" (plist-get p :subject))
+ (cons "%d" (plist-get p :date))
+ (cons "%m" (plist-get p :message-id)))))
+ (when (string-match "%c" fmt)
+ ;; Check if the user wrote this message
+ (if (and org-from-is-user-regexp from to
+ (save-match-data (string-match org-from-is-user-regexp from)))
+ (setq fmt (replace-match "to %t" t t fmt))
+ (setq fmt (replace-match "from %f" t t fmt))))
+ (org-replace-escapes fmt table)))
+
+(defun org-make-org-heading-search-string (&optional string heading)
+ "Make search string for STRING or current headline."
+ (interactive)
+ (let ((s (or string (org-get-heading)))
+ (lines org-context-in-file-links))
+ (unless (and string (not heading))
+ ;; We are using a headline, clean up garbage in there.
+ (if (string-match org-todo-regexp s)
+ (setq s (replace-match "" t t s)))
+ (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s)
+ (setq s (replace-match "" t t s)))
+ (setq s (org-trim s))
+ (if (string-match (concat "^\\(" org-quote-string "\\|"
+ org-comment-string "\\)") s)
+ (setq s (replace-match "" t t s)))
+ (while (string-match org-ts-regexp s)
+ (setq s (replace-match "" t t s))))
+ (or string (setq s (concat "*" s))) ; Add * for headlines
+ (when (and string (integerp lines) (> lines 0))
+ (let ((slines (org-split-string s "\n")))
+ (when (< lines (length slines))
+ (setq s (mapconcat
+ 'identity
+ (reverse (nthcdr (- (length slines) lines)
+ (reverse slines))) "\n")))))
+ (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
+
+(defun org-make-link-string (link &optional description)
+ "Make a link with brackets, consisting of LINK and DESCRIPTION."
+ (unless (string-match "\\S-" link)
+ (error "Empty link"))
+ (when (and description
+ (stringp description)
+ (not (string-match "\\S-" description)))
+ (setq description nil))
+ (when (stringp description)
+ ;; Remove brackets from the description, they are fatal.
+ (while (string-match "\\[" description)
+ (setq description (replace-match "{" t t description)))
+ (while (string-match "\\]" description)
+ (setq description (replace-match "}" t t description))))
+ (when (equal link description)
+ ;; No description needed, it is identical
+ (setq description nil))
+ (when (and (not description)
+ (not (string-match (org-image-file-name-regexp) link))
+ (not (equal link (org-link-escape link))))
+ (setq description (org-extract-attributes link)))
+ (setq link
+ (cond ((string-match (org-image-file-name-regexp) link) link)
+ ((string-match org-link-types-re link)
+ (concat (match-string 1 link)
+ (org-link-escape (substring link (match-end 1)))))
+ (t (org-link-escape link))))
+ (concat "[[" link "]"
+ (if description (concat "[" description "]") "")
+ "]"))
+
+(defconst org-link-escape-chars
+ '(?\ ?\[ ?\] ?\; ?\= ?\+)
+ "List of characters that should be escaped in link.
+This is the list that is used for internal purposes.")
+
+(defconst org-link-escape-chars-browser
+ '(?\ )
+ "List of escapes for characters that are problematic in links.
+This is the list that is used before handing over to the browser.")
+
+(defun org-link-escape (text &optional table merge)
+ "Return percent escaped representation of TEXT.
+TEXT is a string with the text to escape.
+Optional argument TABLE is a list with characters that should be
+escaped. When nil, `org-link-escape-chars' is used.
+If optional argument MERGE is set, merge TABLE into
+`org-link-escape-chars'."
+ (cond
+ ((and table merge)
+ (mapc (lambda (defchr)
+ (unless (member defchr table)
+ (setq table (cons defchr table)))) org-link-escape-chars))
+ ((null table)
+ (setq table org-link-escape-chars)))
+ (mapconcat
+ (lambda (char)
+ (if (or (member char table)
+ (and (or (< char 32) (= char 37) (> char 126))
+ org-url-hexify-p))
+ (mapconcat (lambda (sequence-element)
+ (format "%%%.2X" sequence-element))
+ (or (encode-coding-char char 'utf-8)
+ (error "Unable to percent escape character: %s"
+ (char-to-string char))) "")
+ (char-to-string char))) text ""))
+
+(defun org-link-unescape (str)
+ "Unhex hexified Unicode strings as returned from the JavaScript function
+encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'."
+ (unless (and (null str) (string= "" str))
+ (let ((pos 0) (case-fold-search t) unhexed)
+ (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
+ (setq unhexed (org-link-unescape-compound (match-string 0 str)))
+ (setq str (replace-match unhexed t t str))
+ (setq pos (+ pos (length unhexed))))))
+ str)
+
+(defun org-link-unescape-compound (hex)
+ "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'.
+Note: this function also decodes single byte encodings like
+`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group."
+ (save-match-data
+ (let* ((bytes (cdr (split-string hex "%")))
+ (ret "")
+ (eat 0)
+ (sum 0))
+ (while bytes
+ (let* ((val (string-to-number (pop bytes) 16))
+ (shift-xor
+ (if (= 0 eat)
+ (cond
+ ((>= val 252) (cons 6 252))
+ ((>= val 248) (cons 5 248))
+ ((>= val 240) (cons 4 240))
+ ((>= val 224) (cons 3 224))
+ ((>= val 192) (cons 2 192))
+ (t (cons 0 0)))
+ (cons 6 128))))
+ (if (>= val 192) (setq eat (car shift-xor)))
+ (setq val (logxor val (cdr shift-xor)))
+ (setq sum (+ (lsh sum (car shift-xor)) val))
+ (if (> eat 0) (setq eat (- eat 1)))
+ (cond
+ ((= 0 eat) ;multi byte
+ (setq ret (concat ret (org-char-to-string sum)))
+ (setq sum 0))
+ ((not bytes) ; single byte(s)
+ (setq ret (org-link-unescape-single-byte-sequence hex))))
+ )) ;; end (while bytes
+ ret )))
+
+(defun org-link-unescape-single-byte-sequence (hex)
+ "Unhexify hex-encoded single byte character sequences."
+ (mapconcat (lambda (byte)
+ (char-to-string (string-to-number byte 16)))
+ (cdr (split-string hex "%")) ""))
+
+(defun org-xor (a b)
+ "Exclusive or."
+ (if a (not b) b))
+
+(defun org-fixup-message-id-for-http (s)
+ "Replace special characters in a message id, so it can be used in an http query."
+ (when (string-match "%" s)
+ (setq s (mapconcat (lambda (c)
+ (if (eq c ?%)
+ "%25"
+ (char-to-string c)))
+ s "")))
+ (while (string-match "<" s)
+ (setq s (replace-match "%3C" t t s)))
+ (while (string-match ">" s)
+ (setq s (replace-match "%3E" t t s)))
+ (while (string-match "@" s)
+ (setq s (replace-match "%40" t t s)))
+ s)
+
+(defun org-link-prettify (link)
+ "Return a human-readable representation of LINK.
+The car of LINK must be a raw link the cdr of LINK must be either
+a link description or nil."
+ (let ((desc (or (cadr link) "<no description>")))
+ (concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
+ "<" (car link) ">")))
+
+;;;###autoload
+(defun org-insert-link-global ()
+ "Insert a link like Org-mode does.
+This command can be called in any mode to insert a link in Org-mode syntax."
+ (interactive)
+ (org-load-modules-maybe)
+ (org-run-like-in-org-mode 'org-insert-link))
+
+(defun org-insert-all-links (&optional keep)
+ "Insert all links in `org-stored-links'."
+ (interactive "P")
+ (let ((links (copy-sequence org-stored-links)) l)
+ (while (setq l (if keep (pop links) (pop org-stored-links)))
+ (insert "- ")
+ (org-insert-link nil (car l) (cadr l))
+ (insert "\n"))))
+
+(defun org-link-fontify-links-to-this-file ()
+ "Fontify links to the current file in `org-stored-links'."
+ (let ((f (buffer-file-name)) a b)
+ (setq a (mapcar (lambda(l)
+ (let ((ll (car l)))
+ (when (and (string-match "^file:\\(.+\\)::" ll)
+ (equal f (expand-file-name (match-string 1 ll))))
+ ll)))
+ org-stored-links))
+ (when (featurep 'org-id)
+ (setq b (mapcar (lambda(l)
+ (let ((ll (car l)))
+ (when (and (string-match "^id:\\(.+\\)$" ll)
+ (equal f (expand-file-name
+ (or (org-id-find-id-file
+ (match-string 1 ll)) ""))))
+ ll)))
+ org-stored-links)))
+ (mapcar (lambda(l)
+ (put-text-property 0 (length l) 'face 'font-lock-comment-face l))
+ (delq nil (append a b)))))
+
+(defvar org-link-links-in-this-file nil)
+(defun org-insert-link (&optional complete-file link-location default-description)
+ "Insert a link. At the prompt, enter the link.
+
+Completion can be used to insert any of the link protocol prefixes like
+http or ftp in use.
+
+The history can be used to select a link previously stored with
+`org-store-link'. When the empty string is entered (i.e. if you just
+press RET at the prompt), the link defaults to the most recently
+stored link. As SPC triggers completion in the minibuffer, you need to
+use M-SPC or C-q SPC to force the insertion of a space character.
+
+You will also be prompted for a description, and if one is given, it will
+be displayed in the buffer instead of the link.
+
+If there is already a link at point, this command will allow you to edit link
+and description parts.
+
+With a \\[universal-argument] prefix, prompts for a file to link to. The file name can
+be selected using completion. The path to the file will be relative to the
+current directory if the file is in the current directory or a subdirectory.
+Otherwise, the link will be the absolute path as completed in the minibuffer
+\(i.e. normally ~/path/to/file). You can configure this behavior using the
+option `org-link-file-path-type'.
+
+With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in
+the current directory or below.
+
+With three \\[universal-argument] prefixes, negate the meaning of
+`org-keep-stored-link-after-insertion'.
+
+If `org-make-link-description-function' is non-nil, this function will be
+called with the link target, and the result will be the default
+link description.
+
+If the LINK-LOCATION parameter is non-nil, this value will be
+used as the link location instead of reading one interactively.
+
+If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
+be used as the default description."
+ (interactive "P")
+ (let* ((wcf (current-window-configuration))
+ (region (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))))
+ (remove (and region (list (region-beginning) (region-end))))
+ (desc region)
+ tmphist ; byte-compile incorrectly complains about this
+ (link link-location)
+ (abbrevs org-link-abbrev-alist-local)
+ entry file all-prefixes auto-desc)
+ (cond
+ (link-location) ; specified by arg, just use it.
+ ((org-in-regexp org-bracket-link-regexp 1)
+ ;; We do have a link at point, and we are going to edit it.
+ (setq remove (list (match-beginning 0) (match-end 0)))
+ (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
+ (setq link (read-string "Link: "
+ (org-link-unescape
+ (org-match-string-no-properties 1)))))
+ ((or (org-in-regexp org-angle-link-re)
+ (org-in-regexp org-plain-link-re))
+ ;; Convert to bracket link
+ (setq remove (list (match-beginning 0) (match-end 0))
+ link (read-string "Link: "
+ (org-remove-angle-brackets (match-string 0)))))
+ ((member complete-file '((4) (16)))
+ ;; Completing read for file names.
+ (setq link (org-file-complete-link complete-file)))
+ (t
+ ;; Read link, with completion for stored links.
+ (org-link-fontify-links-to-this-file)
+ (org-switch-to-buffer-other-window "*Org Links*")
+ (with-current-buffer "*Org Links*"
+ (erase-buffer)
+ (insert "Insert a link.
+Use TAB to complete link prefixes, then RET for type-specific completion support\n")
+ (when org-stored-links
+ (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
+ (insert (mapconcat 'org-link-prettify
+ (reverse org-stored-links) "\n")))
+ (goto-char (point-min)))
+ (let ((cw (selected-window)))
+ (select-window (get-buffer-window "*Org Links*" 'visible))
+ (with-current-buffer "*Org Links*" (setq truncate-lines t))
+ (unless (pos-visible-in-window-p (point-max))
+ (org-fit-window-to-buffer))
+ (and (window-live-p cw) (select-window cw)))
+ ;; Fake a link history, containing the stored links.
+ (setq tmphist (append (mapcar 'car org-stored-links)
+ org-insert-link-history))
+ (setq all-prefixes (append (mapcar 'car abbrevs)
+ (mapcar 'car org-link-abbrev-alist)
+ org-link-types))
+ (unwind-protect
+ (progn
+ (setq link
+ (let ((org-completion-use-ido nil)
+ (org-completion-use-iswitchb nil))
+ (org-completing-read
+ "Link: "
+ (append
+ (mapcar (lambda (x) (list (concat x ":")))
+ all-prefixes)
+ (mapcar 'car org-stored-links)
+ (mapcar 'cadr org-stored-links))
+ nil nil nil
+ 'tmphist
+ (caar org-stored-links))))
+ (if (not (string-match "\\S-" link))
+ (error "No link selected"))
+ (mapc (lambda(l)
+ (when (equal link (cadr l)) (setq link (car l) auto-desc t)))
+ org-stored-links)
+ (if (or (member link all-prefixes)
+ (and (equal ":" (substring link -1))
+ (member (substring link 0 -1) all-prefixes)
+ (setq link (substring link 0 -1))))
+ (setq link (org-link-try-special-completion link))))
+ (set-window-configuration wcf)
+ (kill-buffer "*Org Links*"))
+ (setq entry (assoc link org-stored-links))
+ (or entry (push link org-insert-link-history))
+ (setq desc (or desc (nth 1 entry)))))
+
+ (if (funcall (if (equal complete-file '(64)) 'not 'identity)
+ (not org-keep-stored-link-after-insertion))
+ (setq org-stored-links (delq (assoc link org-stored-links)
+ org-stored-links)))
+
+ (if (string-match org-plain-link-re link)
+ ;; URL-like link, normalize the use of angular brackets.
+ (setq link (org-remove-angle-brackets link)))
+
+ ;; Check if we are linking to the current file with a search option
+ ;; If yes, simplify the link by using only the search option.
+ (when (and buffer-file-name
+ (string-match "^file:\\(.+?\\)::\\([^>]+\\)" link))
+ (let* ((path (match-string 1 link))
+ (case-fold-search nil)
+ (search (match-string 2 link)))
+ (save-match-data
+ (if (equal (file-truename buffer-file-name) (file-truename path))
+ ;; We are linking to this same file, with a search option
+ (setq link search)))))
+
+ ;; Check if we can/should use a relative path. If yes, simplify the link
+ (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
+ (let* ((type (match-string 1 link))
+ (path (match-string 2 link))
+ (origpath path)
+ (case-fold-search nil))
+ (cond
+ ((or (eq org-link-file-path-type 'absolute)
+ (equal complete-file '(16)))
+ (setq path (abbreviate-file-name (expand-file-name path))))
+ ((eq org-link-file-path-type 'noabbrev)
+ (setq path (expand-file-name path)))
+ ((eq org-link-file-path-type 'relative)
+ (setq path (file-relative-name path)))
+ (t
+ (save-match-data
+ (if (string-match (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory
+ default-directory))))
+ (expand-file-name path))
+ ;; We are linking a file with relative path name.
+ (setq path (substring (expand-file-name path)
+ (match-end 0)))
+ (setq path (abbreviate-file-name (expand-file-name path)))))))
+ (setq link (concat type path))
+ (if (equal desc origpath)
+ (setq desc path))))
+
+ (if org-make-link-description-function
+ (setq desc
+ (or (condition-case nil
+ (funcall org-make-link-description-function link desc)
+ (error (progn (message "Can't get link description from `%s'"
+ (symbol-name org-make-link-description-function))
+ (sit-for 2) nil)))
+ (read-string "Description: " default-description)))
+ (if default-description (setq desc default-description)
+ (setq desc (or (and auto-desc desc)
+ (read-string "Description: " desc)))))
+
+ (unless (string-match "\\S-" desc) (setq desc nil))
+ (if remove (apply 'delete-region remove))
+ (insert (org-make-link-string link desc))))
+
+(defun org-link-try-special-completion (type)
+ "If there is completion support for link type TYPE, offer it."
+ (let ((fun (intern (concat "org-" type "-complete-link"))))
+ (if (functionp fun)
+ (funcall fun)
+ (read-string "Link (no completion support): " (concat type ":")))))
+
+(defun org-file-complete-link (&optional arg)
+ "Create a file link using completion."
+ (let (file link)
+ (setq file (read-file-name "File: "))
+ (let ((pwd (file-name-as-directory (expand-file-name ".")))
+ (pwd1 (file-name-as-directory (abbreviate-file-name
+ (expand-file-name ".")))))
+ (cond
+ ((equal arg '(16))
+ (setq link (concat
+ "file:"
+ (abbreviate-file-name (expand-file-name file)))))
+ ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
+ (setq link (concat "file:" (match-string 1 file))))
+ ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
+ (expand-file-name file))
+ (setq link (concat
+ "file:" (match-string 1 (expand-file-name file)))))
+ (t (setq link (concat "file:" file)))))
+ link))
+
+(defun org-completing-read (&rest args)
+ "Completing-read with SPACE being a normal character."
+ (let ((enable-recursive-minibuffers t)
+ (minibuffer-local-completion-map
+ (copy-keymap minibuffer-local-completion-map)))
+ (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
+ (org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
+ (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive)
+ (apply 'org-icompleting-read args)))
+
+(defun org-completing-read-no-i (&rest args)
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (apply 'org-completing-read args)))
+
+(defun org-iswitchb-completing-read (prompt choices &rest args)
+ "Use iswitch as a completing-read replacement to choose from choices.
+PROMPT is a string to prompt with. CHOICES is a list of strings to choose
+from."
+ (let* ((iswitchb-use-virtual-buffers nil)
+ (iswitchb-make-buflist-hook
+ (lambda ()
+ (setq iswitchb-temp-buflist choices))))
+ (iswitchb-read-buffer prompt)))
+
+(defun org-icompleting-read (&rest args)
+ "Completing-read using `ido-mode' or `iswitchb' speedups if available."
+ (org-without-partial-completion
+ (if (and org-completion-use-ido
+ (fboundp 'ido-completing-read)
+ (boundp 'ido-mode) ido-mode
+ (listp (second args)))
+ (let ((ido-enter-matching-directory nil))
+ (apply 'ido-completing-read (concat (car args))
+ (if (consp (car (nth 1 args)))
+ (mapcar 'car (nth 1 args))
+ (nth 1 args))
+ (cddr args)))
+ (if (and org-completion-use-iswitchb
+ (boundp 'iswitchb-mode) iswitchb-mode
+ (listp (second args)))
+ (apply 'org-iswitchb-completing-read (concat (car args))
+ (if (consp (car (nth 1 args)))
+ (mapcar 'car (nth 1 args))
+ (nth 1 args))
+ (cddr args))
+ (apply 'completing-read args)))))
+
+(defun org-extract-attributes (s)
+ "Extract the attributes cookie from a string and set as text property."
+ (let (a attr (start 0) key value)
+ (save-match-data
+ (when (string-match "{{\\([^}]+\\)}}$" s)
+ (setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
+ (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
+ (setq key (match-string 1 a) value (match-string 2 a)
+ start (match-end 0)
+ attr (plist-put attr (intern key) value))))
+ (org-add-props s nil 'org-attr attr))
+ s))
+
+(defun org-extract-attributes-from-string (tag)
+ (let (key value attr)
+ (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag)
+ (setq key (match-string 1 tag) value (match-string 2 tag)
+ tag (replace-match "" t t tag)
+ attr (plist-put attr (intern key) value)))
+ (cons tag attr)))
+
+(defun org-attributes-to-string (plist)
+ "Format a property list into an HTML attribute list."
+ (let ((s "") key value)
+ (while plist
+ (setq key (pop plist) value (pop plist))
+ (and value
+ (setq s (concat s " " (symbol-name key) "=\"" value "\""))))
+ s))
+
+;;; Opening/following a link
+
+(defvar org-link-search-failed nil)
+
+(defvar org-open-link-functions nil
+ "Hook for functions finding a plain text link.
+These functions must take a single argument, the link content.
+They will be called for links that look like [[link text][description]]
+when LINK TEXT does not have a protocol like \"http:\" and does not look
+like a filename (e.g. \"./blue.png\").
+
+These functions will be called *before* Org attempts to resolve the
+link by doing text searches in the current buffer - so if you want a
+link \"[[target]]\" to still find \"<<target>>\", your function should
+handle this as a special case.
+
+When the function does handle the link, it must return a non-nil value.
+If it decides that it is not responsible for this link, it must return
+nil to indicate that that Org-mode can continue with other options
+like exact and fuzzy text search.")
+
+(defun org-next-link ()
+ "Move forward to the next link.
+If the link is in hidden text, expose it."
+ (interactive)
+ (when (and org-link-search-failed (eq this-command last-command))
+ (goto-char (point-min))
+ (message "Link search wrapped back to beginning of buffer"))
+ (setq org-link-search-failed nil)
+ (let* ((pos (point))
+ (ct (org-context))
+ (a (assoc :link ct)))
+ (if a (goto-char (nth 2 a)))
+ (if (re-search-forward org-any-link-re nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (if (outline-invisible-p) (org-show-context)))
+ (goto-char pos)
+ (setq org-link-search-failed t)
+ (error "No further link found"))))
+
+(defun org-previous-link ()
+ "Move backward to the previous link.
+If the link is in hidden text, expose it."
+ (interactive)
+ (when (and org-link-search-failed (eq this-command last-command))
+ (goto-char (point-max))
+ (message "Link search wrapped back to end of buffer"))
+ (setq org-link-search-failed nil)
+ (let* ((pos (point))
+ (ct (org-context))
+ (a (assoc :link ct)))
+ (if a (goto-char (nth 1 a)))
+ (if (re-search-backward org-any-link-re nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (if (outline-invisible-p) (org-show-context)))
+ (goto-char pos)
+ (setq org-link-search-failed t)
+ (error "No further link found"))))
+
+(defun org-translate-link (s)
+ "Translate a link string if a translation function has been defined."
+ (if (and org-link-translation-function
+ (fboundp org-link-translation-function)
+ (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s))
+ (progn
+ (setq s (funcall org-link-translation-function
+ (match-string 1 s) (match-string 2 s)))
+ (concat (car s) ":" (cdr s)))
+ s))
+
+(defun org-translate-link-from-planner (type path)
+ "Translate a link from Emacs Planner syntax so that Org can follow it.
+This is still an experimental function, your mileage may vary."
+ (cond
+ ((member type '("http" "https" "news" "ftp"))
+ ;; standard Internet links are the same.
+ nil)
+ ((and (equal type "irc") (string-match "^//" path))
+ ;; Planner has two / at the beginning of an irc link, we have 1.
+ ;; We should have zero, actually....
+ (setq path (substring path 1)))
+ ((and (equal type "lisp") (string-match "^/" path))
+ ;; Planner has a slash, we do not.
+ (setq type "elisp" path (substring path 1)))
+ ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
+ ;; A typical message link. Planner has the id after the final slash,
+ ;; we separate it with a hash mark
+ (setq path (concat (match-string 1 path) "#"
+ (org-remove-angle-brackets (match-string 2 path)))))
+ )
+ (cons type path))
+
+(defun org-find-file-at-mouse (ev)
+ "Open file link or URL at mouse."
+ (interactive "e")
+ (mouse-set-point ev)
+ (org-open-at-point 'in-emacs))
+
+(defun org-open-at-mouse (ev)
+ "Open file link or URL at mouse.
+See the docstring of `org-open-file' for details."
+ (interactive "e")
+ (mouse-set-point ev)
+ (if (eq major-mode 'org-agenda-mode)
+ (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
+ (org-open-at-point))
+
+(defvar org-window-config-before-follow-link nil
+ "The window configuration before following a link.
+This is saved in case the need arises to restore it.")
+
+(defvar org-open-link-marker (make-marker)
+ "Marker pointing to the location where `org-open-at-point; was called.")
+
+;;;###autoload
+(defun org-open-at-point-global ()
+ "Follow a link like Org-mode does.
+This command can be called in any mode to follow a link that has
+Org-mode syntax."
+ (interactive)
+ (org-run-like-in-org-mode 'org-open-at-point))
+
+;;;###autoload
+(defun org-open-link-from-string (s &optional arg reference-buffer)
+ "Open a link in the string S, as if it was in Org-mode."
+ (interactive "sLink: \nP")
+ (let ((reference-buffer (or reference-buffer (current-buffer))))
+ (with-temp-buffer
+ (let ((org-inhibit-startup (not reference-buffer)))
+ (org-mode)
+ (insert s)
+ (goto-char (point-min))
+ (when reference-buffer
+ (setq org-link-abbrev-alist-local
+ (with-current-buffer reference-buffer
+ org-link-abbrev-alist-local)))
+ (org-open-at-point arg reference-buffer)))))
+
+(defvar org-open-at-point-functions nil
+ "Hook that is run when following a link at point.
+
+Functions in this hook must return t if they identify and follow
+a link at point. If they don't find anything interesting at point,
+they must return nil.")
+
+(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
+(defun org-open-at-point (&optional arg reference-buffer)
+ "Open link at or after point.
+If there is no link at point, this function will search forward up to
+the end of the current line.
+Normally, files will be opened by an appropriate application. If the
+optional prefix argument ARG is non-nil, Emacs will visit the file.
+With a double prefix argument, try to open outside of Emacs, in the
+application the system uses for this file type."
+ (interactive "P")
+ ;; if in a code block, then open the block's results
+ (unless (call-interactively #'org-babel-open-src-block-result)
+ (org-load-modules-maybe)
+ (move-marker org-open-link-marker (point))
+ (setq org-window-config-before-follow-link (current-window-configuration))
+ (org-remove-occur-highlights nil nil t)
+ (cond
+ ((and (org-at-heading-p)
+ (not (org-at-timestamp-p t))
+ (not (org-in-regexp
+ (concat org-plain-link-re "\\|"
+ org-bracket-link-regexp "\\|"
+ org-angle-link-re "\\|"
+ "[ \t]:[^ \t\n]+:[ \t]*$")))
+ (not (get-text-property (point) 'org-linked-text)))
+ (or (org-offer-links-in-entry arg)
+ (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
+ ((run-hook-with-args-until-success 'org-open-at-point-functions))
+ ((and (org-at-timestamp-p t)
+ (not (org-in-regexp org-bracket-link-regexp)))
+ (org-follow-timestamp-link))
+ ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
+ (not (org-in-regexp org-bracket-link-regexp)))
+ (org-footnote-action))
+ (t
+ (let (type path link line search (pos (point)))
+ (catch 'match
+ (save-excursion
+ (skip-chars-forward "^]\n\r")
+ (when (org-in-regexp org-bracket-link-regexp 1)
+ (setq link (org-extract-attributes
+ (org-link-unescape (org-match-string-no-properties 1))))
+ (while (string-match " *\n *" link)
+ (setq link (replace-match " " t t link)))
+ (setq link (org-link-expand-abbrev link))
+ (cond
+ ((or (file-name-absolute-p link)
+ (string-match "^\\.\\.?/" link))
+ (setq type "file" path link))
+ ((string-match org-link-re-with-space3 link)
+ (setq type (match-string 1 link) path (match-string 2 link)))
+ ((string-match "^help:+\\(.+\\)" link)
+ (setq type "help" path (match-string 1 link)))
+ (t (setq type "thisfile" path link)))
+ (throw 'match t)))
+
+ (when (get-text-property (point) 'org-linked-text)
+ (setq type "thisfile"
+ pos (if (get-text-property (1+ (point)) 'org-linked-text)
+ (1+ (point)) (point))
+ path (buffer-substring
+ (or (previous-single-property-change pos 'org-linked-text)
+ (point-min))
+ (or (next-single-property-change pos 'org-linked-text)
+ (point-max))))
+ (throw 'match t))
+
+ (save-excursion
+ (when (or (org-in-regexp org-angle-link-re)
+ (and (goto-char (car (org-in-regexp org-plain-link-re)))
+ (save-match-data (not (looking-back "\\[\\[")))))
+ (setq type (match-string 1)
+ path (org-link-unescape (match-string 2)))
+ (throw 'match t)))
+ (save-excursion
+ (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
+ (setq type "tags"
+ path (match-string 1))
+ (while (string-match ":" path)
+ (setq path (replace-match "+" t t path)))
+ (throw 'match t)))
+ (when (org-in-regexp "<\\([^><\n]+\\)>")
+ (setq type "tree-match"
+ path (match-string 1))
+ (throw 'match t)))
+ (unless path
+ (error "No link found"))
+
+ ;; switch back to reference buffer
+ ;; needed when if called in a temporary buffer through
+ ;; org-open-link-from-string
+ (with-current-buffer (or reference-buffer (current-buffer))
+
+ ;; Remove any trailing spaces in path
+ (if (string-match " +\\'" path)
+ (setq path (replace-match "" t t path)))
+ (if (and org-link-translation-function
+ (fboundp org-link-translation-function))
+ ;; Check if we need to translate the link
+ (let ((tmp (funcall org-link-translation-function type path)))
+ (setq type (car tmp) path (cdr tmp))))
+
+ (cond
+
+ ((assoc type org-link-protocols)
+ (funcall (nth 1 (assoc type org-link-protocols)) path))
+
+ ((equal type "help")
+ (let ((f-or-v (intern path)))
+ (cond ((fboundp f-or-v)
+ (describe-function f-or-v))
+ ((boundp f-or-v)
+ (describe-variable f-or-v))
+ (t (error "Not a known function or variable")))))
+
+ ((equal type "mailto")
+ (let ((cmd (car org-link-mailto-program))
+ (args (cdr org-link-mailto-program)) args1
+ (address path) (subject "") a)
+ (if (string-match "\\(.*\\)::\\(.*\\)" path)
+ (setq address (match-string 1 path)
+ subject (org-link-escape (match-string 2 path))))
+ (while args
+ (cond
+ ((not (stringp (car args))) (push (pop args) args1))
+ (t (setq a (pop args))
+ (if (string-match "%a" a)
+ (setq a (replace-match address t t a)))
+ (if (string-match "%s" a)
+ (setq a (replace-match subject t t a)))
+ (push a args1))))
+ (apply cmd (nreverse args1))))
+
+ ((member type '("http" "https" "ftp" "news"))
+ (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
+ (org-link-escape
+ path org-link-escape-chars-browser)
+ path))))
+
+ ((string= type "doi")
+ (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path)
+ (org-link-escape
+ path org-link-escape-chars-browser)
+ path))))
+
+ ((member type '("message"))
+ (browse-url (concat type ":" path)))
+
+ ((string= type "tags")
+ (org-tags-view arg path))
+
+ ((string= type "tree-match")
+ (org-occur (concat "\\[" (regexp-quote path) "\\]")))
+
+ ((string= type "file")
+ (if (string-match "::\\([0-9]+\\)\\'" path)
+ (setq line (string-to-number (match-string 1 path))
+ path (substring path 0 (match-beginning 0)))
+ (if (string-match "::\\(.+\\)\\'" path)
+ (setq search (match-string 1 path)
+ path (substring path 0 (match-beginning 0)))))
+ (if (string-match "[*?{]" (file-name-nondirectory path))
+ (dired path)
+ (org-open-file path arg line search)))
+
+ ((string= type "shell")
+ (let ((buf (generate-new-buffer "*Org Shell Output"))
+ (cmd path))
+ (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
+ (string-match org-confirm-shell-link-not-regexp cmd))
+ (not org-confirm-shell-link-function)
+ (funcall org-confirm-shell-link-function
+ (format "Execute \"%s\" in shell? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (progn
+ (message "Executing %s" cmd)
+ (shell-command cmd buf)
+ (if (featurep 'midnight)
+ (setq clean-buffer-list-kill-buffer-names
+ (cons buf clean-buffer-list-kill-buffer-names))))
+ (error "Abort"))))
+
+ ((string= type "elisp")
+ (let ((cmd path))
+ (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
+ (string-match org-confirm-elisp-link-not-regexp cmd))
+ (not org-confirm-elisp-link-function)
+ (funcall org-confirm-elisp-link-function
+ (format "Execute \"%s\" as elisp? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (message "%s => %s" cmd
+ (if (equal (string-to-char cmd) ?\()
+ (eval (read cmd))
+ (call-interactively (read cmd))))
+ (error "Abort"))))
+
+ ((and (string= type "thisfile")
+ (run-hook-with-args-until-success
+ 'org-open-link-functions path)))
+
+ ((string= type "thisfile")
+ (if arg
+ (switch-to-buffer-other-window
+ (org-get-buffer-for-internal-link (current-buffer)))
+ (org-mark-ring-push))
+ (let ((cmd `(org-link-search
+ ,path
+ ,(cond ((equal arg '(4)) ''occur)
+ ((equal arg '(16)) ''org-occur))
+ ,pos)))
+ (condition-case nil (let ((org-link-search-inhibit-query t))
+ (eval cmd))
+ (error (progn (widen) (eval cmd))))))
+
+ (t (browse-url-at-point)))))))
+ (move-marker org-open-link-marker nil)
+ (run-hook-with-args 'org-follow-link-hook)))
+
+(defun org-offer-links-in-entry (&optional nth zero)
+ "Offer links in the current entry and follow the selected link.
+If there is only one link, follow it immediately as well.
+If NTH is an integer, immediately pick the NTH link found.
+If ZERO is a string, check also this string for a link, and if
+there is one, offer it as link number zero."
+ (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
+ "\\(" org-angle-link-re "\\)\\|"
+ "\\(" org-plain-link-re "\\)"))
+ (cnt ?0)
+ (in-emacs (if (integerp nth) nil nth))
+ have-zero end links link c)
+ (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
+ (push (match-string 0 zero) links)
+ (setq cnt (1- cnt) have-zero t))
+ (save-excursion
+ (org-back-to-heading t)
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (while (re-search-forward re end t)
+ (push (match-string 0) links))
+ (setq links (org-uniquify (reverse links))))
+
+ (cond
+ ((null links)
+ (message "No links"))
+ ((equal (length links) 1)
+ (setq link (list (car links))))
+ ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
+ (setq link (list (nth (if have-zero nth (1- nth)) links))))
+ (t ; we have to select a link
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Select Link*"
+ (mapc (lambda (l)
+ (if (not (string-match org-bracket-link-regexp l))
+ (princ (format "[%c] %s\n" (incf cnt)
+ (org-remove-angle-brackets l)))
+ (if (match-end 3)
+ (princ (format "[%c] %s (%s)\n" (incf cnt)
+ (match-string 3 l) (match-string 1 l)))
+ (princ (format "[%c] %s\n" (incf cnt)
+ (match-string 1 l))))))
+ links))
+ (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
+ (message "Select link to open, RET to open all:")
+ (setq c (read-char-exclusive))
+ (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
+ (when (equal c ?q) (error "Abort"))
+ (if (equal c ?\C-m)
+ (setq link links)
+ (setq nth (- c ?0))
+ (if have-zero (setq nth (1+ nth)))
+ (unless (and (integerp nth) (>= (length links) nth))
+ (error "Invalid link selection"))
+ (setq link (list (nth (1- nth) links))))))
+ (if link
+ (let ((buf (current-buffer)))
+ (dolist (l link)
+ (org-open-link-from-string l in-emacs buf))
+ t)
+ nil)))
+
+;; Add special file links that specify the way of opening
+
+(org-add-link-type "file+sys" 'org-open-file-with-system)
+(org-add-link-type "file+emacs" 'org-open-file-with-emacs)
+(defun org-open-file-with-system (path)
+ "Open file at PATH using the system way of opening it."
+ (org-open-file path 'system))
+(defun org-open-file-with-emacs (path)
+ "Open file at PATH in Emacs."
+ (org-open-file path 'emacs))
+(defun org-remove-file-link-modifiers ()
+ "Remove the file link modifiers in `file+sys:' and `file+emacs:' links."
+ (goto-char (point-min))
+ (while (re-search-forward "\\<file\\+\\(sys\\|emacs\\):" nil t)
+ (org-if-unprotected
+ (replace-match "file:" t t))))
+(eval-after-load "org-exp"
+ '(add-hook 'org-export-preprocess-before-normalizing-links-hook
+ 'org-remove-file-link-modifiers))
+
+;;;; Time estimates
+
+(defun org-get-effort (&optional pom)
+ "Get the effort estimate for the current entry."
+ (org-entry-get pom org-effort-property))
+
+;;; File search
+
+(defvar org-create-file-search-functions nil
+ "List of functions to construct the right search string for a file link.
+These functions are called in turn with point at the location to
+which the link should point.
+
+A function in the hook should first test if it would like to
+handle this file type, for example by checking the `major-mode'
+or the file extension. If it decides not to handle this file, it
+should just return nil to give other functions a chance. If it
+does handle the file, it must return the search string to be used
+when following the link. The search string will be part of the
+file link, given after a double colon, and `org-open-at-point'
+will automatically search for it. If special measures must be
+taken to make the search successful, another function should be
+added to the companion hook `org-execute-file-search-functions',
+which see.
+
+A function in this hook may also use `setq' to set the variable
+`description' to provide a suggestion for the descriptive text to
+be used for this link when it gets inserted into an Org-mode
+buffer with \\[org-insert-link].")
+
+(defvar org-execute-file-search-functions nil
+ "List of functions to execute a file search triggered by a link.
+
+Functions added to this hook must accept a single argument, the
+search string that was part of the file link, the part after the
+double colon. The function must first check if it would like to
+handle this search, for example by checking the `major-mode' or
+the file extension. If it decides not to handle this search, it
+should just return nil to give other functions a chance. If it
+does handle the search, it must return a non-nil value to keep
+other functions from trying.
+
+Each function can access the current prefix argument through the
+variable `current-prefix-argument'. Note that a single prefix is
+used to force opening a link in Emacs, so it may be good to only
+use a numeric or double prefix to guide the search function.
+
+In case this is needed, a function in this hook can also restore
+the window configuration before `org-open-at-point' was called using:
+
+ (set-window-configuration org-window-config-before-follow-link)")
+
+(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
+(defun org-link-search (s &optional type avoid-pos stealth)
+ "Search for a link search option.
+If S is surrounded by forward slashes, it is interpreted as a
+regular expression. In org-mode files, this will create an `org-occur'
+sparse tree. In ordinary files, `occur' will be used to list matches.
+If the current buffer is in `dired-mode', grep will be used to search
+in all files. If AVOID-POS is given, ignore matches near that position.
+
+When optional argument STEALTH is non-nil, do not modify
+visibility around point, thus ignoring
+`org-show-hierarchy-above', `org-show-following-heading' and
+`org-show-siblings' variables."
+ (let ((case-fold-search t)
+ (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
+ (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
+ (append '(("") (" ") ("\t") ("\n"))
+ org-emphasis-alist)
+ "\\|") "\\)"))
+ (pos (point))
+ (pre nil) (post nil)
+ words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall)
+ (cond
+ ;; First check if there are any special search functions
+ ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
+ ;; Now try the builtin stuff
+ ((and (equal (string-to-char s0) ?#)
+ (> (length s0) 1)
+ (save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
+ (setq type 'dedicated
+ pos (match-beginning 0))))
+ ;; There is an exact target for this
+ (goto-char pos)
+ (org-back-to-heading t)))
+ ((save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (concat "<<" (regexp-quote s0) ">>") nil t)
+ (setq type 'dedicated
+ pos (match-beginning 0))))
+ ;; There is an exact target for this
+ (goto-char pos))
+ ((save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (format "^[ \t]*#\\+TARGET: %s" (regexp-quote s0)) nil t)
+ (setq type 'dedicated pos (match-beginning 0))))
+ ;; Found an invisible target.
+ (goto-char pos))
+ ((save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t)
+ (setq type 'dedicated pos (match-beginning 0))))
+ ;; Found an element with a matching #+name affiliated keyword.
+ (goto-char pos))
+ ((and (string-match "^(\\(.*\\))$" s0)
+ (save-excursion
+ (goto-char (point-min))
+ (and
+ (re-search-forward
+ (concat "[^[]" (regexp-quote
+ (format org-coderef-label-format
+ (match-string 1 s0))))
+ nil t)
+ (setq type 'dedicated
+ pos (1+ (match-beginning 0))))))
+ ;; There is a coderef target for this
+ (goto-char pos))
+ ((string-match "^/\\(.*\\)/$" s)
+ ;; A regular expression
+ (cond
+ ((derived-mode-p 'org-mode)
+ (org-occur (match-string 1 s)))
+ ;;((eq major-mode 'dired-mode)
+ ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
+ (t (org-do-occur (match-string 1 s)))))
+ ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline)
+ (and (equal (string-to-char s) ?*) (setq s (substring s 1)))
+ (goto-char (point-min))
+ (cond
+ ((let (case-fold-search)
+ (re-search-forward (format org-complex-heading-regexp-format
+ (regexp-quote s))
+ nil t))
+ ;; OK, found a match
+ (setq type 'dedicated)
+ (goto-char (match-beginning 0)))
+ ((and (not org-link-search-inhibit-query)
+ (eq org-link-search-must-match-exact-headline 'query-to-create)
+ (y-or-n-p "No match - create this as a new heading? "))
+ (goto-char (point-max))
+ (or (bolp) (newline))
+ (insert "* " s "\n")
+ (beginning-of-line 0))
+ (t
+ (goto-char pos)
+ (error "No match"))))
+ (t
+ ;; A normal search string
+ (when (equal (string-to-char s) ?*)
+ ;; Anchor on headlines, post may include tags.
+ (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
+ post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$")
+ s (substring s 1)))
+ (remove-text-properties
+ 0 (length s)
+ '(face nil mouse-face nil keymap nil fontified nil) s)
+ ;; Make a series of regular expressions to find a match
+ (setq words (org-split-string s "[ \n\r\t]+")
+
+ re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
+ re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
+ "\\)" markers)
+ re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
+ re2a (concat "[ \t\r\n]" re2a_)
+ re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
+ re4 (concat "[^a-zA-Z_]" re4_)
+
+ re1 (concat pre re2 post)
+ re3 (concat pre (if pre re4_ re4) post)
+ re5 (concat pre ".*" re4)
+ re2 (concat pre re2)
+ re2a (concat pre (if pre re2a_ re2a))
+ re4 (concat pre (if pre re4_ re4))
+ reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
+ "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
+ re5 "\\)"
+ ))
+ (cond
+ ((eq type 'org-occur) (org-occur reall))
+ ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
+ (t (goto-char (point-min))
+ (setq type 'fuzzy)
+ (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated))
+ (org-search-not-self 1 re1 nil t)
+ (org-search-not-self 1 re2 nil t)
+ (org-search-not-self 1 re2a nil t)
+ (org-search-not-self 1 re3 nil t)
+ (org-search-not-self 1 re4 nil t)
+ (org-search-not-self 1 re5 nil t)
+ )
+ (goto-char (match-beginning 1))
+ (goto-char pos)
+ (error "No match"))))))
+ (and (derived-mode-p 'org-mode)
+ (not stealth)
+ (org-show-context 'link-search))
+ type))
+
+(defun org-search-not-self (group &rest args)
+ "Execute `re-search-forward', but only accept matches that do not
+enclose the position of `org-open-link-marker'."
+ (let ((m org-open-link-marker))
+ (catch 'exit
+ (while (apply 're-search-forward args)
+ (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
+ (goto-char (match-end group))
+ (if (and (or (not (eq (marker-buffer m) (current-buffer)))
+ (> (match-beginning 0) (marker-position m))
+ (< (match-end 0) (marker-position m)))
+ (save-match-data
+ (or (not (org-in-regexp
+ org-bracket-link-analytic-regexp 1))
+ (not (match-end 4)) ; no description
+ (and (<= (match-beginning 4) (point))
+ (>= (match-end 4) (point))))))
+ (throw 'exit (point))))))))
+
+(defun org-get-buffer-for-internal-link (buffer)
+ "Return a buffer to be used for displaying the link target of internal links."
+ (cond
+ ((not org-display-internal-link-with-indirect-buffer)
+ buffer)
+ ((string-match "(Clone)$" (buffer-name buffer))
+ (message "Buffer is already a clone, not making another one")
+ ;; we also do not modify visibility in this case
+ buffer)
+ (t ; make a new indirect buffer for displaying the link
+ (let* ((bn (buffer-name buffer))
+ (ibn (concat bn "(Clone)"))
+ (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
+ (with-current-buffer ib (org-overview))
+ ib))))
+
+(defun org-do-occur (regexp &optional cleanup)
+ "Call the Emacs command `occur'.
+If CLEANUP is non-nil, remove the printout of the regular expression
+in the *Occur* buffer. This is useful if the regex is long and not useful
+to read."
+ (occur regexp)
+ (when cleanup
+ (let ((cwin (selected-window)) win beg end)
+ (when (setq win (get-buffer-window "*Occur*"))
+ (select-window win))
+ (goto-char (point-min))
+ (when (re-search-forward "match[a-z]+" nil t)
+ (setq beg (match-end 0))
+ (if (re-search-forward "^[ \t]*[0-9]+" nil t)
+ (setq end (1- (match-beginning 0)))))
+ (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
+ (goto-char (point-min))
+ (select-window cwin))))
+
+;;; The mark ring for links jumps
+
+(defvar org-mark-ring nil
+ "Mark ring for positions before jumps in Org-mode.")
+(defvar org-mark-ring-last-goto nil
+ "Last position in the mark ring used to go back.")
+;; Fill and close the ring
+(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
+(loop for i from 1 to org-mark-ring-length do
+ (push (make-marker) org-mark-ring))
+(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
+ org-mark-ring)
+
+(defun org-mark-ring-push (&optional pos buffer)
+ "Put the current position or POS into the mark ring and rotate it."
+ (interactive)
+ (setq pos (or pos (point)))
+ (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
+ (move-marker (car org-mark-ring)
+ (or pos (point))
+ (or buffer (current-buffer)))
+ (message "%s"
+ (substitute-command-keys
+ "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
+
+(defun org-mark-ring-goto (&optional n)
+ "Jump to the previous position in the mark ring.
+With prefix arg N, jump back that many stored positions. When
+called several times in succession, walk through the entire ring.
+Org-mode commands jumping to a different position in the current file,
+or to another Org-mode file, automatically push the old position
+onto the ring."
+ (interactive "p")
+ (let (p m)
+ (if (eq last-command this-command)
+ (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
+ (setq p org-mark-ring))
+ (setq org-mark-ring-last-goto p)
+ (setq m (car p))
+ (org-pop-to-buffer-same-window (marker-buffer m))
+ (goto-char m)
+ (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+
+(defun org-remove-angle-brackets (s)
+ (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
+ (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
+ s)
+(defun org-add-angle-brackets (s)
+ (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
+ (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
+ s)
+(defun org-remove-double-quotes (s)
+ (if (equal (substring s 0 1) "\"") (setq s (substring s 1)))
+ (if (equal (substring s -1) "\"") (setq s (substring s 0 -1)))
+ s)
+
+;;; Following specific links
+
+(defun org-follow-timestamp-link ()
+ "Open an agenda view for the time-stamp date/range at point."
+ (cond
+ ((org-at-date-range-p t)
+ (let ((org-agenda-start-on-weekday)
+ (t1 (match-string 1))
+ (t2 (match-string 2)) tt1 tt2)
+ (setq tt1 (time-to-days (org-time-string-to-time t1))
+ tt2 (time-to-days (org-time-string-to-time t2)))
+ (let ((org-agenda-buffer-tmp-name
+ (format "*Org Agenda(a:%s)"
+ (concat (substring t1 0 10) "--" (substring t2 0 10)))))
+ (org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
+ ((org-at-timestamp-p t)
+ (let ((org-agenda-buffer-tmp-name
+ (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
+ (org-agenda-list nil (time-to-days (org-time-string-to-time
+ (substring (match-string 1) 0 10)))
+ 1)))
+ (t (error "This should not happen"))))
+
+
+;;; Following file links
+(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
+(declare-function mailcap-extension-to-mime "mailcap" (extn))
+(declare-function mailcap-mime-info
+ "mailcap" (string &optional request no-decode))
+(defvar org-wait nil)
+(defun org-open-file (path &optional in-emacs line search)
+ "Open the file at PATH.
+First, this expands any special file name abbreviations. Then the
+configuration variable `org-file-apps' is checked if it contains an
+entry for this file type, and if yes, the corresponding command is launched.
+
+If no application is found, Emacs simply visits the file.
+
+With optional prefix argument IN-EMACS, Emacs will visit the file.
+With a double \\[universal-argument] \\[universal-argument] \
+prefix arg, Org tries to avoid opening in Emacs
+and to use an external application to visit the file.
+
+Optional LINE specifies a line to go to, optional SEARCH a string
+to search for. If LINE or SEARCH is given, the file will be
+opened in Emacs, unless an entry from org-file-apps that makes
+use of groups in a regexp matches.
+
+If you want to change the way frames are used when following a
+link, please customize `org-link-frame-setup'.
+
+If the file does not exist, an error is thrown."
+ (let* ((file (if (equal path "")
+ buffer-file-name
+ (substitute-in-file-name (expand-file-name path))))
+ (file-apps (append org-file-apps (org-default-apps)))
+ (apps (org-remove-if
+ 'org-file-apps-entry-match-against-dlink-p file-apps))
+ (apps-dlink (org-remove-if-not
+ 'org-file-apps-entry-match-against-dlink-p file-apps))
+ (remp (and (assq 'remote apps) (org-file-remote-p file)))
+ (dirp (if remp nil (file-directory-p file)))
+ (file (if (and dirp org-open-directory-means-index-dot-org)
+ (concat (file-name-as-directory file) "index.org")
+ file))
+ (a-m-a-p (assq 'auto-mode apps))
+ (dfile (downcase file))
+ ;; reconstruct the original file: link from the PATH, LINE and SEARCH args
+ (link (cond ((and (eq line nil)
+ (eq search nil))
+ file)
+ (line
+ (concat file "::" (number-to-string line)))
+ (search
+ (concat file "::" search))))
+ (dlink (downcase link))
+ (old-buffer (current-buffer))
+ (old-pos (point))
+ (old-mode major-mode)
+ ext cmd link-match-data)
+ (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile)
+ (setq ext (match-string 1 dfile))
+ (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile)
+ (setq ext (match-string 1 dfile))))
+ (cond
+ ((member in-emacs '((16) system))
+ (setq cmd (cdr (assoc 'system apps))))
+ (in-emacs (setq cmd 'emacs))
+ (t
+ (setq cmd (or (and remp (cdr (assoc 'remote apps)))
+ (and dirp (cdr (assoc 'directory apps)))
+ ; first, try matching against apps-dlink
+ ; if we get a match here, store the match data for later
+ (let ((match (assoc-default dlink apps-dlink
+ 'string-match)))
+ (if match
+ (progn (setq link-match-data (match-data))
+ match)
+ (progn (setq in-emacs (or in-emacs line search))
+ nil))) ; if we have no match in apps-dlink,
+ ; always open the file in emacs if line or search
+ ; is given (for backwards compatibility)
+ (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
+ 'string-match)
+ (cdr (assoc ext apps))
+ (cdr (assoc t apps))))))
+ (when (eq cmd 'system)
+ (setq cmd (cdr (assoc 'system apps))))
+ (when (eq cmd 'default)
+ (setq cmd (cdr (assoc t apps))))
+ (when (eq cmd 'mailcap)
+ (require 'mailcap)
+ (mailcap-parse-mailcaps)
+ (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
+ (command (mailcap-mime-info mime-type)))
+ (if (stringp command)
+ (setq cmd command)
+ (setq cmd 'emacs))))
+ (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
+ (not (file-exists-p file))
+ (not org-open-non-existing-files))
+ (error "No such file: %s" file))
+ (cond
+ ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
+ ;; Remove quotes around the file name - we'll use shell-quote-argument.
+ (while (string-match "['\"]%s['\"]" cmd)
+ (setq cmd (replace-match "%s" t t cmd)))
+ (while (string-match "%s" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument
+ (convert-standard-filename file)))
+ t t cmd)))
+
+ ;; Replace "%1", "%2" etc. in command with group matches from regex
+ (save-match-data
+ (let ((match-index 1)
+ (number-of-groups (- (/ (length link-match-data) 2) 1)))
+ (set-match-data link-match-data)
+ (while (<= match-index number-of-groups)
+ (let ((regex (concat "%" (number-to-string match-index)))
+ (replace-with (match-string match-index dlink)))
+ (while (string-match regex cmd)
+ (setq cmd (replace-match replace-with t t cmd))))
+ (setq match-index (+ match-index 1)))))
+
+ (save-window-excursion
+ (start-process-shell-command cmd nil cmd)
+ (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
+ ))
+ ((or (stringp cmd)
+ (eq cmd 'emacs))
+ (funcall (cdr (assq 'file org-link-frame-setup)) file)
+ (widen)
+ (if line (org-goto-line line)
+ (if search (org-link-search search))))
+ ((consp cmd)
+ (let ((file (convert-standard-filename file)))
+ (save-match-data
+ (set-match-data link-match-data)
+ (eval cmd))))
+ (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
+ (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode)
+ (or (not (equal old-buffer (current-buffer)))
+ (not (equal old-pos (point))))
+ (org-mark-ring-push old-pos old-buffer))))
+
+(defun org-file-apps-entry-match-against-dlink-p (entry)
+ "This function returns non-nil if `entry' uses a regular
+expression which should be matched against the whole link by
+org-open-file.
+
+It assumes that is the case when the entry uses a regular
+expression which has at least one grouping construct and the
+action is either a lisp form or a command string containing
+'%1', i.e. using at least one subexpression match as a
+parameter."
+ (let ((selector (car entry))
+ (action (cdr entry)))
+ (if (stringp selector)
+ (and (> (regexp-opt-depth selector) 0)
+ (or (and (stringp action)
+ (string-match "%[0-9]" action))
+ (consp action)))
+ nil)))
+
+(defun org-default-apps ()
+ "Return the default applications for this operating system."
+ (cond
+ ((eq system-type 'darwin)
+ org-file-apps-defaults-macosx)
+ ((eq system-type 'windows-nt)
+ org-file-apps-defaults-windowsnt)
+ (t org-file-apps-defaults-gnu)))
+
+(defun org-apps-regexp-alist (list &optional add-auto-mode)
+ "Convert extensions to regular expressions in the cars of LIST.
+Also, weed out any non-string entries, because the return value is used
+only for regexp matching.
+When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist'
+point to the symbol `emacs', indicating that the file should
+be opened in Emacs."
+ (append
+ (delq nil
+ (mapcar (lambda (x)
+ (if (not (stringp (car x)))
+ nil
+ (if (string-match "\\W" (car x))
+ x
+ (cons (concat "\\." (car x) "\\'") (cdr x)))))
+ list))
+ (if add-auto-mode
+ (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
+
+(defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
+(defun org-file-remote-p (file)
+ "Test whether FILE specifies a location on a remote system.
+Return non-nil if the location is indeed remote.
+
+For example, the filename \"/user@host:/foo\" specifies a location
+on the system \"/user@host:\"."
+ (cond ((fboundp 'file-remote-p)
+ (file-remote-p file))
+ ((fboundp 'tramp-handle-file-remote-p)
+ (tramp-handle-file-remote-p file))
+ ((and (boundp 'ange-ftp-name-format)
+ (string-match (car ange-ftp-name-format) file))
+ t)))
+
+
+;;;; Refiling
+
+(defun org-get-org-file ()
+ "Read a filename, with default directory `org-directory'."
+ (let ((default (or org-default-notes-file remember-data-file)))
+ (read-file-name (format "File name [%s]: " default)
+ (file-name-as-directory org-directory)
+ default)))
+
+(defun org-notes-order-reversed-p ()
+ "Check if the current file should receive notes in reversed order."
+ (cond
+ ((not org-reverse-note-order) nil)
+ ((eq t org-reverse-note-order) t)
+ ((not (listp org-reverse-note-order)) nil)
+ (t (catch 'exit
+ (let ((all org-reverse-note-order)
+ entry)
+ (while (setq entry (pop all))
+ (if (string-match (car entry) buffer-file-name)
+ (throw 'exit (cdr entry))))
+ nil)))))
+
+(defvar org-refile-target-table nil
+ "The list of refile targets, created by `org-refile'.")
+
+(defvar org-agenda-new-buffers nil
+ "Buffers created to visit agenda files.")
+
+(defvar org-refile-cache nil
+ "Cache for refile targets.")
+
+(defvar org-refile-markers nil
+ "All the markers used for caching refile locations.")
+
+(defun org-refile-marker (pos)
+ "Get a new refile marker, but only if caching is in use."
+ (if (not org-refile-use-cache)
+ pos
+ (let ((m (make-marker)))
+ (move-marker m pos)
+ (push m org-refile-markers)
+ m)))
+
+(defun org-refile-cache-clear ()
+ "Clear the refile cache and disable all the markers."
+ (mapc (lambda (m) (move-marker m nil)) org-refile-markers)
+ (setq org-refile-markers nil)
+ (setq org-refile-cache nil)
+ (message "Refile cache has been cleared"))
+
+(defun org-refile-cache-check-set (set)
+ "Check if all the markers in the cache still have live buffers."
+ (let (marker)
+ (catch 'exit
+ (while (and set (setq marker (nth 3 (pop set))))
+ ;; if org-refile-use-outline-path is 'file, marker may be nil
+ (when (and marker (null (marker-buffer marker)))
+ (message "not found") (sit-for 3)
+ (throw 'exit nil)))
+ t)))
+
+(defun org-refile-cache-put (set &rest identifiers)
+ "Push the refile targets SET into the cache, under IDENTIFIERS."
+ (let* ((key (sha1 (prin1-to-string identifiers)))
+ (entry (assoc key org-refile-cache)))
+ (if entry
+ (setcdr entry set)
+ (push (cons key set) org-refile-cache))))
+
+(defun org-refile-cache-get (&rest identifiers)
+ "Retrieve the cached value for refile targets given by IDENTIFIERS."
+ (cond
+ ((not org-refile-cache) nil)
+ ((not org-refile-use-cache) (org-refile-cache-clear) nil)
+ (t
+ (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
+ org-refile-cache))))
+ (and set (org-refile-cache-check-set set) set)))))
+
+(defun org-refile-get-targets (&optional default-buffer excluded-entries)
+ "Produce a table with refile targets."
+ (let ((case-fold-search nil)
+ ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
+ (entries (or org-refile-targets '((nil . (:level . 1)))))
+ targets tgs txt re files f desc descre fast-path-p level pos0)
+ (message "Getting targets...")
+ (with-current-buffer (or default-buffer (current-buffer))
+ (while (setq entry (pop entries))
+ (setq files (car entry) desc (cdr entry))
+ (setq fast-path-p nil)
+ (cond
+ ((null files) (setq files (list (current-buffer))))
+ ((eq files 'org-agenda-files)
+ (setq files (org-agenda-files 'unrestricted)))
+ ((and (symbolp files) (fboundp files))
+ (setq files (funcall files)))
+ ((and (symbolp files) (boundp files))
+ (setq files (symbol-value files))))
+ (if (stringp files) (setq files (list files)))
+ (cond
+ ((eq (car desc) :tag)
+ (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
+ ((eq (car desc) :todo)
+ (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
+ ((eq (car desc) :regexp)
+ (setq descre (cdr desc)))
+ ((eq (car desc) :level)
+ (setq descre (concat "^\\*\\{" (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ ((eq (car desc) :maxlevel)
+ (setq fast-path-p t)
+ (setq descre (concat "^\\*\\{1," (number-to-string
+ (if org-odd-levels-only
+ (1- (* 2 (cdr desc)))
+ (cdr desc)))
+ "\\}[ \t]")))
+ (t (error "Bad refiling target description %s" desc)))
+ (while (setq f (pop files))
+ (with-current-buffer
+ (if (bufferp f) f (org-get-agenda-file-buffer f))
+ (or
+ (setq tgs (org-refile-cache-get (buffer-file-name) descre))
+ (progn
+ (if (bufferp f) (setq f (buffer-file-name
+ (buffer-base-buffer f))))
+ (setq f (and f (expand-file-name f)))
+ (if (eq org-refile-use-outline-path 'file)
+ (push (list (file-name-nondirectory f) f nil nil) tgs))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward descre nil t)
+ (goto-char (setq pos0 (point-at-bol)))
+ (catch 'next
+ (when org-refile-target-verify-function
+ (save-match-data
+ (or (funcall org-refile-target-verify-function)
+ (throw 'next t))))
+ (when (and (looking-at org-complex-heading-regexp)
+ (not (member (match-string 4) excluded-entries))
+ (match-string 4))
+ (setq level (org-reduced-level
+ (- (match-end 1) (match-beginning 1)))
+ txt (org-link-display-format (match-string 4))
+ txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt)
+ re (format org-complex-heading-regexp-format
+ (regexp-quote (match-string 4))))
+ (when org-refile-use-outline-path
+ (setq txt (mapconcat
+ 'org-protect-slash
+ (append
+ (if (eq org-refile-use-outline-path
+ 'file)
+ (list (file-name-nondirectory
+ (buffer-file-name
+ (buffer-base-buffer))))
+ (if (eq org-refile-use-outline-path
+ 'full-file-path)
+ (list (buffer-file-name
+ (buffer-base-buffer)))))
+ (org-get-outline-path fast-path-p
+ level txt)
+ (list txt))
+ "/")))
+ (push (list txt f re (org-refile-marker (point)))
+ tgs)))
+ (when (= (point) pos0)
+ ;; verification function has not moved point
+ (goto-char (point-at-eol))))))))
+ (when org-refile-use-cache
+ (org-refile-cache-put tgs (buffer-file-name) descre))
+ (setq targets (append tgs targets))
+ ))))
+ (message "Getting targets...done")
+ (nreverse targets)))
+
+(defun org-protect-slash (s)
+ (while (string-match "/" s)
+ (setq s (replace-match "\\" t t s)))
+ s)
+
+(defvar org-olpa (make-vector 20 nil))
+
+(defun org-get-outline-path (&optional fastp level heading)
+ "Return the outline path to the current entry, as a list.
+
+The parameters FASTP, LEVEL, and HEADING are for use by a scanner
+routine which makes outline path derivations for an entire file,
+avoiding backtracing. Refile target collection makes use of that."
+ (if fastp
+ (progn
+ (if (> level 19)
+ (error "Outline path failure, more than 19 levels"))
+ (loop for i from level upto 19 do
+ (aset org-olpa i nil))
+ (prog1
+ (delq nil (append org-olpa nil))
+ (aset org-olpa level heading)))
+ (let (rtn case-fold-search)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (while (org-up-heading-safe)
+ (when (looking-at org-complex-heading-regexp)
+ (push (org-match-string-no-properties 4) rtn)))
+ rtn)))))
+
+(defun org-format-outline-path (path &optional width prefix)
+ "Format the outline path PATH for display.
+Width is the maximum number of characters that is available.
+Prefix is a prefix to be included in the returned string,
+such as the file name."
+ (setq width (or width 79))
+ (if prefix (setq width (- width (length prefix))))
+ (if (not path)
+ (or prefix "")
+ (let* ((nsteps (length path))
+ (total-width (+ nsteps (apply '+ (mapcar 'length path))))
+ (maxwidth (if (<= total-width width)
+ 10000 ;; everything fits
+ ;; we need to shorten the level headings
+ (/ (- width nsteps) nsteps)))
+ (org-odd-levels-only nil)
+ (n 0)
+ (total (1+ (length prefix))))
+ (setq maxwidth (max maxwidth 10))
+ (concat prefix
+ (mapconcat
+ (lambda (h)
+ (setq n (1+ n))
+ (if (and (= n nsteps) (< maxwidth 10000))
+ (setq maxwidth (- total-width total)))
+ (if (< (length h) maxwidth)
+ (progn (setq total (+ total (length h) 1)) h)
+ (setq h (substring h 0 (- maxwidth 2))
+ total (+ total maxwidth 1))
+ (if (string-match "[ \t]+\\'" h)
+ (setq h (substring h 0 (match-beginning 0))))
+ (setq h (concat h "..")))
+ (org-add-props h nil 'face
+ (nth (% (1- n) org-n-level-faces)
+ org-level-faces))
+ h)
+ path "/")))))
+
+(defun org-display-outline-path (&optional file current)
+ "Display the current outline path in the echo area."
+ (interactive "P")
+ (let* ((bfn (buffer-file-name (buffer-base-buffer)))
+ (case-fold-search nil)
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path))))
+ (if current (setq path (append path
+ (save-excursion
+ (org-back-to-heading t)
+ (if (looking-at org-complex-heading-regexp)
+ (list (match-string 4)))))))
+ (message "%s"
+ (org-format-outline-path
+ path
+ (1- (frame-width))
+ (and file bfn (concat (file-name-nondirectory bfn) "/"))))))
+
+(defvar org-refile-history nil
+ "History for refiling operations.")
+
+(defvar org-after-refile-insert-hook nil
+ "Hook run after `org-refile' has inserted its stuff at the new location.
+Note that this is still *before* the stuff will be removed from
+the *old* location.")
+
+(defvar org-capture-last-stored-marker)
+(defun org-refile (&optional goto default-buffer rfloc)
+ "Move the entry or entries at point to another heading.
+The list of target headings is compiled using the information in
+`org-refile-targets', which see.
+
+At the target location, the entry is filed as a subitem of the target
+heading. Depending on `org-reverse-note-order', the new subitem will
+either be the first or the last subitem.
+
+If there is an active region, all entries in that region will be moved.
+However, the region must fulfill the requirement that the first heading
+is the first one sets the top-level of the moved text - at most siblings
+below it are allowed.
+
+With prefix arg GOTO, the command will only visit the target location
+and not actually move anything.
+
+With a double prefix arg \\[universal-argument] \\[universal-argument], \
+go to the location where the last refiling operation has put the subtree.
+With a prefix argument of `2', refile to the running clock.
+
+RFLOC can be a refile location obtained in a different way.
+
+See also `org-refile-use-outline-path' and `org-completion-use-ido'.
+
+If you are using target caching (see `org-refile-use-cache'),
+you have to clear the target cache in order to find new targets.
+This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
+prefix argument (`C-u C-u C-u C-c C-w')."
+
+ (interactive "P")
+ (if (member goto '(0 (64)))
+ (org-refile-cache-clear)
+ (let* ((cbuf (current-buffer))
+ (regionp (org-region-active-p))
+ (region-start (and regionp (region-beginning)))
+ (region-end (and regionp (region-end)))
+ (region-length (and regionp (- region-end region-start)))
+ (filename (buffer-file-name (buffer-base-buffer cbuf)))
+ pos it nbuf file re level reversed)
+ (setq last-command nil)
+ (when regionp
+ (goto-char region-start)
+ (or (bolp) (goto-char (point-at-bol)))
+ (setq region-start (point))
+ (unless (or (org-kill-is-subtree-p
+ (buffer-substring region-start region-end))
+ (prog1 org-refile-active-region-within-subtree
+ (org-toggle-heading)))
+ (error "The region is not a (sequence of) subtree(s)")))
+ (if (equal goto '(16))
+ (org-refile-goto-last-stored)
+ (when (or
+ (and (equal goto 2)
+ org-clock-hd-marker (marker-buffer org-clock-hd-marker)
+ (prog1
+ (setq it (list (or org-clock-heading "running clock")
+ (buffer-file-name
+ (marker-buffer org-clock-hd-marker))
+ ""
+ (marker-position org-clock-hd-marker)))
+ (setq goto nil)))
+ (setq it (or rfloc
+ (let (heading-text)
+ (save-excursion
+ (unless goto
+ (org-back-to-heading t)
+ (setq heading-text
+ (nth 4 (org-heading-components))))
+ (org-refile-get-location
+ (cond (goto "Goto")
+ (regionp "Refile region to")
+ (t (concat "Refile subtree \""
+ heading-text "\" to")))
+ default-buffer
+ (and (not (equal '(4) goto))
+ org-refile-allow-creating-parent-nodes)
+ goto))))))
+ (setq file (nth 1 it)
+ re (nth 2 it)
+ pos (nth 3 it))
+ (if (and (not goto)
+ pos
+ (equal (buffer-file-name) file)
+ (if regionp
+ (and (>= pos region-start)
+ (<= pos region-end))
+ (and (>= pos (point))
+ (< pos (save-excursion
+ (org-end-of-subtree t t))))))
+ (error "Cannot refile to position inside the tree or region"))
+
+ (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (if goto
+ (progn
+ (org-pop-to-buffer-same-window nbuf)
+ (goto-char pos)
+ (org-show-context 'org-goto))
+ (if regionp
+ (progn
+ (org-kill-new (buffer-substring region-start region-end))
+ (org-save-markers-in-region region-start region-end))
+ (org-copy-subtree 1 nil t))
+ (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
+ (find-file-noselect file)))
+ (setq reversed (org-notes-order-reversed-p))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if pos
+ (progn
+ (goto-char pos)
+ (looking-at org-outline-regexp)
+ (setq level (org-get-valid-level (funcall outline-level) 1))
+ (goto-char
+ (if reversed
+ (or (outline-next-heading) (point-max))
+ (or (save-excursion (org-get-next-sibling))
+ (org-end-of-subtree t t)
+ (point-max)))))
+ (setq level 1)
+ (if (not reversed)
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (or (outline-next-heading) (goto-char (point-max)))))
+ (if (not (bolp)) (newline))
+ (org-paste-subtree level)
+ (when org-log-refile
+ (org-add-log-setup 'refile nil nil 'findpos
+ org-log-refile)
+ (unless (eq org-log-refile 'note)
+ (save-excursion (org-add-log-note))))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-set-tags nil t)))
+ (bookmark-set "org-refile-last-stored")
+ ;; If we are refiling for capture, make sure that the
+ ;; last-capture pointers point here
+ (when (org-bound-and-true-p org-refile-for-capture)
+ (bookmark-set "org-capture-last-stored-marker")
+ (move-marker org-capture-last-stored-marker (point)))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (run-hooks 'org-after-refile-insert-hook))))
+ (if regionp
+ (delete-region (point) (+ (point) region-length))
+ (org-cut-subtree))
+ (when (featurep 'org-inlinetask)
+ (org-inlinetask-remove-END-maybe))
+ (setq org-markers-to-move nil)
+ (message "Refiled to \"%s\" in file %s" (car it) file)))))))
+
+(defun org-refile-goto-last-stored ()
+ "Go to the location where the last refile was stored."
+ (interactive)
+ (bookmark-jump "org-refile-last-stored")
+ (message "This is the location of the last refile"))
+
+(defun org-refile-get-location (&optional prompt default-buffer new-nodes
+ no-exclude)
+ "Prompt the user for a refile location, using PROMPT.
+PROMPT should not be suffixed with a colon and a space, because
+this function appends the default value from
+`org-refile-history' automatically, if that is not empty.
+When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
+this is used for the GOTO interface."
+ (let ((org-refile-targets org-refile-targets)
+ (org-refile-use-outline-path org-refile-use-outline-path)
+ excluded-entries)
+ (when (and (derived-mode-p 'org-mode)
+ (not org-refile-use-cache)
+ (not no-exclude))
+ (org-map-tree
+ (lambda()
+ (setq excluded-entries
+ (append excluded-entries (list (org-get-heading t t)))))))
+ (setq org-refile-target-table
+ (org-refile-get-targets default-buffer excluded-entries)))
+ (unless org-refile-target-table
+ (error "No refile targets"))
+ (let* ((prompt (concat prompt
+ (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ ": "))
+ (cbuf (current-buffer))
+ (partial-completion-mode nil)
+ (cfn (buffer-file-name (buffer-base-buffer cbuf)))
+ (cfunc (if (and org-refile-use-outline-path
+ org-outline-path-complete-in-steps)
+ 'org-olpath-completing-read
+ 'org-icompleting-read))
+ (extra (if org-refile-use-outline-path "/" ""))
+ (filename (and cfn (expand-file-name cfn)))
+ (tbl (mapcar
+ (lambda (x)
+ (if (and (not (member org-refile-use-outline-path
+ '(file full-file-path)))
+ (not (equal filename (nth 1 x))))
+ (cons (concat (car x) extra " ("
+ (file-name-nondirectory (nth 1 x)) ")")
+ (cdr x))
+ (cons (concat (car x) extra) (cdr x))))
+ org-refile-target-table))
+ (completion-ignore-case t)
+ pa answ parent-target child parent old-hist)
+ (setq old-hist org-refile-history)
+ (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
+ nil 'org-refile-history (car org-refile-history)))
+ (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
+ (org-refile-check-position pa)
+ (if pa
+ (progn
+ (when (or (not org-refile-history)
+ (not (eq old-hist org-refile-history))
+ (not (equal (car pa) (car org-refile-history))))
+ (setq org-refile-history
+ (cons (car pa) (if (assoc (car org-refile-history) tbl)
+ org-refile-history
+ (cdr org-refile-history))))
+ (if (equal (car org-refile-history) (nth 1 org-refile-history))
+ (pop org-refile-history)))
+ pa)
+ (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
+ (progn
+ (setq parent (match-string 1 answ)
+ child (match-string 2 answ))
+ (setq parent-target (or (assoc parent tbl)
+ (assoc (concat parent "/") tbl)))
+ (when (and parent-target
+ (or (eq new-nodes t)
+ (and (eq new-nodes 'confirm)
+ (y-or-n-p (format "Create new node \"%s\"? "
+ child)))))
+ (org-refile-new-child parent-target child)))
+ (error "Invalid target location")))))
+
+(declare-function org-string-nw-p "org-macs.el" (s))
+(defun org-refile-check-position (refile-pointer)
+ "Check if the refile pointer matches the readline to which it points."
+ (let* ((file (nth 1 refile-pointer))
+ (re (nth 2 refile-pointer))
+ (pos (nth 3 refile-pointer))
+ buffer)
+ (when (org-string-nw-p re)
+ (setq buffer (if (markerp pos)
+ (marker-buffer pos)
+ (or (find-buffer-visiting file)
+ (find-file-noselect file))))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (beginning-of-line 1)
+ (unless (org-looking-at-p re)
+ (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
+
+(defun org-refile-new-child (parent-target child)
+ "Use refile target PARENT-TARGET to add new CHILD below it."
+ (unless parent-target
+ (error "Cannot find parent for new node"))
+ (let ((file (nth 1 parent-target))
+ (pos (nth 3 parent-target))
+ level)
+ (with-current-buffer (or (find-buffer-visiting file)
+ (find-file-noselect file))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if pos
+ (goto-char pos)
+ (goto-char (point-max))
+ (if (not (bolp)) (newline)))
+ (when (looking-at org-outline-regexp)
+ (setq level (funcall outline-level))
+ (org-end-of-subtree t t))
+ (org-back-over-empty-lines)
+ (insert "\n" (make-string
+ (if pos (org-get-valid-level level 1) 1) ?*)
+ " " child "\n")
+ (beginning-of-line 0)
+ (list (concat (car parent-target) "/" child) file "" (point)))))))
+
+(defun org-olpath-completing-read (prompt collection &rest args)
+ "Read an outline path like a file name."
+ (let ((thetable collection)
+ (org-completion-use-ido nil) ; does not work with ido.
+ (org-completion-use-iswitchb nil)) ; or iswitchb
+ (apply
+ 'org-icompleting-read prompt
+ (lambda (string predicate &optional flag)
+ (let (rtn r f (l (length string)))
+ (cond
+ ((eq flag nil)
+ ;; try completion
+ (try-completion string thetable))
+ ((eq flag t)
+ ;; all-completions
+ (setq rtn (all-completions string thetable predicate))
+ (mapcar
+ (lambda (x)
+ (setq r (substring x l))
+ (if (string-match " ([^)]*)$" x)
+ (setq f (match-string 0 x))
+ (setq f ""))
+ (if (string-match "/" r)
+ (concat string (substring r 0 (match-end 0)) f)
+ x))
+ rtn))
+ ((eq flag 'lambda)
+ ;; exact match?
+ (assoc string thetable)))))
+ args)))
+
+;;;; Dynamic blocks
+
+(defun org-find-dblock (name)
+ "Find the first dynamic block with name NAME in the buffer.
+If not found, stay at current position and return nil."
+ (let ((case-fold-search t) pos)
+ (save-excursion
+ (goto-char (point-min))
+ (setq pos (and (re-search-forward
+ (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
+ (match-beginning 0))))
+ (if pos (goto-char pos))
+ pos))
+
+(defconst org-dblock-start-re
+ "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
+ "Matches the start line of a dynamic block, with parameters.")
+
+(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
+ "Matches the end of a dynamic block.")
+
+(defun org-create-dblock (plist)
+ "Create a dynamic block section, with parameters taken from PLIST.
+PLIST must contain a :name entry which is used as name of the block."
+ (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
+ (end-of-line 1)
+ (newline))
+ (let ((col (current-column))
+ (name (plist-get plist :name)))
+ (insert "#+BEGIN: " name)
+ (while plist
+ (if (eq (car plist) :name)
+ (setq plist (cddr plist))
+ (insert " " (prin1-to-string (pop plist)))))
+ (insert "\n\n" (make-string col ?\ ) "#+END:\n")
+ (beginning-of-line -2)))
+
+(defun org-prepare-dblock ()
+ "Prepare dynamic block for refresh.
+This empties the block, puts the cursor at the insert position and returns
+the property list including an extra property :name with the block name."
+ (unless (looking-at org-dblock-start-re)
+ (error "Not at a dynamic block"))
+ (let* ((begdel (1+ (match-end 0)))
+ (name (org-no-properties (match-string 1)))
+ (params (append (list :name name)
+ (read (concat "(" (match-string 3) ")")))))
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (setq params (plist-put params :indentation-column (current-column))))
+ (unless (re-search-forward org-dblock-end-re nil t)
+ (error "Dynamic block not terminated"))
+ (setq params
+ (append params
+ (list :content (buffer-substring
+ begdel (match-beginning 0)))))
+ (delete-region begdel (match-beginning 0))
+ (goto-char begdel)
+ (open-line 1)
+ params))
+
+(defun org-map-dblocks (&optional command)
+ "Apply COMMAND to all dynamic blocks in the current buffer.
+If COMMAND is not given, use `org-update-dblock'."
+ (let ((cmd (or command 'org-update-dblock)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-dblock-start-re nil t)
+ (goto-char (match-beginning 0))
+ (save-excursion
+ (condition-case nil
+ (funcall cmd)
+ (error (message "Error during update of dynamic block"))))
+ (unless (re-search-forward org-dblock-end-re nil t)
+ (error "Dynamic block not terminated"))))))
+
+(defun org-dblock-update (&optional arg)
+ "User command for updating dynamic blocks.
+Update the dynamic block at point. With prefix ARG, update all dynamic
+blocks in the buffer."
+ (interactive "P")
+ (if arg
+ (org-update-all-dblocks)
+ (or (looking-at org-dblock-start-re)
+ (org-beginning-of-dblock))
+ (org-update-dblock)))
+
+(defun org-update-dblock ()
+ "Update the dynamic block at point.
+This means to empty the block, parse for parameters and then call
+the correct writing function."
+ (interactive)
+ (save-window-excursion
+ (let* ((pos (point))
+ (line (org-current-line))
+ (params (org-prepare-dblock))
+ (name (plist-get params :name))
+ (indent (plist-get params :indentation-column))
+ (cmd (intern (concat "org-dblock-write:" name))))
+ (message "Updating dynamic block `%s' at line %d..." name line)
+ (funcall cmd params)
+ (message "Updating dynamic block `%s' at line %d...done" name line)
+ (goto-char pos)
+ (when (and indent (> indent 0))
+ (setq indent (make-string indent ?\ ))
+ (save-excursion
+ (org-beginning-of-dblock)
+ (forward-line 1)
+ (while (not (looking-at org-dblock-end-re))
+ (insert indent)
+ (beginning-of-line 2))
+ (when (looking-at org-dblock-end-re)
+ (and (looking-at "[ \t]+")
+ (replace-match ""))
+ (insert indent)))))))
+
+(defun org-beginning-of-dblock ()
+ "Find the beginning of the dynamic block at point.
+Error if there is no such block at point."
+ (let ((pos (point))
+ beg)
+ (end-of-line 1)
+ (if (and (re-search-backward org-dblock-start-re nil t)
+ (setq beg (match-beginning 0))
+ (re-search-forward org-dblock-end-re nil t)
+ (> (match-end 0) pos))
+ (goto-char beg)
+ (goto-char pos)
+ (error "Not in a dynamic block"))))
+
+;;;###autoload
+(defun org-update-all-dblocks ()
+ "Update all dynamic blocks in the buffer.
+This function can be used in a hook."
+ (interactive)
+ (when (derived-mode-p 'org-mode)
+ (org-map-dblocks 'org-update-dblock)))
+
+
+;;;; Completion
+
+(defconst org-additional-option-like-keywords
+ '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:"
+ "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:"
+ "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:"
+ "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:"
+ "BEGIN:" "END:"
+ "ORGTBL" "TBLFM:" "TBLNAME:"
+ "BEGIN_EXAMPLE" "END_EXAMPLE"
+ "BEGIN_VERBATIM" "END_VERBATIM"
+ "BEGIN_QUOTE" "END_QUOTE"
+ "BEGIN_VERSE" "END_VERSE"
+ "BEGIN_CENTER" "END_CENTER"
+ "BEGIN_SRC" "END_SRC"
+ "BEGIN_RESULT" "END_RESULT"
+ "BEGIN_lstlisting" "END_lstlisting"
+ "NAME:" "RESULTS:"
+ "HEADER:" "HEADERS:"
+ "COLUMNS:" "PROPERTY:"
+ "CAPTION:" "LABEL:"
+ "SETUPFILE:"
+ "INCLUDE:"
+ "BIND:"
+ "MACRO:"))
+
+(defconst org-options-keywords
+ '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:"
+ "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:"
+ "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:"
+ "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:"
+ "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:"
+ "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:"
+ "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:"))
+
+(defconst org-additional-option-like-keywords-for-flyspell
+ (delete-dups
+ (split-string
+ (mapconcat (lambda(k)
+ (replace-regexp-in-string
+ "_\\|:" " "
+ (concat k " " (downcase k) " " (upcase k))))
+ (append org-options-keywords org-additional-option-like-keywords)
+ " ")
+ " +" t)))
+
+(defcustom org-structure-template-alist
+ '(
+ ("s" "#+BEGIN_SRC ?\n\n#+END_SRC"
+ "<src lang=\"?\">\n\n</src>")
+ ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE"
+ "<example>\n?\n</example>")
+ ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE"
+ "<quote>\n?\n</quote>")
+ ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE"
+ "<verse>\n?\n</verse>")
+ ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER"
+ "<center>\n?\n</center>")
+ ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX"
+ "<literal style=\"latex\">\n?\n</literal>")
+ ("L" "#+LaTeX: "
+ "<literal style=\"latex\">?</literal>")
+ ("h" "#+BEGIN_HTML\n?\n#+END_HTML"
+ "<literal style=\"html\">\n?\n</literal>")
+ ("H" "#+HTML: "
+ "<literal style=\"html\">?</literal>")
+ ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII")
+ ("A" "#+ASCII: ")
+ ("i" "#+INDEX: ?"
+ "#+INDEX: ?")
+ ("I" "#+INCLUDE: %file ?"
+ "<include file=%file markup=\"?\">")
+ )
+ "Structure completion elements.
+This is a list of abbreviation keys and values. The value gets inserted
+if you type `<' followed by the key and then press the completion key,
+usually `M-TAB'. %file will be replaced by a file name after prompting
+for the file using completion. The cursor will be placed at the position
+of the `?` in the template.
+There are two templates for each key, the first uses the original Org syntax,
+the second uses Emacs Muse-like syntax tags. These Muse-like tags become
+the default when the /org-mtags.el/ module has been loaded. See also the
+variable `org-mtags-prefer-muse-templates'."
+ :group 'org-completion
+ :type '(repeat
+ (string :tag "Key")
+ (string :tag "Template")
+ (string :tag "Muse Template")))
+
+(defun org-try-structure-completion ()
+ "Try to complete a structure template before point.
+This looks for strings like \"<e\" on an otherwise empty line and
+expands them."
+ (let ((l (buffer-substring (point-at-bol) (point)))
+ a)
+ (when (and (looking-at "[ \t]*$")
+ (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l)
+ (setq a (assoc (match-string 1 l) org-structure-template-alist)))
+ (org-complete-expand-structure-template (+ -1 (point-at-bol)
+ (match-beginning 1)) a)
+ t)))
+
+(defun org-complete-expand-structure-template (start cell)
+ "Expand a structure template."
+ (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
+ (rpl (nth (if musep 2 1) cell))
+ (ind ""))
+ (delete-region start (point))
+ (when (string-match "\\`#\\+" rpl)
+ (cond
+ ((bolp))
+ ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
+ (setq ind (buffer-substring (point-at-bol) (point))))
+ (t (newline))))
+ (setq start (point))
+ (if (string-match "%file" rpl)
+ (setq rpl (replace-match
+ (concat
+ "\""
+ (save-match-data
+ (abbreviate-file-name (read-file-name "Include file: ")))
+ "\"")
+ t t rpl)))
+ (setq rpl (mapconcat 'identity (split-string rpl "\n")
+ (concat "\n" ind)))
+ (insert rpl)
+ (if (re-search-backward "\\?" start t) (delete-char 1))))
+
+;;;; TODO, DEADLINE, Comments
+
+(defun org-toggle-comment ()
+ "Change the COMMENT state of an entry."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading)
+ (let (case-fold-search)
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-comment-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-comment-string " "))))))
+
+(defvar org-last-todo-state-is-todo nil
+ "This is non-nil when the last TODO state change led to a TODO state.
+If the last change removed the TODO tag or switched to DONE, then
+this is nil.")
+
+(defvar org-setting-tags nil) ; dynamically skipped
+
+(defvar org-todo-setup-filter-hook nil
+ "Hook for functions that pre-filter todo specs.
+Each function takes a todo spec and returns either nil or the spec
+transformed into canonical form." )
+
+(defvar org-todo-get-default-hook nil
+ "Hook for functions that get a default item for todo.
+Each function takes arguments (NEW-MARK OLD-MARK) and returns either
+nil or a string to be used for the todo mark." )
+
+(defvar org-agenda-headline-snapshot-before-repeat)
+
+(defun org-current-effective-time ()
+ "Return current time adjusted for `org-extend-today-until' variable."
+ (let* ((ct (org-current-time))
+ (dct (decode-time ct))
+ (ct1
+ (if (and org-use-effective-time
+ (< (nth 2 dct) org-extend-today-until))
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+ ct)))
+ ct1))
+
+(defun org-todo-yesterday (&optional arg)
+ "Like `org-todo' but the time of change will be 23:59 of yesterday."
+ (interactive "P")
+ (if (eq major-mode 'org-agenda-mode)
+ (apply 'org-agenda-todo-yesterday arg)
+ (let* ((hour (third (decode-time
+ (org-current-time))))
+ (org-extend-today-until (1+ hour)))
+ (org-todo arg))))
+
+(defun org-todo (&optional arg)
+ "Change the TODO state of an item.
+The state of an item is given by a keyword at the start of the heading,
+like
+ *** TODO Write paper
+ *** DONE Call mom
+
+The different keywords are specified in the variable `org-todo-keywords'.
+By default the available states are \"TODO\" and \"DONE\".
+So for this example: when the item starts with TODO, it is changed to DONE.
+When it starts with DONE, the DONE is removed. And when neither TODO nor
+DONE are present, add TODO at the beginning of the heading.
+
+With \\[universal-argument] prefix arg, use completion to determine the new \
+state.
+With numeric prefix arg, switch to that state.
+With a double \\[universal-argument] prefix, switch to the next set of TODO \
+keywords (nextset).
+With a triple \\[universal-argument] prefix, circumvent any state blocking.
+With a numeric prefix arg of 0, inhibit note taking for the change.
+
+For calling through lisp, arg is also interpreted in the following way:
+'none -> empty state
+\"\"(empty string) -> switch to empty state
+'done -> switch to DONE
+'nextset -> switch to the next set of keywords
+'previousset -> switch to the previous set of keywords
+\"WAITING\" -> switch to the specified keyword, but only if it
+ really is a member of `org-todo-keywords'."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-todo ,arg)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (if (equal arg '(16)) (setq arg 'nextset))
+ (let ((org-blocker-hook org-blocker-hook)
+ (case-fold-search nil))
+ (when (equal arg '(64))
+ (setq arg nil org-blocker-hook nil))
+ (when (and org-blocker-hook
+ (or org-inhibit-blocking
+ (org-entry-get nil "NOBLOCKING")))
+ (setq org-blocker-hook nil))
+ (save-excursion
+ (catch 'exit
+ (org-back-to-heading t)
+ (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
+ (looking-at "\\(?: *\\|[ \t]*$\\)"))
+ (let* ((match-data (match-data))
+ (startpos (point-at-bol))
+ (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
+ (org-log-done org-log-done)
+ (org-log-repeat org-log-repeat)
+ (org-todo-log-states org-todo-log-states)
+ (org-inhibit-logging
+ (if (equal arg 0)
+ (progn (setq arg nil) 'note) org-inhibit-logging))
+ (this (match-string 1))
+ (hl-pos (match-beginning 0))
+ (head (org-get-todo-sequence-head this))
+ (ass (assoc head org-todo-kwd-alist))
+ (interpret (nth 1 ass))
+ (done-word (nth 3 ass))
+ (final-done-word (nth 4 ass))
+ (org-last-state (or this ""))
+ (completion-ignore-case t)
+ (member (member this org-todo-keywords-1))
+ (tail (cdr member))
+ (org-state (cond
+ ((and org-todo-key-trigger
+ (or (and (equal arg '(4))
+ (eq org-use-fast-todo-selection 'prefix))
+ (and (not arg) org-use-fast-todo-selection
+ (not (eq org-use-fast-todo-selection
+ 'prefix)))))
+ ;; Use fast selection
+ (org-fast-todo-selection))
+ ((and (equal arg '(4))
+ (or (not org-use-fast-todo-selection)
+ (not org-todo-key-trigger)))
+ ;; Read a state with completion
+ (org-icompleting-read
+ "State: " (mapcar (lambda(x) (list x))
+ org-todo-keywords-1)
+ nil t))
+ ((eq arg 'right)
+ (if this
+ (if tail (car tail) nil)
+ (car org-todo-keywords-1)))
+ ((eq arg 'left)
+ (if (equal member org-todo-keywords-1)
+ nil
+ (if this
+ (nth (- (length org-todo-keywords-1)
+ (length tail) 2)
+ org-todo-keywords-1)
+ (org-last org-todo-keywords-1))))
+ ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
+ (setq arg nil))) ; hack to fall back to cycling
+ (arg
+ ;; user or caller requests a specific state
+ (cond
+ ((equal arg "") nil)
+ ((eq arg 'none) nil)
+ ((eq arg 'done) (or done-word (car org-done-keywords)))
+ ((eq arg 'nextset)
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads)))
+ ((eq arg 'previousset)
+ (let ((org-todo-heads (reverse org-todo-heads)))
+ (or (car (cdr (member head org-todo-heads)))
+ (car org-todo-heads))))
+ ((car (member arg org-todo-keywords-1)))
+ ((stringp arg)
+ (error "State `%s' not valid in this file" arg))
+ ((nth (1- (prefix-numeric-value arg))
+ org-todo-keywords-1))))
+ ((null member) (or head (car org-todo-keywords-1)))
+ ((equal this final-done-word) nil) ;; -> make empty
+ ((null tail) nil) ;; -> first entry
+ ((memq interpret '(type priority))
+ (if (eq this-command last-command)
+ (car tail)
+ (if (> (length tail) 0)
+ (or done-word (car org-done-keywords))
+ nil)))
+ (t
+ (car tail))))
+ (org-state (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook org-state org-last-state)
+ org-state))
+ (next (if org-state (concat " " org-state " ") " "))
+ (change-plist (list :type 'todo-state-change :from this :to org-state
+ :position startpos))
+ dolog now-done-p)
+ (when org-blocker-hook
+ (setq org-last-todo-state-is-todo
+ (not (member this org-done-keywords)))
+ (unless (save-excursion
+ (save-match-data
+ (org-with-wide-buffer
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist))))
+ (if (org-called-interactively-p 'interactive)
+ (error "TODO state change from %s to %s blocked" this org-state)
+ ;; fail silently
+ (message "TODO state change from %s to %s blocked" this org-state)
+ (throw 'exit nil))))
+ (store-match-data match-data)
+ (replace-match next t t)
+ (unless (pos-visible-in-window-p hl-pos)
+ (message "TODO state changed to %s" (org-trim next)))
+ (unless head
+ (setq head (org-get-todo-sequence-head org-state)
+ ass (assoc head org-todo-kwd-alist)
+ interpret (nth 1 ass)
+ done-word (nth 3 ass)
+ final-done-word (nth 4 ass)))
+ (when (memq arg '(nextset previousset))
+ (message "Keyword-Set %d/%d: %s"
+ (- (length org-todo-sets) -1
+ (length (memq (assoc org-state org-todo-sets) org-todo-sets)))
+ (length org-todo-sets)
+ (mapconcat 'identity (assoc org-state org-todo-sets) " ")))
+ (setq org-last-todo-state-is-todo
+ (not (member org-state org-done-keywords)))
+ (setq now-done-p (and (member org-state org-done-keywords)
+ (not (member this org-done-keywords))))
+ (and logging (org-local-logging logging))
+ (when (and (or org-todo-log-states org-log-done)
+ (not (eq org-inhibit-logging t))
+ (not (memq arg '(nextset previousset))))
+ ;; we need to look at recording a time and note
+ (setq dolog (or (nth 1 (assoc org-state org-todo-log-states))
+ (nth 2 (assoc this org-todo-log-states))))
+ (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
+ (when (and org-state
+ (member org-state org-not-done-keywords)
+ (not (member this org-not-done-keywords)))
+ ;; This is now a todo state and was not one before
+ ;; If there was a CLOSED time stamp, get rid of it.
+ (org-add-planning-info nil nil 'closed))
+ (when (and now-done-p org-log-done)
+ ;; It is now done, and it was not done before
+ (org-add-planning-info 'closed (org-current-effective-time))
+ (if (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done org-state this 'findpos 'note)))
+ (when (and org-state dolog)
+ ;; This is a non-nil state, and we need to log it
+ (org-add-log-setup 'state org-state this 'findpos dolog)))
+ ;; Fixup tag positioning
+ (org-todo-trigger-tag-changes org-state)
+ (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
+ (when org-provide-todo-statistics
+ (org-update-parent-todo-statistics))
+ (run-hooks 'org-after-todo-state-change-hook)
+ (if (and arg (not (member org-state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head org-state)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
+ ;; Do we need to trigger a repeat?
+ (when now-done-p
+ (when (boundp 'org-agenda-headline-snapshot-before-repeat)
+ ;; This is for the agenda, take a snapshot of the headline.
+ (save-match-data
+ (setq org-agenda-headline-snapshot-before-repeat
+ (org-get-heading))))
+ (org-auto-repeat-maybe org-state))
+ ;; Fixup cursor location if close to the keyword
+ (if (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (progn
+ (goto-char (or (match-end 2) (match-end 1)))
+ (and (looking-at " ") (just-one-space))))
+ (when org-trigger-hook
+ (save-excursion
+ (run-hook-with-args 'org-trigger-hook change-plist)))))))))
+
+(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
+ "Block turning an entry into a TODO, using the hierarchy.
+This checks whether the current task should be blocked from state
+changes. Such blocking occurs when:
+
+ 1. The task has children which are not all in a completed state.
+
+ 2. A task has a parent with the property :ORDERED:, and there
+ are siblings prior to the current task with incomplete
+ status.
+
+ 3. The parent of the task is blocked because it has siblings that should
+ be done first, or is child of a block grandparent TODO entry."
+
+ (if (not org-enforce-todo-dependencies)
+ t ; if locally turned off don't block
+ (catch 'dont-block
+ ;; If this is not a todo state change, or if this entry is already DONE,
+ ;; do not block
+ (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
+ (member (plist-get change-plist :from)
+ (cons 'done org-done-keywords))
+ (member (plist-get change-plist :to)
+ (cons 'todo org-not-done-keywords))
+ (not (plist-get change-plist :to)))
+ (throw 'dont-block t))
+ ;; If this task has children, and any are undone, it's blocked
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((this-level (funcall outline-level)))
+ (outline-next-heading)
+ (let ((child-level (funcall outline-level)))
+ (while (and (not (eobp))
+ (> child-level this-level))
+ ;; this todo has children, check whether they are all
+ ;; completed
+ (if (and (not (org-entry-is-done-p))
+ (org-entry-is-todo-p))
+ (throw 'dont-block nil))
+ (outline-next-heading)
+ (setq child-level (funcall outline-level))))))
+ ;; Otherwise, if the task's parent has the :ORDERED: property, and
+ ;; any previous siblings are undone, it's blocked
+ (save-excursion
+ (org-back-to-heading t)
+ (let* ((pos (point))
+ (parent-pos (and (org-up-heading-safe) (point))))
+ (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
+ (forward-line 1)
+ (re-search-forward org-not-done-heading-regexp pos t))
+ (throw 'dont-block nil)) ; block, there is an older sibling not done.
+ ;; Search further up the hierarchy, to see if an ancestor is blocked
+ (while t
+ (goto-char parent-pos)
+ (if (not (looking-at org-not-done-heading-regexp))
+ (throw 'dont-block t)) ; do not block, parent is not a TODO
+ (setq pos (point))
+ (setq parent-pos (and (org-up-heading-safe) (point)))
+ (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
+ (forward-line 1)
+ (re-search-forward org-not-done-heading-regexp pos t))
+ (throw 'dont-block nil)))))))) ; block, older sibling not done.
+
+(defcustom org-track-ordered-property-with-tag nil
+ "Should the ORDERED property also be shown as a tag?
+The ORDERED property decides if an entry should require subtasks to be
+completed in sequence. Since a property is not very visible, setting
+this option means that toggling the ORDERED property with the command
+`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
+not relevant for the behavior, but it makes things more visible.
+
+Note that toggling the tag with tags commands will not change the property
+and therefore not influence behavior!
+
+This can be t, meaning the tag ORDERED should be used, It can also be a
+string to select a different tag for this task."
+ :group 'org-todo
+ :type '(choice
+ (const :tag "No tracking" nil)
+ (const :tag "Track with ORDERED tag" t)
+ (string :tag "Use other tag")))
+
+(defun org-toggle-ordered-property ()
+ "Toggle the ORDERED property of the current entry.
+For better visibility, you can track the value of this property with a tag.
+See variable `org-track-ordered-property-with-tag'."
+ (interactive)
+ (let* ((t1 org-track-ordered-property-with-tag)
+ (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
+ (save-excursion
+ (org-back-to-heading)
+ (if (org-entry-get nil "ORDERED")
+ (progn
+ (org-delete-property "ORDERED")
+ (and tag (org-toggle-tag tag 'off))
+ (message "Subtasks can be completed in arbitrary order"))
+ (org-entry-put nil "ORDERED" "t")
+ (and tag (org-toggle-tag tag 'on))
+ (message "Subtasks must be completed in sequence")))))
+
+(defvar org-blocked-by-checkboxes) ; dynamically scoped
+(defun org-block-todo-from-checkboxes (change-plist)
+ "Block turning an entry into a TODO, using checkboxes.
+This checks whether the current task should be blocked from state
+changes because there are unchecked boxes in this entry."
+ (if (not org-enforce-todo-checkbox-dependencies)
+ t ; if locally turned off don't block
+ (catch 'dont-block
+ ;; If this is not a todo state change, or if this entry is already DONE,
+ ;; do not block
+ (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
+ (member (plist-get change-plist :from)
+ (cons 'done org-done-keywords))
+ (member (plist-get change-plist :to)
+ (cons 'todo org-not-done-keywords))
+ (not (plist-get change-plist :to)))
+ (throw 'dont-block t))
+ ;; If this task has checkboxes that are not checked, it's blocked
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((beg (point)) end)
+ (outline-next-heading)
+ (setq end (point))
+ (goto-char beg)
+ (if (org-list-search-forward
+ (concat (org-item-beginning-re)
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\[[- ]\\]")
+ end t)
+ (progn
+ (if (boundp 'org-blocked-by-checkboxes)
+ (setq org-blocked-by-checkboxes t))
+ (throw 'dont-block nil)))))
+ t))) ; do not block
+
+(defun org-entry-blocked-p ()
+ "Is the current entry blocked?"
+ (if (org-entry-get nil "NOBLOCKING")
+ nil ;; Never block this entry
+ (not
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook
+ (list :type 'todo-state-change
+ :position (point)
+ :from 'todo
+ :to 'done)))))
+
+(defun org-update-statistics-cookies (all)
+ "Update the statistics cookie, either from TODO or from checkboxes.
+This should be called with the cursor in a line with a statistics cookie."
+ (interactive "P")
+ (if all
+ (progn
+ (org-update-checkbox-count 'all)
+ (org-map-entries 'org-update-parent-todo-statistics))
+ (if (not (org-at-heading-p))
+ (org-update-checkbox-count)
+ (let ((pos (move-marker (make-marker) (point)))
+ end l1 l2)
+ (ignore-errors (org-back-to-heading t))
+ (if (not (org-at-heading-p))
+ (org-update-checkbox-count)
+ (setq l1 (org-outline-level))
+ (setq end (save-excursion
+ (outline-next-heading)
+ (if (org-at-heading-p) (setq l2 (org-outline-level)))
+ (point)))
+ (if (and (save-excursion
+ (re-search-forward
+ "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
+ (not (save-excursion (re-search-forward
+ ":COOKIE_DATA:.*\\<todo\\>" end t))))
+ (org-update-checkbox-count)
+ (if (and l2 (> l2 l1))
+ (progn
+ (goto-char end)
+ (org-update-parent-todo-statistics))
+ (goto-char pos)
+ (beginning-of-line 1)
+ (while (re-search-forward
+ "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
+ (point-at-eol) t)
+ (replace-match (if (match-end 2) "[100%]" "[0/0]") t t)))))
+ (goto-char pos)
+ (move-marker pos nil)))))
+
+(defvar org-entry-property-inherited-from) ;; defined below
+(defun org-update-parent-todo-statistics ()
+ "Update any statistics cookie in the parent of the current headline.
+When `org-hierarchical-todo-statistics' is nil, statistics will cover
+the entire subtree and this will travel up the hierarchy and update
+statistics everywhere."
+ (let* ((prop (save-excursion (org-up-heading-safe)
+ (org-entry-get nil "COOKIE_DATA" 'inherit)))
+ (recursive (or (not org-hierarchical-todo-statistics)
+ (and prop (string-match "\\<recursive\\>" prop))))
+ (lim (or (and prop (marker-position org-entry-property-inherited-from))
+ 0))
+ (first t)
+ (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ level ltoggle l1 new ndel
+ (cnt-all 0) (cnt-done 0) is-percent kwd
+ checkbox-beg ov ovs ove cookie-present)
+ (catch 'exit
+ (save-excursion
+ (beginning-of-line 1)
+ (setq ltoggle (funcall outline-level))
+ ;; Three situations are to consider:
+
+ ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
+ ;; to the top-level ancestor on the headline;
+
+ ;; 2. If parent has "recursive" property, repeat up to the
+ ;; headline setting that property, taking inheritance into
+ ;; account;
+
+ ;; 3. Else, move up to direct parent and proceed only once.
+ (while (and (setq level (org-up-heading-safe))
+ (or recursive first)
+ (>= (point) lim))
+ (setq first nil cookie-present nil)
+ (unless (and level
+ (not (string-match
+ "\\<checkbox\\>"
+ (downcase (or (org-entry-get nil "COOKIE_DATA")
+ "")))))
+ (throw 'exit nil))
+ (while (re-search-forward box-re (point-at-eol) t)
+ (setq cnt-all 0 cnt-done 0 cookie-present t)
+ (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
+ (save-match-data
+ (unless (outline-next-heading) (throw 'exit nil))
+ (while (and (looking-at org-complex-heading-regexp)
+ (> (setq l1 (length (match-string 1))) level))
+ (setq kwd (and (or recursive (= l1 ltoggle))
+ (match-string 2)))
+ (if (or (eq org-provide-todo-statistics 'all-headlines)
+ (and (listp org-provide-todo-statistics)
+ (or (member kwd org-provide-todo-statistics)
+ (member kwd org-done-keywords))))
+ (setq cnt-all (1+ cnt-all))
+ (if (eq org-provide-todo-statistics t)
+ (and kwd (setq cnt-all (1+ cnt-all)))))
+ (and (member kwd org-done-keywords)
+ (setq cnt-done (1+ cnt-done)))
+ (outline-next-heading)))
+ (setq new
+ (if is-percent
+ (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
+ (format "[%d/%d]" cnt-done cnt-all))
+ ndel (- (match-end 0) checkbox-beg))
+ ;; handle overlays when updating cookie from column view
+ (when (setq ov (car (overlays-at checkbox-beg)))
+ (setq ovs (overlay-start ov) ove (overlay-end ov))
+ (delete-overlay ov))
+ (goto-char checkbox-beg)
+ (insert new)
+ (delete-region (point) (+ (point) ndel))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly))
+ (when ov (move-overlay ov ovs ove)))
+ (when cookie-present
+ (run-hook-with-args 'org-after-todo-statistics-hook
+ cnt-done (- cnt-all cnt-done))))))
+ (run-hooks 'org-todo-statistics-hook)))
+
+(defvar org-after-todo-statistics-hook nil
+ "Hook that is called after a TODO statistics cookie has been updated.
+Each function is called with two arguments: the number of not-done entries
+and the number of done entries.
+
+For example, the following function, when added to this hook, will switch
+an entry to DONE when all children are done, and back to TODO when new
+entries are set to a TODO status. Note that this hook is only called
+when there is a statistics cookie in the headline!
+
+ (defun org-summary-todo (n-done n-not-done)
+ \"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
+ (let (org-log-done org-log-states) ; turn off logging
+ (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
+")
+
+(defvar org-todo-statistics-hook nil
+ "Hook that is run whenever Org thinks TODO statistics should be updated.
+This hook runs even if there is no statistics cookie present, in which case
+`org-after-todo-statistics-hook' would not run.")
+
+(defun org-todo-trigger-tag-changes (state)
+ "Apply the changes defined in `org-todo-state-tags-triggers'."
+ (let ((l org-todo-state-tags-triggers)
+ changes)
+ (when (or (not state) (equal state ""))
+ (setq changes (append changes (cdr (assoc "" l)))))
+ (when (and (stringp state) (> (length state) 0))
+ (setq changes (append changes (cdr (assoc state l)))))
+ (when (member state org-not-done-keywords)
+ (setq changes (append changes (cdr (assoc 'todo l)))))
+ (when (member state org-done-keywords)
+ (setq changes (append changes (cdr (assoc 'done l)))))
+ (dolist (c changes)
+ (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
+
+(defun org-local-logging (value)
+ "Get logging settings from a property VALUE."
+ (let* (words w a)
+ ;; directly set the variables, they are already local.
+ (setq org-log-done nil
+ org-log-repeat nil
+ org-todo-log-states nil)
+ (setq words (org-split-string value))
+ (while (setq w (pop words))
+ (cond
+ ((setq a (assoc w org-startup-options))
+ (and (member (nth 1 a) '(org-log-done org-log-repeat))
+ (set (nth 1 a) (nth 2 a))))
+ ((setq a (org-extract-log-state-settings w))
+ (and (member (car a) org-todo-keywords-1)
+ (push a org-todo-log-states)))))))
+
+(defun org-get-todo-sequence-head (kwd)
+ "Return the head of the TODO sequence to which KWD belongs.
+If KWD is not set, check if there is a text property remembering the
+right sequence."
+ (let (p)
+ (cond
+ ((not kwd)
+ (or (get-text-property (point-at-bol) 'org-todo-head)
+ (progn
+ (setq p (next-single-property-change (point-at-bol) 'org-todo-head
+ nil (point-at-eol)))
+ (get-text-property p 'org-todo-head))))
+ ((not (member kwd org-todo-keywords-1))
+ (car org-todo-keywords-1))
+ (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
+
+(defun org-fast-todo-selection ()
+ "Fast TODO keyword selection with single keys.
+Returns the new TODO keyword, or nil if no state change should occur."
+ (let* ((fulltable org-todo-key-alist)
+ (done-keywords org-done-keywords) ;; needed for the faces.
+ (maxlen (apply 'max (mapcar
+ (lambda (x)
+ (if (stringp (car x)) (string-width (car x)) 0))
+ fulltable)))
+ (expert nil)
+ (fwidth (+ maxlen 3 1 3))
+ (ncol (/ (- (window-width) 4) fwidth))
+ tg cnt e c tbl
+ groups ingroup)
+ (save-excursion
+ (save-window-excursion
+ (if expert
+ (set-buffer (get-buffer-create " *Org todo*"))
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
+ (erase-buffer)
+ (org-set-local 'org-done-keywords done-keywords)
+ (setq tbl fulltable cnt 0)
+ (while (setq e (pop tbl))
+ (cond
+ ((equal e '(:startgroup))
+ (push '() groups) (setq ingroup t)
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "{ "))
+ ((equal e '(:endgroup))
+ (setq ingroup nil cnt 0)
+ (insert "}\n"))
+ ((equal e '(:newline))
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n")
+ (setq e (car tbl))
+ (while (equal (car tbl) '(:newline))
+ (insert "\n")
+ (setq tbl (cdr tbl)))))
+ (t
+ (setq tg (car e) c (cdr e))
+ (if ingroup (push tg (car groups)))
+ (setq tg (org-add-props tg nil 'face
+ (org-get-todo-face tg)))
+ (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (insert "[" c "] " tg (make-string
+ (- fwidth 4 (length tg)) ?\ ))
+ (when (= (setq cnt (1+ cnt)) ncol)
+ (insert "\n")
+ (if ingroup (insert " "))
+ (setq cnt 0)))))
+ (insert "\n")
+ (goto-char (point-min))
+ (if (not expert) (org-fit-window-to-buffer))
+ (message "[a-z..]:Set [SPC]:clear")
+ (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
+ (cond
+ ((or (= c ?\C-g)
+ (and (= c ?q) (not (rassoc c fulltable))))
+ (setq quit-flag t))
+ ((= c ?\ ) nil)
+ ((setq e (rassoc c fulltable) tg (car e))
+ tg)
+ (t (setq quit-flag t)))))))
+
+(defun org-entry-is-todo-p ()
+ (member (org-get-todo-state) org-not-done-keywords))
+
+(defun org-entry-is-done-p ()
+ (member (org-get-todo-state) org-done-keywords))
+
+(defun org-get-todo-state ()
+ (save-excursion
+ (org-back-to-heading t)
+ (and (looking-at org-todo-line-regexp)
+ (match-end 2)
+ (match-string 2))))
+
+(defun org-at-date-range-p (&optional inactive-ok)
+ "Is the cursor inside a date range?"
+ (interactive)
+ (save-excursion
+ (catch 'exit
+ (let ((pos (point)))
+ (skip-chars-backward "^[<\r\n")
+ (skip-chars-backward "<[")
+ (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
+ (>= (match-end 0) pos)
+ (throw 'exit t))
+ (skip-chars-backward "^<[\r\n")
+ (skip-chars-backward "<[")
+ (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
+ (>= (match-end 0) pos)
+ (throw 'exit t)))
+ nil)))
+
+(defun org-get-repeat (&optional tagline)
+ "Check if there is a deadline/schedule with repeater in this entry."
+ (save-match-data
+ (save-excursion
+ (org-back-to-heading t)
+ (and (re-search-forward (if tagline
+ (concat tagline "\\s-*" org-repeat-re)
+ org-repeat-re)
+ (org-entry-end-position) t)
+ (match-string-no-properties 1)))))
+
+(defvar org-last-changed-timestamp)
+(defvar org-last-inserted-timestamp)
+(defvar org-log-post-message)
+(defvar org-log-note-purpose)
+(defvar org-log-note-how)
+(defvar org-log-note-extra)
+(defun org-auto-repeat-maybe (done-word)
+ "Check if the current headline contains a repeated deadline/schedule.
+If yes, set TODO state back to what it was and change the base date
+of repeating deadline/scheduled time stamps to new date.
+This function is run automatically after each state change to a DONE state."
+ ;; last-state is dynamically scoped into this function
+ (let* ((repeat (org-get-repeat))
+ (aa (assoc org-last-state org-todo-kwd-alist))
+ (interpret (nth 1 aa))
+ (head (nth 2 aa))
+ (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
+ (msg "Entry repeats: ")
+ (org-log-done nil)
+ (org-todo-log-states nil)
+ re type n what ts time to-state)
+ (when repeat
+ (if (eq org-log-repeat t) (setq org-log-repeat 'state))
+ (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
+ org-todo-repeat-to-state))
+ (unless (and to-state (member to-state org-todo-keywords-1))
+ (setq to-state (if (eq interpret 'type) org-last-state head)))
+ (org-todo to-state)
+ (when (or org-log-repeat (org-entry-get nil "CLOCK"))
+ (org-entry-put nil "LAST_REPEAT" (format-time-string
+ (org-time-stamp-format t t))))
+ (when org-log-repeat
+ (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ ;; OK, we are already setup for some record
+ (if (eq org-log-repeat 'note)
+ ;; make sure we take a note, not only a time stamp
+ (setq org-log-note-how 'note))
+ ;; Set up for taking a record
+ (org-add-log-setup 'state (or done-word (car org-done-keywords))
+ org-last-state
+ 'findpos org-log-repeat)))
+ (org-back-to-heading t)
+ (org-add-planning-info nil nil 'closed)
+ (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
+ org-deadline-time-regexp "\\)\\|\\("
+ org-ts-regexp "\\)"))
+ (while (re-search-forward
+ re (save-excursion (outline-next-heading) (point)) t)
+ (setq type (if (match-end 1) org-scheduled-string
+ (if (match-end 3) org-deadline-string "Plain:"))
+ ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
+ (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)
+ (setq n (string-to-number (match-string 2 ts))
+ what (match-string 3 ts))
+ (if (equal what "w") (setq n (* n 7) what "d"))
+ (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
+ (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
+ ;; Preparation, see if we need to modify the start date for the change
+ (when (match-end 1)
+ (setq time (save-match-data (org-time-string-to-time ts)))
+ (cond
+ ((equal (match-string 1 ts) ".")
+ ;; Shift starting date to today
+ (org-timestamp-change
+ (- (org-today) (time-to-days time))
+ 'day))
+ ((equal (match-string 1 ts) "+")
+ (let ((nshiftmax 10) (nshift 0))
+ (while (or (= nshift 0)
+ (<= (time-to-days time)
+ (time-to-days (current-time))))
+ (when (= (incf nshift) nshiftmax)
+ (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift))
+ (error "Abort")))
+ (org-timestamp-change n (cdr (assoc what whata)))
+ (org-at-timestamp-p t)
+ (setq ts (match-string 1))
+ (setq time (save-match-data (org-time-string-to-time ts)))))
+ (org-timestamp-change (- n) (cdr (assoc what whata)))
+ ;; rematch, so that we have everything in place for the real shift
+ (org-at-timestamp-p t)
+ (setq ts (match-string 1))
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
+ (org-timestamp-change n (cdr (assoc what whata)))
+ (setq msg (concat msg type " " org-last-changed-timestamp " "))))
+ (setq org-log-post-message msg)
+ (message "%s" msg))))
+
+(defun org-show-todo-tree (arg)
+ "Make a compact tree which shows all headlines marked with TODO.
+The tree will show the lines where the regexp matches, and all higher
+headlines above the match.
+With a \\[universal-argument] prefix, prompt for a regexp to match.
+With a numeric prefix N, construct a sparse tree for the Nth element
+of `org-todo-keywords-1'."
+ (interactive "P")
+ (let ((case-fold-search nil)
+ (kwd-re
+ (cond ((null arg) org-not-done-regexp)
+ ((equal arg '(4))
+ (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
+ (mapcar 'list org-todo-keywords-1))))
+ (concat "\\("
+ (mapconcat 'identity (org-split-string kwd "|") "\\|")
+ "\\)\\>")))
+ ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
+ (regexp-quote (nth (1- (prefix-numeric-value arg))
+ org-todo-keywords-1)))
+ (t (error "Invalid prefix argument: %s" arg)))))
+ (message "%d TODO entries found"
+ (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
+
+(defun org-deadline (&optional remove time)
+ "Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
+With argument REMOVE, remove any deadline from the item.
+With argument TIME, set the deadline at the corresponding date. TIME
+can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-deadline ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "DEADLINE"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-redeadline)
+ (org-add-log-setup 'deldeadline nil old-date 'findpos
+ org-log-redeadline))
+ (org-remove-timestamp-with-keyword org-deadline-string)
+ (message "Item no longer has a deadline."))
+ (org-add-planning-info 'deadline time 'closed)
+ (when (and old-date org-log-redeadline
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'redeadline nil old-date 'findpos
+ org-log-redeadline))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-deadline-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message "Deadline on %s" org-last-inserted-timestamp)))))
+
+(defun org-schedule (&optional remove time)
+ "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
+With argument REMOVE, remove any scheduling date from the item.
+With argument TIME, scheduled at the corresponding date. TIME can
+either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ `(org-schedule ',remove ,time)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((old-date (org-entry-get nil "SCHEDULED"))
+ (repeater (and old-date
+ (string-match
+ "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
+ old-date)
+ (match-string 1 old-date))))
+ (if remove
+ (progn
+ (when (and old-date org-log-reschedule)
+ (org-add-log-setup 'delschedule nil old-date 'findpos
+ org-log-reschedule))
+ (org-remove-timestamp-with-keyword org-scheduled-string)
+ (message "Item is no longer scheduled."))
+ (org-add-planning-info 'scheduled time 'closed)
+ (when (and old-date org-log-reschedule
+ (not (equal old-date
+ (substring org-last-inserted-timestamp 1 -1))))
+ (org-add-log-setup 'reschedule nil old-date 'findpos
+ org-log-reschedule))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward (concat org-scheduled-string " "
+ org-last-inserted-timestamp)
+ (save-excursion
+ (outline-next-heading) (point)) t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message "Scheduled to %s" org-last-inserted-timestamp)))))
+
+(defun org-get-scheduled-time (pom &optional inherit)
+ "Get the scheduled time as a time tuple, of a format suitable
+for calling org-schedule with, or if there is no scheduling,
+returns nil."
+ (let ((time (org-entry-get pom "SCHEDULED" inherit)))
+ (when time
+ (apply 'encode-time (org-parse-time-string time)))))
+
+(defun org-get-deadline-time (pom &optional inherit)
+ "Get the deadline as a time tuple, of a format suitable for
+calling org-deadline with, or if there is no scheduling, returns
+nil."
+ (let ((time (org-entry-get pom "DEADLINE" inherit)))
+ (when time
+ (apply 'encode-time (org-parse-time-string time)))))
+
+(defun org-remove-timestamp-with-keyword (keyword)
+ "Remove all time stamps with KEYWORD in the current entry."
+ (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
+ beg)
+ (save-excursion
+ (org-back-to-heading t)
+ (setq beg (point))
+ (outline-next-heading)
+ (while (re-search-backward re beg t)
+ (replace-match "")
+ (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
+ (equal (char-before) ?\ ))
+ (backward-delete-char 1)
+ (if (string-match "^[ \t]*$" (buffer-substring
+ (point-at-bol) (point-at-eol)))
+ (delete-region (point-at-bol)
+ (min (point-max) (1+ (point-at-eol))))))))))
+
+(defun org-add-planning-info (what &optional time &rest remove)
+ "Insert new timestamp with keyword in the line directly after the headline.
+WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
+If non is given, the user is prompted for a date.
+REMOVE indicates what kind of entries to remove. An old WHAT entry will also
+be removed."
+ (interactive)
+ (let (org-time-was-given org-end-time-was-given ts
+ end default-time default-input)
+
+ (catch 'exit
+ (when (and (memq what '(scheduled deadline))
+ (or (not time)
+ (and (stringp time)
+ (string-match "^[-+]+[0-9]" time))))
+ ;; Try to get a default date/time from existing timestamp
+ (save-excursion
+ (org-back-to-heading t)
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (when (re-search-forward (if (eq what 'scheduled)
+ org-scheduled-time-regexp
+ org-deadline-time-regexp)
+ end t)
+ (setq ts (match-string 1)
+ default-time
+ (apply 'encode-time (org-parse-time-string ts))
+ default-input (and ts (org-get-compact-tod ts))))))
+ (when what
+ (setq time
+ (if (stringp time)
+ ;; This is a string (relative or absolute), set proper date
+ (apply 'encode-time
+ (org-read-date-analyze
+ time default-time (decode-time default-time)))
+ ;; If necessary, get the time from the user
+ (or time (org-read-date nil 'to-time nil nil
+ default-time default-input)))))
+
+ (when (and org-insert-labeled-timestamps-at-point
+ (member what '(scheduled deadline)))
+ (insert
+ (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
+ (org-insert-time-stamp time org-time-was-given
+ nil nil nil (list org-end-time-was-given))
+ (setq what nil))
+ (save-excursion
+ (save-restriction
+ (let (col list elt ts buffer-invisibility-spec)
+ (org-back-to-heading t)
+ (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"))
+ (goto-char (match-end 1))
+ (setq col (current-column))
+ (goto-char (match-end 0))
+ (if (eobp) (insert "\n") (forward-char 1))
+ (when (and (not what)
+ (not (looking-at
+ (concat "[ \t]*"
+ org-keyword-time-not-clock-regexp))))
+ ;; Nothing to add, nothing to remove...... :-)
+ (throw 'exit nil))
+ (if (and (not (looking-at org-outline-regexp))
+ (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
+ "[^\r\n]*"))
+ (not (equal (match-string 1) org-clock-string)))
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (insert-before-markers "\n")
+ (backward-char 1)
+ (narrow-to-region (point) (point))
+ (and org-adapt-indentation (org-indent-to-column col)))
+ ;; Check if we have to remove something.
+ (setq list (cons what remove))
+ (while list
+ (setq elt (pop list))
+ (when (or (and (eq elt 'scheduled)
+ (re-search-forward org-scheduled-time-regexp nil t))
+ (and (eq elt 'deadline)
+ (re-search-forward org-deadline-time-regexp nil t))
+ (and (eq elt 'closed)
+ (re-search-forward org-closed-time-regexp nil t)))
+ (replace-match "")
+ (if (looking-at "--+<[^>]+>") (replace-match ""))))
+ (and (looking-at "[ \t]+") (replace-match ""))
+ (and org-adapt-indentation (bolp) (org-indent-to-column col))
+ (when what
+ (insert
+ (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
+ (cond ((eq what 'scheduled) org-scheduled-string)
+ ((eq what 'deadline) org-deadline-string)
+ ((eq what 'closed) org-closed-string))
+ " ")
+ (setq ts (org-insert-time-stamp
+ time
+ (or org-time-was-given
+ (and (eq what 'closed) org-log-done-with-time))
+ (eq what 'closed)
+ nil nil (list org-end-time-was-given)))
+ (insert
+ (if (not (or (bolp) (eq (char-before) ?\ )
+ (memq (char-after) '(32 10))
+ (eobp))) " " ""))
+ (end-of-line 1))
+ (goto-char (point-min))
+ (widen)
+ (if (and (looking-at "[ \t]*\n")
+ (equal (char-before) ?\n))
+ (delete-region (1- (point)) (point-at-eol)))
+ ts))))))
+
+(defvar org-log-note-marker (make-marker))
+(defvar org-log-note-purpose nil)
+(defvar org-log-note-state nil)
+(defvar org-log-note-previous-state nil)
+(defvar org-log-note-how nil)
+(defvar org-log-note-extra nil)
+(defvar org-log-note-window-configuration nil)
+(defvar org-log-note-return-to (make-marker))
+(defvar org-log-note-effective-time nil
+ "Remembered current time so that dynamically scoped
+`org-extend-today-until' affects tha timestamps in state change
+log")
+
+(defvar org-log-post-message nil
+ "Message to be displayed after a log note has been stored.
+The auto-repeater uses this.")
+
+(defun org-add-note ()
+ "Add a note to the current entry.
+This is done in the same way as adding a state change note."
+ (interactive)
+ (org-add-log-setup 'note nil nil 'findpos nil))
+
+(defvar org-property-end-re)
+(defun org-add-log-setup (&optional purpose state prev-state
+ findpos how extra)
+ "Set up the post command hook to take a note.
+If this is about to TODO state change, the new state is expected in STATE.
+When FINDPOS is non-nil, find the correct position for the note in
+the current entry. If not, assume that it can be inserted at point.
+HOW is an indicator what kind of note should be created.
+EXTRA is additional text that will be inserted into the notes buffer."
+ (let* ((org-log-into-drawer (org-log-into-drawer))
+ (drawer (cond ((stringp org-log-into-drawer)
+ org-log-into-drawer)
+ (org-log-into-drawer "LOGBOOK"))))
+ (save-restriction
+ (save-excursion
+ (when findpos
+ (org-back-to-heading t)
+ (narrow-to-region (point) (save-excursion
+ (outline-next-heading) (point)))
+ (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"
+ "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
+ "[^\r\n]*\\)?"))
+ (goto-char (match-end 0))
+ (cond
+ (drawer
+ (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
+ nil t)
+ (progn
+ (goto-char (match-end 0))
+ (or org-log-states-order-reversed
+ (and (re-search-forward org-property-end-re nil t)
+ (goto-char (1- (match-beginning 0))))))
+ (insert "\n:" drawer ":\n:END:")
+ (beginning-of-line 0)
+ (org-indent-line)
+ (beginning-of-line 2)
+ (org-indent-line)
+ (end-of-line 0)))
+ ((and org-log-state-notes-insert-after-drawers
+ (save-excursion
+ (forward-line) (looking-at org-drawer-regexp)))
+ (forward-line)
+ (while (looking-at org-drawer-regexp)
+ (goto-char (match-end 0))
+ (re-search-forward org-property-end-re (point-max) t)
+ (forward-line))
+ (forward-line -1)))
+ (unless org-log-states-order-reversed
+ (and (= (char-after) ?\n) (forward-char 1))
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n\r")))
+ (move-marker org-log-note-marker (point))
+ (setq org-log-note-purpose purpose
+ org-log-note-state state
+ org-log-note-previous-state prev-state
+ org-log-note-how how
+ org-log-note-extra extra
+ org-log-note-effective-time (org-current-effective-time))
+ (add-hook 'post-command-hook 'org-add-log-note 'append)))))
+
+(defun org-skip-over-state-notes ()
+ "Skip past the list of State notes in an entry."
+ (if (looking-at "\n[ \t]*- State") (forward-char 1))
+ (when (ignore-errors (goto-char (org-in-item-p)))
+ (let* ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct)))
+ (while (looking-at "[ \t]*- State")
+ (goto-char (or (org-list-get-next-item (point) struct prevs)
+ (org-list-get-item-end (point) struct)))))))
+
+(defun org-add-log-note (&optional purpose)
+ "Pop up a window for taking a note, and add this note later at point."
+ (remove-hook 'post-command-hook 'org-add-log-note)
+ (setq org-log-note-window-configuration (current-window-configuration))
+ (delete-other-windows)
+ (move-marker org-log-note-return-to (point))
+ (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker))
+ (goto-char org-log-note-marker)
+ (org-switch-to-buffer-other-window "*Org Note*")
+ (erase-buffer)
+ (if (memq org-log-note-how '(time state))
+ (let (current-prefix-arg) (org-store-log-note))
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert (format "# Insert note for %s.
+# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
+ (cond
+ ((eq org-log-note-purpose 'clock-out) "stopped clock")
+ ((eq org-log-note-purpose 'done) "closed todo item")
+ ((eq org-log-note-purpose 'state)
+ (format "state change from \"%s\" to \"%s\""
+ (or org-log-note-previous-state "")
+ (or org-log-note-state "")))
+ ((eq org-log-note-purpose 'reschedule)
+ "rescheduling")
+ ((eq org-log-note-purpose 'delschedule)
+ "no longer scheduled")
+ ((eq org-log-note-purpose 'redeadline)
+ "changing deadline")
+ ((eq org-log-note-purpose 'deldeadline)
+ "removing deadline")
+ ((eq org-log-note-purpose 'refile)
+ "refiling")
+ ((eq org-log-note-purpose 'note)
+ "this entry")
+ (t (error "This should not happen")))))
+ (if org-log-note-extra (insert org-log-note-extra))
+ (org-set-local 'org-finish-function 'org-store-log-note)
+ (run-hooks 'org-log-buffer-setup-hook)))
+
+(defvar org-note-abort nil) ; dynamically scoped
+(defun org-store-log-note ()
+ "Finish taking a log note, and insert it to where it belongs."
+ (let ((txt (buffer-string))
+ (note (cdr (assq org-log-note-purpose org-log-note-headings)))
+ lines ind bul)
+ (kill-buffer (current-buffer))
+ (while (string-match "\\`# .*\n[ \t\n]*" txt)
+ (setq txt (replace-match "" t t txt)))
+ (if (string-match "\\s-+\\'" txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq lines (org-split-string txt "\n"))
+ (when (and note (string-match "\\S-" note))
+ (setq note
+ (org-replace-escapes
+ note
+ (list (cons "%u" (user-login-name))
+ (cons "%U" user-full-name)
+ (cons "%t" (format-time-string
+ (org-time-stamp-format 'long 'inactive)
+ org-log-note-effective-time))
+ (cons "%T" (format-time-string
+ (org-time-stamp-format 'long nil)
+ org-log-note-effective-time))
+ (cons "%d" (format-time-string
+ (org-time-stamp-format nil 'inactive)
+ org-log-note-effective-time))
+ (cons "%D" (format-time-string
+ (org-time-stamp-format nil nil)
+ org-log-note-effective-time))
+ (cons "%s" (if org-log-note-state
+ (concat "\"" org-log-note-state "\"")
+ ""))
+ (cons "%S" (if org-log-note-previous-state
+ (concat "\"" org-log-note-previous-state "\"")
+ "\"\"")))))
+ (if lines (setq note (concat note " \\\\")))
+ (push note lines))
+ (when (or current-prefix-arg org-note-abort)
+ (when org-log-into-drawer
+ (org-remove-empty-drawer-at
+ (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
+ org-log-note-marker))
+ (setq lines nil))
+ (when lines
+ (with-current-buffer (marker-buffer org-log-note-marker)
+ (save-excursion
+ (goto-char org-log-note-marker)
+ (move-marker org-log-note-marker nil)
+ (end-of-line 1)
+ (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
+ (setq ind (save-excursion
+ (if (ignore-errors (goto-char (org-in-item-p)))
+ (let ((struct (org-list-struct)))
+ (org-list-get-ind
+ (org-list-get-top-point struct) struct))
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ((and (org-at-heading-p)
+ org-adapt-indentation)
+ (1+ (org-current-level)))
+ ((org-at-heading-p) 0)
+ (t (org-get-indentation))))))
+ (setq bul (org-list-bullet-string "-"))
+ (org-indent-line-to ind)
+ (insert bul (pop lines))
+ (let ((ind-body (+ (length bul) ind)))
+ (while lines
+ (insert "\n")
+ (org-indent-line-to ind-body)
+ (insert (pop lines))))
+ (message "Note stored")
+ (org-back-to-heading t)
+ (org-cycle-hide-drawers 'children)))))
+ (set-window-configuration org-log-note-window-configuration)
+ (with-current-buffer (marker-buffer org-log-note-return-to)
+ (goto-char org-log-note-return-to))
+ (move-marker org-log-note-return-to nil)
+ (and org-log-post-message (message "%s" org-log-post-message)))
+
+(defun org-remove-empty-drawer-at (drawer pos)
+ "Remove an empty drawer DRAWER at position POS.
+POS may also be a marker."
+ (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char pos)
+ (if (org-in-regexp
+ (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
+ (replace-match ""))))))
+
+(defvar org-ts-type nil)
+(defun org-sparse-tree (&optional arg type)
+ "Create a sparse tree, prompt for the details.
+This command can create sparse trees. You first need to select the type
+of match used to create the tree:
+
+t Show all TODO entries.
+T Show entries with a specific TODO keyword.
+m Show entries selected by a tags/property match.
+p Enter a property name and its value (both with completion on existing
+ names/values) and show entries with that property.
+r Show entries matching a regular expression (`/' can be used as well).
+b Show deadlines and scheduled items before a date.
+a Show deadlines and scheduled items after a date.
+d Show deadlines due within `org-deadline-warning-days'.
+D Show deadlines and scheduled items between a date range."
+ (interactive "P")
+ (let (ans kwd value ts-type)
+ (setq type (or type org-sparse-tree-default-date-type))
+ (setq org-ts-type type)
+ (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s"
+ (cond ((eq type 'all) "all timestamps")
+ ((eq type 'scheduled) "only scheduled")
+ ((eq type 'deadline) "only deadline")
+ ((eq type 'active) "only active timestamps")
+ ((eq type 'inactive) "only inactive timestamps")
+ ((eq type 'scheduled-or-deadline) "scheduled/deadline")
+ (t "scheduled/deadline")))
+ (setq ans (read-char-exclusive))
+ (cond
+ ((equal ans ?c)
+ (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive)))))
+ ((equal ans ?d)
+ (call-interactively 'org-check-deadlines))
+ ((equal ans ?b)
+ (call-interactively 'org-check-before-date))
+ ((equal ans ?a)
+ (call-interactively 'org-check-after-date))
+ ((equal ans ?D)
+ (call-interactively 'org-check-dates-range))
+ ((equal ans ?t)
+ (org-show-todo-tree nil))
+ ((equal ans ?T)
+ (org-show-todo-tree '(4)))
+ ((member ans '(?T ?m))
+ (call-interactively 'org-match-sparse-tree))
+ ((member ans '(?p ?P))
+ (setq kwd (org-icompleting-read "Property: "
+ (mapcar 'list (org-buffer-property-keys))))
+ (setq value (org-icompleting-read "Value: "
+ (mapcar 'list (org-property-values kwd))))
+ (unless (string-match "\\`{.*}\\'" value)
+ (setq value (concat "\"" value "\"")))
+ (org-match-sparse-tree arg (concat kwd "=" value)))
+ ((member ans '(?r ?R ?/))
+ (call-interactively 'org-occur))
+ (t (error "No such sparse tree command \"%c\"" ans)))))
+
+(defvar org-occur-highlights nil
+ "List of overlays used for occur matches.")
+(make-variable-buffer-local 'org-occur-highlights)
+(defvar org-occur-parameters nil
+ "Parameters of the active org-occur calls.
+This is a list, each call to org-occur pushes as cons cell,
+containing the regular expression and the callback, onto the list.
+The list can contain several entries if `org-occur' has been called
+several time with the KEEP-PREVIOUS argument. Otherwise, this list
+will only contain one set of parameters. When the highlights are
+removed (for example with `C-c C-c', or with the next edit (depending
+on `org-remove-highlights-with-change'), this variable is emptied
+as well.")
+(make-variable-buffer-local 'org-occur-parameters)
+
+(defun org-occur (regexp &optional keep-previous callback)
+ "Make a compact tree which shows all matches of REGEXP.
+The tree will show the lines where the regexp matches, and all higher
+headlines above the match. It will also show the heading after the match,
+to make sure editing the matching entry is easy.
+If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
+call to `org-occur' will be kept, to allow stacking of calls to this
+command.
+If CALLBACK is non-nil, it is a function which is called to confirm
+that the match should indeed be shown."
+ (interactive "sRegexp: \nP")
+ (when (equal regexp "")
+ (error "Regexp cannot be empty"))
+ (unless keep-previous
+ (org-remove-occur-highlights nil nil t))
+ (push (cons regexp callback) org-occur-parameters)
+ (let ((cnt 0))
+ (save-excursion
+ (goto-char (point-min))
+ (if (or (not keep-previous) ; do not want to keep
+ (not org-occur-highlights)) ; no previous matches
+ ;; hide everything
+ (org-overview))
+ (while (re-search-forward regexp nil t)
+ (when (or (not callback)
+ (save-match-data (funcall callback)))
+ (setq cnt (1+ cnt))
+ (when org-highlight-sparse-tree-matches
+ (org-highlight-new-match (match-beginning 0) (match-end 0)))
+ (org-show-context 'occur-tree))))
+ (when org-remove-highlights-with-change
+ (org-add-hook 'before-change-functions 'org-remove-occur-highlights
+ nil 'local))
+ (unless org-sparse-tree-open-archived-trees
+ (org-hide-archived-subtrees (point-min) (point-max)))
+ (run-hooks 'org-occur-hook)
+ (if (org-called-interactively-p 'interactive)
+ (message "%d match(es) for regexp %s" cnt regexp))
+ cnt))
+
+(defun org-occur-next-match (&optional n reset)
+ "Function for `next-error-function' to find sparse tree matches.
+N is the number of matches to move, when negative move backwards.
+RESET is entirely ignored - this function always goes back to the
+starting point when no match is found."
+ (let* ((limit (if (< n 0) (point-min) (point-max)))
+ (search-func (if (< n 0)
+ 'previous-single-char-property-change
+ 'next-single-char-property-change))
+ (n (abs n))
+ (pos (point))
+ p1)
+ (catch 'exit
+ (while (setq p1 (funcall search-func (point) 'org-type))
+ (when (equal p1 limit)
+ (goto-char pos)
+ (error "No more matches"))
+ (when (equal (get-char-property p1 'org-type) 'org-occur)
+ (setq n (1- n))
+ (when (= n 0)
+ (goto-char p1)
+ (throw 'exit (point))))
+ (goto-char p1))
+ (goto-char p1)
+ (error "No more matches"))))
+
+(defun org-show-context (&optional key)
+ "Make sure point and context are visible.
+How much context is shown depends upon the variables
+`org-show-hierarchy-above', `org-show-following-heading',
+`org-show-entry-below' and `org-show-siblings'."
+ (let ((heading-p (org-at-heading-p t))
+ (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
+ (following-p (org-get-alist-option org-show-following-heading key))
+ (entry-p (org-get-alist-option org-show-entry-below key))
+ (siblings-p (org-get-alist-option org-show-siblings key)))
+ (catch 'exit
+ ;; Show heading or entry text
+ (if (and heading-p (not entry-p))
+ (org-flag-heading nil) ; only show the heading
+ (and (or entry-p (outline-invisible-p) (org-invisible-p2))
+ (org-show-hidden-entry))) ; show entire entry
+ (when following-p
+ ;; Show next sibling, or heading below text
+ (save-excursion
+ (and (if heading-p (org-goto-sibling) (outline-next-heading))
+ (org-flag-heading nil))))
+ (when siblings-p (org-show-siblings))
+ (when hierarchy-p
+ ;; show all higher headings, possibly with siblings
+ (save-excursion
+ (while (and (condition-case nil
+ (progn (org-up-heading-all 1) t)
+ (error nil))
+ (not (bobp)))
+ (org-flag-heading nil)
+ (when siblings-p (org-show-siblings))))))))
+
+(defvar org-reveal-start-hook nil
+ "Hook run before revealing a location.")
+
+(defun org-reveal (&optional siblings)
+ "Show current entry, hierarchy above it, and the following headline.
+This can be used to show a consistent set of context around locations
+exposed with `org-show-hierarchy-above' or `org-show-following-heading'
+not t for the search context.
+
+With optional argument SIBLINGS, on each level of the hierarchy all
+siblings are shown. This repairs the tree structure to what it would
+look like when opened with hierarchical calls to `org-cycle'.
+With double optional argument \\[universal-argument] \\[universal-argument], \
+go to the parent and show the
+entire tree."
+ (interactive "P")
+ (run-hooks 'org-reveal-start-hook)
+ (let ((org-show-hierarchy-above t)
+ (org-show-following-heading t)
+ (org-show-siblings (if siblings t org-show-siblings)))
+ (org-show-context nil))
+ (when (equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree)))))
+
+(defun org-highlight-new-match (beg end)
+ "Highlight from BEG to END and mark the highlight is an occur headline."
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'secondary-selection)
+ (overlay-put ov 'org-type 'org-occur)
+ (push ov org-occur-highlights)))
+
+(defun org-remove-occur-highlights (&optional beg end noremove)
+ "Remove the occur highlights from the buffer.
+BEG and END are ignored. If NOREMOVE is nil, remove this function
+from the `before-change-functions' in the current buffer."
+ (interactive)
+ (unless org-inhibit-highlight-removal
+ (mapc 'delete-overlay org-occur-highlights)
+ (setq org-occur-highlights nil)
+ (setq org-occur-parameters nil)
+ (unless noremove
+ (remove-hook 'before-change-functions
+ 'org-remove-occur-highlights 'local))))
+
+;;;; Priorities
+
+(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
+ "Regular expression matching the priority indicator.")
+
+(defvar org-remove-priority-next-time nil)
+
+(defun org-priority-up ()
+ "Increase the priority of the current item."
+ (interactive)
+ (org-priority 'up))
+
+(defun org-priority-down ()
+ "Decrease the priority of the current item."
+ (interactive)
+ (org-priority 'down))
+
+(defun org-priority (&optional action show)
+ "Change the priority of an item.
+ACTION can be `set', `up', `down', or a character."
+ (interactive "P")
+ (if (equal action '(4))
+ (org-show-priority)
+ (unless org-enable-priority-commands
+ (error "Priority commands are disabled"))
+ (setq action (or action 'set))
+ (let (current new news have remove)
+ (save-excursion
+ (org-back-to-heading t)
+ (if (looking-at org-priority-regexp)
+ (setq current (string-to-char (match-string 2))
+ have t))
+ (cond
+ ((eq action 'remove)
+ (setq remove t new ?\ ))
+ ((or (eq action 'set)
+ (if (featurep 'xemacs) (characterp action) (integerp action)))
+ (if (not (eq action 'set))
+ (setq new action)
+ (message "Priority %c-%c, SPC to remove: "
+ org-highest-priority org-lowest-priority)
+ (save-match-data
+ (setq new (read-char-exclusive))))
+ (if (and (= (upcase org-highest-priority) org-highest-priority)
+ (= (upcase org-lowest-priority) org-lowest-priority))
+ (setq new (upcase new)))
+ (cond ((equal new ?\ ) (setq remove t))
+ ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
+ (error "Priority must be between `%c' and `%c'"
+ org-highest-priority org-lowest-priority))))
+ ((eq action 'up)
+ (setq new (if have
+ (1- current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-lowest-priority ; wrap around empty to lowest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1- org-default-priority))))))
+ ((eq action 'down)
+ (setq new (if have
+ (1+ current) ; normal cycling
+ ;; last priority was empty
+ (if (eq last-command this-command)
+ org-highest-priority ; wrap around empty to highest
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1+ org-default-priority))))))
+ (t (error "Invalid action")))
+ (if (or (< (upcase new) org-highest-priority)
+ (> (upcase new) org-lowest-priority))
+ (if (and (memq action '(up down))
+ (not have) (not (eq last-command this-command)))
+ ;; `new' is from default priority
+ (error
+ "The default can not be set, see `org-default-priority' why")
+ ;; normal cycling: `new' is beyond highest/lowest priority
+ ;; and is wrapped around to the empty priority
+ (setq remove t)))
+ (setq news (format "%c" new))
+ (if have
+ (if remove
+ (replace-match "" t t nil 1)
+ (replace-match news t t nil 2))
+ (if remove
+ (error "No priority cookie found in line")
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp))
+ (if (match-end 2)
+ (progn
+ (goto-char (match-end 2))
+ (insert " [#" news "]"))
+ (goto-char (match-beginning 3))
+ (insert "[#" news "] "))))
+ (org-preserve-lc (org-set-tags nil 'align)))
+ (if remove
+ (message "Priority removed")
+ (message "Priority of current item set to %s" news)))))
+
+(defun org-show-priority ()
+ "Show the priority of the current item.
+This priority is composed of the main priority given with the [#A] cookies,
+and by additional input from the age of a schedules or deadline entry."
+ (interactive)
+ (let ((pri (if (eq major-mode 'org-agenda-mode)
+ (org-get-at-bol 'priority)
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (and (looking-at org-heading-regexp)
+ (org-get-priority (match-string 0))))))))
+ (message "Priority is %d" (if pri pri -1000))))
+
+(defun org-get-priority (s)
+ "Find priority cookie and return priority."
+ (if (functionp org-get-priority-function)
+ (funcall org-get-priority-function)
+ (save-match-data
+ (if (not (string-match org-priority-regexp s))
+ (* 1000 (- org-lowest-priority org-default-priority))
+ (* 1000 (- org-lowest-priority
+ (string-to-char (match-string 2 s))))))))
+
+;;;; Tags
+
+(defvar org-agenda-archives-mode)
+(defvar org-map-continue-from nil
+ "Position from where mapping should continue.
+Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
+
+(defvar org-scanner-tags nil
+ "The current tag list while the tags scanner is running.")
+(defvar org-trust-scanner-tags nil
+ "Should `org-get-tags-at' use the tags for the scanner.
+This is for internal dynamical scoping only.
+When this is non-nil, the function `org-get-tags-at' will return the value
+of `org-scanner-tags' instead of building the list by itself. This
+can lead to large speed-ups when the tags scanner is used in a file with
+many entries, and when the list of tags is retrieved, for example to
+obtain a list of properties. Building the tags list for each entry in such
+a file becomes an N^2 operation - but with this variable set, it scales
+as N.")
+
+(defun org-scan-tags (action matcher todo-only &optional start-level)
+ "Scan headline tags with inheritance and produce output ACTION.
+
+ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
+or `agenda' to produce an entry list for an agenda view. It can also be
+a Lisp form or a function that should be called at each matched headline, in
+this case the return value is a list of all return values from these calls.
+
+MATCHER is a Lisp form to be evaluated, testing if a given set of tags
+qualifies a headline for inclusion. When TODO-ONLY is non-nil,
+only lines with a not-done TODO keyword are included in the output.
+This should be the same variable that was scoped into
+and set by `org-make-tags-matcher' when it constructed MATCHER.
+
+START-LEVEL can be a string with asterisks, reducing the scope to
+headlines matching this string."
+ (require 'org-agenda)
+ (let* ((re (concat "^"
+ (if start-level
+ ;; Get the correct level to match
+ (concat "\\*\\{" (number-to-string start-level) "\\} ")
+ org-outline-regexp)
+ " *\\(\\<\\("
+ (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
+ (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
+ (props (list 'face 'default
+ 'done-face 'org-agenda-done
+ 'undone-face 'default
+ 'mouse-face 'highlight
+ 'org-not-done-regexp org-not-done-regexp
+ 'org-todo-regexp org-todo-regexp
+ 'org-complex-heading-regexp org-complex-heading-regexp
+ 'help-echo
+ (format "mouse-2 or RET jump to org file %s"
+ (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (buffer-name (buffer-base-buffer)))))))
+ (case-fold-search nil)
+ (org-map-continue-from nil)
+ lspos tags tags-list
+ (tags-alist (list (cons 0 org-file-tags)))
+ (llast 0) rtn rtn1 level category i txt
+ todo marker entry priority)
+ (when (not (or (member action '(agenda sparse-tree)) (functionp action)))
+ (setq action (list 'lambda nil action)))
+ (save-excursion
+ (goto-char (point-min))
+ (when (eq action 'sparse-tree)
+ (org-overview)
+ (org-remove-occur-highlights))
+ (while (re-search-forward re nil t)
+ (setq org-map-continue-from nil)
+ (catch :skip
+ (setq todo (if (match-end 1) (org-match-string-no-properties 2))
+ tags (if (match-end 4) (org-match-string-no-properties 4)))
+ (goto-char (setq lspos (match-beginning 0)))
+ (setq level (org-reduced-level (funcall outline-level))
+ category (org-get-category))
+ (setq i llast llast level)
+ ;; remove tag lists from same and sublevels
+ (while (>= i level)
+ (when (setq entry (assoc i tags-alist))
+ (setq tags-alist (delete entry tags-alist)))
+ (setq i (1- i)))
+ ;; add the next tags
+ (when tags
+ (setq tags (org-split-string tags ":")
+ tags-alist
+ (cons (cons level tags) tags-alist)))
+ ;; compile tags for current headline
+ (setq tags-list
+ (if org-use-tag-inheritance
+ (apply 'append (mapcar 'cdr (reverse tags-alist)))
+ tags)
+ org-scanner-tags tags-list)
+ (when org-use-tag-inheritance
+ (setcdr (car tags-alist)
+ (mapcar (lambda (x)
+ (setq x (copy-sequence x))
+ (org-add-prop-inherited x))
+ (cdar tags-alist))))
+ (when (and tags org-use-tag-inheritance
+ (or (not (eq t org-use-tag-inheritance))
+ org-tags-exclude-from-inheritance))
+ ;; selective inheritance, remove uninherited ones
+ (setcdr (car tags-alist)
+ (org-remove-uninherited-tags (cdar tags-alist))))
+ (when (and
+
+ ;; eval matcher only when the todo condition is OK
+ (and (or (not todo-only) (member todo org-not-done-keywords))
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (eval matcher)))
+
+ ;; Call the skipper, but return t if it does not skip,
+ ;; so that the `and' form continues evaluating
+ (progn
+ (unless (eq action 'sparse-tree) (org-agenda-skip))
+ t)
+
+ ;; Check if timestamps are deselecting this entry
+ (or (not todo-only)
+ (and (member todo org-not-done-keywords)
+ (or (not org-agenda-tags-todo-honor-ignore-options)
+ (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))
+
+ ;; Extra check for the archive tag
+ ;; FIXME: Does the skipper already do this????
+ (or
+ (not (member org-archive-tag tags-list))
+ ;; we have an archive tag, should we use this anyway?
+ (or (not org-agenda-skip-archived-trees)
+ (and (eq action 'agenda) org-agenda-archives-mode))))
+
+ ;; select this headline
+
+ (cond
+ ((eq action 'sparse-tree)
+ (and org-highlight-sparse-tree-matches
+ (org-get-heading) (match-end 0)
+ (org-highlight-new-match
+ (match-beginning 1) (match-end 1)))
+ (org-show-context 'tags-tree))
+ ((eq action 'agenda)
+ (setq txt (org-agenda-format-item
+ ""
+ (concat
+ (if (eq org-tags-match-list-sublevels 'indented)
+ (make-string (1- level) ?.) "")
+ (org-get-heading))
+ category
+ tags-list)
+ priority (org-get-priority txt))
+ (goto-char lspos)
+ (setq marker (org-agenda-new-marker))
+ (org-add-props txt props
+ 'org-marker marker 'org-hd-marker marker 'org-category category
+ 'todo-state todo
+ 'priority priority 'type "tagsmatch")
+ (push txt rtn))
+ ((functionp action)
+ (setq org-map-continue-from nil)
+ (save-excursion
+ (setq rtn1 (funcall action))
+ (push rtn1 rtn)))
+ (t (error "Invalid action")))
+
+ ;; if we are to skip sublevels, jump to end of subtree
+ (unless org-tags-match-list-sublevels
+ (org-end-of-subtree t)
+ (backward-char 1))))
+ ;; Get the correct position from where to continue
+ (if org-map-continue-from
+ (goto-char org-map-continue-from)
+ (and (= (point) lspos) (end-of-line 1)))))
+ (when (and (eq action 'sparse-tree)
+ (not org-sparse-tree-open-archived-trees))
+ (org-hide-archived-subtrees (point-min) (point-max)))
+ (nreverse rtn)))
+
+(defun org-remove-uninherited-tags (tags)
+ "Remove all tags that are not inherited from the list TAGS."
+ (cond
+ ((eq org-use-tag-inheritance t)
+ (if org-tags-exclude-from-inheritance
+ (org-delete-all org-tags-exclude-from-inheritance tags)
+ tags))
+ ((not org-use-tag-inheritance) nil)
+ ((stringp org-use-tag-inheritance)
+ (delq nil (mapcar
+ (lambda (x)
+ (if (and (string-match org-use-tag-inheritance x)
+ (not (member x org-tags-exclude-from-inheritance)))
+ x nil))
+ tags)))
+ ((listp org-use-tag-inheritance)
+ (delq nil (mapcar
+ (lambda (x)
+ (if (member x org-use-tag-inheritance) x nil))
+ tags)))))
+
+(defun org-match-sparse-tree (&optional todo-only match)
+ "Create a sparse tree according to tags string MATCH.
+MATCH can contain positive and negative selection of tags, like
+\"+WORK+URGENT-WITHBOSS\".
+If optional argument TODO-ONLY is non-nil, only select lines that are
+also TODO lines."
+ (interactive "P")
+ (org-agenda-prepare-buffers (list (current-buffer)))
+ (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
+
+(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
+
+(defvar org-cached-props nil)
+(defun org-cached-entry-get (pom property)
+ (if (or (eq t org-use-property-inheritance)
+ (and (stringp org-use-property-inheritance)
+ (string-match org-use-property-inheritance property))
+ (and (listp org-use-property-inheritance)
+ (member property org-use-property-inheritance)))
+ ;; Caching is not possible, check it directly
+ (org-entry-get pom property 'inherit)
+ ;; Get all properties, so that we can do complicated checks easily
+ (cdr (assoc property (or org-cached-props
+ (setq org-cached-props
+ (org-entry-properties pom)))))))
+
+(defun org-global-tags-completion-table (&optional files)
+ "Return the list of all tags in all agenda buffer/files.
+Optional FILES argument is a list of files which can be used
+instead of the agenda files."
+ (save-excursion
+ (org-uniquify
+ (delq nil
+ (apply 'append
+ (mapcar
+ (lambda (file)
+ (set-buffer (find-file-noselect file))
+ (append (org-get-buffer-tags)
+ (mapcar (lambda (x) (if (stringp (car-safe x))
+ (list (car-safe x)) nil))
+ org-tag-alist)))
+ (if (and files (car files))
+ files
+ (org-agenda-files))))))))
+
+(defun org-make-tags-matcher (match)
+ "Create the TAGS/TODO matcher form for the selection string MATCH.
+
+The variable `todo-only' is scoped dynamically into this function.
+It will be set to t if the matcher restricts matching to TODO entries,
+otherwise will not be touched.
+
+Returns a cons of the selection string MATCH and the constructed
+lisp form implementing the matcher. The matcher is to be evaluated
+at an Org entry, with point on the headline, and returns t if the
+entry matches the selection string MATCH. The returned lisp form
+references two variables with information about the entry, which
+must be bound around the form's evaluation: todo, the TODO keyword
+at the entry (or nil of none); and tags-list, the list of all tags
+at the entry including inherited ones. Additionally, the category
+of the entry (if any) must be specified as the text property
+'org-category on the headline.
+
+See also `org-scan-tags'.
+"
+ (declare (special todo-only))
+ (unless (boundp 'todo-only)
+ (error "org-make-tags-matcher expects todo-only to be scoped in"))
+ (unless match
+ ;; Get a new match request, with completion
+ (let ((org-last-tags-completion-table
+ (org-global-tags-completion-table)))
+ (setq match (org-completing-read-no-i
+ "Match: " 'org-tags-completion-function nil nil nil
+ 'org-tags-history))))
+
+ ;; Parse the string and create a lisp form
+ (let ((match0 match)
+ (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
+ minus tag mm
+ tagsmatch todomatch tagsmatcher todomatcher kwd matcher
+ orterms term orlist re-p str-p level-p level-op time-p
+ prop-p pn pv po gv rest)
+ (if (string-match "/+" match)
+ ;; match contains also a todo-matching request
+ (progn
+ (setq tagsmatch (substring match 0 (match-beginning 0))
+ todomatch (substring match (match-end 0)))
+ (if (string-match "^!" todomatch)
+ (setq todo-only t todomatch (substring todomatch 1)))
+ (if (string-match "^\\s-*$" todomatch)
+ (setq todomatch nil)))
+ ;; only matching tags
+ (setq tagsmatch match todomatch nil))
+
+ ;; Make the tags matcher
+ (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
+ (setq tagsmatcher t)
+ (setq orterms (org-split-string tagsmatch "|") orlist nil)
+ (while (setq term (pop orterms))
+ (while (and (equal (substring term -1) "\\") orterms)
+ (setq term (concat term "|" (pop orterms)))) ; repair bad split
+ (while (string-match re term)
+ (setq rest (substring term (match-end 0))
+ minus (and (match-end 1)
+ (equal (match-string 1 term) "-"))
+ tag (save-match-data (replace-regexp-in-string
+ "\\\\-" "-"
+ (match-string 2 term)))
+ re-p (equal (string-to-char tag) ?{)
+ level-p (match-end 4)
+ prop-p (match-end 5)
+ mm (cond
+ (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
+ (level-p
+ (setq level-op (org-op-to-function (match-string 3 term)))
+ `(,level-op level ,(string-to-number
+ (match-string 4 term))))
+ (prop-p
+ (setq pn (match-string 5 term)
+ po (match-string 6 term)
+ pv (match-string 7 term)
+ re-p (equal (string-to-char pv) ?{)
+ str-p (equal (string-to-char pv) ?\")
+ time-p (save-match-data
+ (string-match "^\"[[<].*[]>]\"$" pv))
+ pv (if (or re-p str-p) (substring pv 1 -1) pv))
+ (if time-p (setq pv (org-matcher-time pv)))
+ (setq po (org-op-to-function po (if time-p 'time str-p)))
+ (cond
+ ((equal pn "CATEGORY")
+ (setq gv '(get-text-property (point) 'org-category)))
+ ((equal pn "TODO")
+ (setq gv 'todo))
+ (t
+ (setq gv `(org-cached-entry-get nil ,pn))))
+ (if re-p
+ (if (eq po 'org<>)
+ `(not (string-match ,pv (or ,gv "")))
+ `(string-match ,pv (or ,gv "")))
+ (if str-p
+ `(,po (or ,gv "") ,pv)
+ `(,po (string-to-number (or ,gv ""))
+ ,(string-to-number pv) ))))
+ (t `(member ,tag tags-list)))
+ mm (if minus (list 'not mm) mm)
+ term rest)
+ (push mm tagsmatcher))
+ (push (if (> (length tagsmatcher) 1)
+ (cons 'and tagsmatcher)
+ (car tagsmatcher))
+ orlist)
+ (setq tagsmatcher nil))
+ (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
+ (setq tagsmatcher
+ (list 'progn '(setq org-cached-props nil) tagsmatcher)))
+ ;; Make the todo matcher
+ (if (or (not todomatch) (not (string-match "\\S-" todomatch)))
+ (setq todomatcher t)
+ (setq orterms (org-split-string todomatch "|") orlist nil)
+ (while (setq term (pop orterms))
+ (while (string-match re term)
+ (setq minus (and (match-end 1)
+ (equal (match-string 1 term) "-"))
+ kwd (match-string 2 term)
+ re-p (equal (string-to-char kwd) ?{)
+ term (substring term (match-end 0))
+ mm (if re-p
+ `(string-match ,(substring kwd 1 -1) todo)
+ (list 'equal 'todo kwd))
+ mm (if minus (list 'not mm) mm))
+ (push mm todomatcher))
+ (push (if (> (length todomatcher) 1)
+ (cons 'and todomatcher)
+ (car todomatcher))
+ orlist)
+ (setq todomatcher nil))
+ (setq todomatcher (if (> (length orlist) 1)
+ (cons 'or orlist) (car orlist))))
+
+ ;; Return the string and lisp forms of the matcher
+ (setq matcher (if todomatcher
+ (list 'and tagsmatcher todomatcher)
+ tagsmatcher))
+ (when todo-only
+ (setq matcher (list 'and '(member todo org-not-done-keywords)
+ matcher)))
+ (cons match0 matcher)))
+
+(defun org-op-to-function (op &optional stringp)
+ "Turn an operator into the appropriate function."
+ (setq op
+ (cond
+ ((equal op "<" ) '(< string< org-time<))
+ ((equal op ">" ) '(> org-string> org-time>))
+ ((member op '("<=" "=<")) '(<= org-string<= org-time<=))
+ ((member op '(">=" "=>")) '(>= org-string>= org-time>=))
+ ((member op '("=" "==")) '(= string= org-time=))
+ ((member op '("<>" "!=")) '(org<> org-string<> org-time<>))))
+ (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
+
+(defun org<> (a b) (not (= a b)))
+(defun org-string<= (a b) (or (string= a b) (string< a b)))
+(defun org-string>= (a b) (not (string< a b)))
+(defun org-string> (a b) (and (not (string= a b)) (not (string< a b))))
+(defun org-string<> (a b) (not (string= a b)))
+(defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b)))
+(defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b)))
+(defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b)))
+(defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b)))
+(defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b)))
+(defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b)))
+(defun org-2ft (s)
+ "Convert S to a floating point time.
+If S is already a number, just return it. If it is a string, parse
+it as a time string and apply `float-time' to it. If S is nil, just return 0."
+ (cond
+ ((numberp s) s)
+ ((stringp s)
+ (condition-case nil
+ (float-time (apply 'encode-time (org-parse-time-string s)))
+ (error 0.)))
+ (t 0.)))
+
+(defun org-time-today ()
+ "Time in seconds today at 0:00.
+Returns the float number of seconds since the beginning of the
+epoch to the beginning of today (00:00)."
+ (float-time (apply 'encode-time
+ (append '(0 0 0) (nthcdr 3 (decode-time))))))
+
+(defun org-matcher-time (s)
+ "Interpret a time comparison value."
+ (save-match-data
+ (cond
+ ((string= s "<now>") (float-time))
+ ((string= s "<today>") (org-time-today))
+ ((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
+ ((string= s "<yesterday>") (- (org-time-today) 86400.0))
+ ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s)
+ (+ (org-time-today)
+ (* (string-to-number (match-string 1 s))
+ (cdr (assoc (match-string 2 s)
+ '(("d" . 86400.0) ("w" . 604800.0)
+ ("m" . 2678400.0) ("y" . 31557600.0)))))))
+ (t (org-2ft s)))))
+
+(defun org-match-any-p (re list)
+ "Does re match any element of list?"
+ (setq list (mapcar (lambda (x) (string-match re x)) list))
+ (delq nil list))
+
+(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
+(defvar org-tags-overlay (make-overlay 1 1))
+(org-detach-overlay org-tags-overlay)
+
+(defun org-get-local-tags-at (&optional pos)
+ "Get a list of tags defined in the current headline."
+ (org-get-tags-at pos 'local))
+
+(defun org-get-local-tags ()
+ "Get a list of tags defined in the current headline."
+ (org-get-tags-at nil 'local))
+
+(defun org-get-tags-at (&optional pos local)
+ "Get a list of all headline tags applicable at POS.
+POS defaults to point. If tags are inherited, the list contains
+the targets in the same sequence as the headlines appear, i.e.
+the tags of the current headline come last.
+When LOCAL is non-nil, only return tags from the current headline,
+ignore inherited ones."
+ (interactive)
+ (if (and org-trust-scanner-tags
+ (or (not pos) (equal pos (point)))
+ (not local))
+ org-scanner-tags
+ (let (tags ltags lastpos parent)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (or pos (point)))
+ (save-match-data
+ (catch 'done
+ (condition-case nil
+ (progn
+ (org-back-to-heading t)
+ (while (not (equal lastpos (point)))
+ (setq lastpos (point))
+ (when (looking-at
+ (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
+ (setq ltags (org-split-string
+ (org-match-string-no-properties 1) ":"))
+ (when parent
+ (setq ltags (mapcar 'org-add-prop-inherited ltags)))
+ (setq tags (append
+ (if parent
+ (org-remove-uninherited-tags ltags)
+ ltags)
+ tags)))
+ (or org-use-tag-inheritance (throw 'done t))
+ (if local (throw 'done t))
+ (or (org-up-heading-safe) (error nil))
+ (setq parent t)))
+ (error nil)))))
+ (if local
+ tags
+ (append (org-remove-uninherited-tags org-file-tags) tags))))))
+
+(defun org-add-prop-inherited (s)
+ (add-text-properties 0 (length s) '(inherited t) s)
+ s)
+
+(defun org-toggle-tag (tag &optional onoff)
+ "Toggle the tag TAG for the current line.
+If ONOFF is `on' or `off', don't toggle but set to this state."
+ (let (res current)
+ (save-excursion
+ (org-back-to-heading t)
+ (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
+ (point-at-eol) t)
+ (progn
+ (setq current (match-string 1))
+ (replace-match ""))
+ (setq current ""))
+ (setq current (nreverse (org-split-string current ":")))
+ (cond
+ ((eq onoff 'on)
+ (setq res t)
+ (or (member tag current) (push tag current)))
+ ((eq onoff 'off)
+ (or (not (member tag current)) (setq current (delete tag current))))
+ (t (if (member tag current)
+ (setq current (delete tag current))
+ (setq res t)
+ (push tag current))))
+ (end-of-line 1)
+ (if current
+ (progn
+ (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
+ (org-set-tags nil t))
+ (delete-horizontal-space))
+ (run-hooks 'org-after-tags-change-hook))
+ res))
+
+(defun org-align-tags-here (to-col)
+ ;; Assumes that this is a headline
+ (let ((pos (point)) (col (current-column)) ncol tags-l p)
+ (beginning-of-line 1)
+ (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (< pos (match-beginning 2)))
+ (progn
+ (setq tags-l (- (match-end 2) (match-beginning 2)))
+ (goto-char (match-beginning 1))
+ (insert " ")
+ (delete-region (point) (1+ (match-beginning 2)))
+ (setq ncol (max (current-column)
+ (1+ col)
+ (if (> to-col 0)
+ to-col
+ (- (abs to-col) tags-l))))
+ (setq p (point))
+ (insert (make-string (- ncol (current-column)) ?\ ))
+ (setq ncol (current-column))
+ (when indent-tabs-mode (tabify p (point-at-eol)))
+ (org-move-to-column (min ncol col) t))
+ (goto-char pos))))
+
+(defun org-set-tags-command (&optional arg just-align)
+ "Call the set-tags command for the current entry."
+ (interactive "P")
+ (if (or (org-at-heading-p) (and arg (org-before-first-heading-p)))
+ (org-set-tags arg just-align)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-set-tags arg just-align))))
+
+(defun org-set-tags-to (data)
+ "Set the tags of the current entry to DATA, replacing the current tags.
+DATA may be a tags string like :aa:bb:cc:, or a list of tags.
+If DATA is nil or the empty string, any tags will be removed."
+ (interactive "sTags: ")
+ (setq data
+ (cond
+ ((eq data nil) "")
+ ((equal data "") "")
+ ((stringp data)
+ (concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
+ ":"))
+ ((listp data)
+ (concat ":" (mapconcat 'identity data ":") ":"))))
+ (when data
+ (save-excursion
+ (org-back-to-heading t)
+ (when (looking-at org-complex-heading-regexp)
+ (if (match-end 5)
+ (progn
+ (goto-char (match-beginning 5))
+ (insert data)
+ (delete-region (point) (point-at-eol))
+ (org-set-tags nil 'align))
+ (goto-char (point-at-eol))
+ (insert " " data)
+ (org-set-tags nil 'align)))
+ (beginning-of-line 1)
+ (if (looking-at ".*?\\([ \t]+\\)$")
+ (delete-region (match-beginning 1) (match-end 1))))))
+
+(defun org-align-all-tags ()
+ "Align the tags i all headings."
+ (interactive)
+ (save-excursion
+ (or (ignore-errors (org-back-to-heading t))
+ (outline-next-heading))
+ (if (org-at-heading-p)
+ (org-set-tags t)
+ (message "No headings"))))
+
+(defvar org-indent-indentation-per-level)
+(defun org-set-tags (&optional arg just-align)
+ "Set the tags for the current headline.
+With prefix ARG, realign all tags in headings in the current buffer."
+ (interactive "P")
+ (if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
+ (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ ;; We don't use ARG and JUST-ALIGN here these args are not
+ ;; useful when looping over headlines
+ `(org-set-tags)
+ org-loop-over-headlines-in-active-region
+ cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ (let* ((re org-outline-regexp-bol)
+ (current (unless arg (org-get-tags-string)))
+ (col (current-column))
+ (org-setting-tags t)
+ table current-tags inherited-tags ; computed below when needed
+ tags p0 c0 c1 rpl di tc level)
+ (if arg
+ (save-excursion
+ (goto-char (point-min))
+ (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
+ (while (re-search-forward re nil t)
+ (org-set-tags nil t)
+ (end-of-line 1)))
+ (message "All tags realigned to column %d" org-tags-column))
+ (if just-align
+ (setq tags current)
+ ;; Get a new set of tags from the user
+ (save-excursion
+ (setq table (append org-tag-persistent-alist
+ (or org-tag-alist (org-get-buffer-tags))
+ (and
+ org-complete-tags-always-offer-all-agenda-tags
+ (org-global-tags-completion-table
+ (org-agenda-files))))
+ org-last-tags-completion-table table
+ current-tags (org-split-string current ":")
+ inherited-tags (nreverse
+ (nthcdr (length current-tags)
+ (nreverse (org-get-tags-at))))
+ tags
+ (if (or (eq t org-use-fast-tag-selection)
+ (and org-use-fast-tag-selection
+ (delq nil (mapcar 'cdr table))))
+ (org-fast-tag-selection
+ current-tags inherited-tags table
+ (if org-fast-tag-selection-include-todo
+ org-todo-key-alist))
+ (let ((org-add-colon-after-tag-completion (< 1 (length table))))
+ (org-trim
+ (org-icompleting-read "Tags: "
+ 'org-tags-completion-function
+ nil nil current 'org-tags-history))))))
+ (while (string-match "[-+&]+" tags)
+ ;; No boolean logic, just a list
+ (setq tags (replace-match ":" t t tags))))
+
+ (setq tags (replace-regexp-in-string "[,]" ":" tags))
+
+ (if org-tags-sort-function
+ (setq tags (mapconcat 'identity
+ (sort (org-split-string
+ tags (org-re "[^[:alnum:]_@#%]+"))
+ org-tags-sort-function) ":")))
+
+ (if (string-match "\\`[\t ]*\\'" tags)
+ (setq tags "")
+ (unless (string-match ":$" tags) (setq tags (concat tags ":")))
+ (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
+
+ ;; Insert new tags at the correct column
+ (beginning-of-line 1)
+ (setq level (or (and (looking-at org-outline-regexp)
+ (- (match-end 0) (point) 1))
+ 1))
+ (cond
+ ((and (equal current "") (equal tags "")))
+ ((re-search-forward
+ (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+ (point-at-eol) t)
+ (if (equal tags "")
+ (setq rpl "")
+ (goto-char (match-beginning 0))
+ (setq c0 (current-column)
+ ;; compute offset for the case of org-indent-mode active
+ di (if org-indent-mode
+ (* (1- org-indent-indentation-per-level) (1- level))
+ 0)
+ p0 (if (equal (char-before) ?*) (1+ (point)) (point))
+ tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
+ c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
+ rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+ (replace-match rpl t t)
+ (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
+ tags)
+ (t (error "Tags alignment failed")))
+ (org-move-to-column col)
+ (unless just-align
+ (run-hooks 'org-after-tags-change-hook))))))
+
+(defun org-change-tag-in-region (beg end tag off)
+ "Add or remove TAG for each entry in the region.
+This works in the agenda, and also in an org-mode buffer."
+ (interactive
+ (list (region-beginning) (region-end)
+ (let ((org-last-tags-completion-table
+ (if (derived-mode-p 'org-mode)
+ (org-get-buffer-tags)
+ (org-global-tags-completion-table))))
+ (org-icompleting-read
+ "Tag: " 'org-tags-completion-function nil nil nil
+ 'org-tags-history))
+ (progn
+ (message "[s]et or [r]emove? ")
+ (equal (read-char-exclusive) ?r))))
+ (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (let ((agendap (equal major-mode 'org-agenda-mode))
+ l1 l2 m buf pos newhead (cnt 0))
+ (goto-char end)
+ (setq l2 (1- (org-current-line)))
+ (goto-char beg)
+ (setq l1 (org-current-line))
+ (loop for l from l1 to l2 do
+ (org-goto-line l)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
+ (and agendap m))
+ (setq buf (if agendap (marker-buffer m) (current-buffer))
+ pos (if agendap m (point)))
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (goto-char pos)
+ (setq cnt (1+ cnt))
+ (org-toggle-tag tag (if off 'off 'on))
+ (setq newhead (org-get-heading)))))
+ (and agendap (org-agenda-change-all-lines newhead m))))
+ (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
+
+(defun org-tags-completion-function (string predicate &optional flag)
+ (let (s1 s2 rtn (ctable org-last-tags-completion-table)
+ (confirm (lambda (x) (stringp (car x)))))
+ (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
+ (setq s1 (match-string 1 string)
+ s2 (match-string 2 string))
+ (setq s1 "" s2 string))
+ (cond
+ ((eq flag nil)
+ ;; try completion
+ (setq rtn (try-completion s2 ctable confirm))
+ (if (stringp rtn)
+ (setq rtn
+ (concat s1 s2 (substring rtn (length s2))
+ (if (and org-add-colon-after-tag-completion
+ (assoc rtn ctable))
+ ":" ""))))
+ rtn)
+ ((eq flag t)
+ ;; all-completions
+ (all-completions s2 ctable confirm)
+ )
+ ((eq flag 'lambda)
+ ;; exact match?
+ (assoc s2 ctable)))
+ ))
+
+(defun org-fast-tag-insert (kwd tags face &optional end)
+ "Insert KDW, and the TAGS, the latter with face FACE. Also insert END."
+ (insert (format "%-12s" (concat kwd ":"))
+ (org-add-props (mapconcat 'identity tags " ") nil 'face face)
+ (or end "")))
+
+(defun org-fast-tag-show-exit (flag)
+ (save-excursion
+ (org-goto-line 3)
+ (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
+ (replace-match ""))
+ (when flag
+ (end-of-line 1)
+ (org-move-to-column (- (window-width) 19) t)
+ (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
+
+(defun org-set-current-tags-overlay (current prefix)
+ (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
+ (if (featurep 'xemacs)
+ (org-overlay-display org-tags-overlay (concat prefix s)
+ 'secondary-selection)
+ (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
+ (org-overlay-display org-tags-overlay (concat prefix s)))))
+
+(defvar org-last-tag-selection-key nil)
+(defun org-fast-tag-selection (current inherited table &optional todo-table)
+ "Fast tag selection with single keys.
+CURRENT is the current list of tags in the headline, INHERITED is the
+list of inherited tags, and TABLE is an alist of tags and corresponding keys,
+possibly with grouping information. TODO-TABLE is a similar table with
+TODO keywords, should these have keys assigned to them.
+If the keys are nil, a-z are automatically assigned.
+Returns the new tags string, or nil to not change the current settings."
+ (let* ((fulltable (append table todo-table))
+ (maxlen (apply 'max (mapcar
+ (lambda (x)
+ (if (stringp (car x)) (string-width (car x)) 0))
+ fulltable)))
+ (buf (current-buffer))
+ (expert (eq org-fast-tag-selection-single-key 'expert))
+ (buffer-tags nil)
+ (fwidth (+ maxlen 3 1 3))
+ (ncol (/ (- (window-width) 4) fwidth))
+ (i-face 'org-done)
+ (c-face 'org-todo)
+ tg cnt e c char c1 c2 ntable tbl rtn
+ ov-start ov-end ov-prefix
+ (exit-after-next org-fast-tag-selection-single-key)
+ (done-keywords org-done-keywords)
+ groups ingroup)
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at
+ (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (setq ov-start (match-beginning 1)
+ ov-end (match-end 1)
+ ov-prefix "")
+ (setq ov-start (1- (point-at-eol))
+ ov-end (1+ ov-start))
+ (skip-chars-forward "^\n\r")
+ (setq ov-prefix
+ (concat
+ (buffer-substring (1- (point)) (point))
+ (if (> (current-column) org-tags-column)
+ " "
+ (make-string (- org-tags-column (current-column)) ?\ ))))))
+ (move-overlay org-tags-overlay ov-start ov-end)
+ (save-window-excursion
+ (if expert
+ (set-buffer (get-buffer-create " *Org tags*"))
+ (delete-other-windows)
+ (split-window-vertically)
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
+ (erase-buffer)
+ (org-set-local 'org-done-keywords done-keywords)
+ (org-fast-tag-insert "Inherited" inherited i-face "\n")
+ (org-fast-tag-insert "Current" current c-face "\n\n")
+ (org-fast-tag-show-exit exit-after-next)
+ (org-set-current-tags-overlay current ov-prefix)
+ (setq tbl fulltable char ?a cnt 0)
+ (while (setq e (pop tbl))
+ (cond
+ ((equal (car e) :startgroup)
+ (push '() groups) (setq ingroup t)
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n"))
+ (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
+ ((equal (car e) :endgroup)
+ (setq ingroup nil cnt 0)
+ (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((equal e '(:newline))
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n")
+ (setq e (car tbl))
+ (while (equal (car tbl) '(:newline))
+ (insert "\n")
+ (setq tbl (cdr tbl)))))
+ (t
+ (setq tg (copy-sequence (car e)) c2 nil)
+ (if (cdr e)
+ (setq c (cdr e))
+ ;; automatically assign a character.
+ (setq c1 (string-to-char
+ (downcase (substring
+ tg (if (= (string-to-char tg) ?@) 1 0)))))
+ (if (or (rassoc c1 ntable) (rassoc c1 table))
+ (while (or (rassoc char ntable) (rassoc char table))
+ (setq char (1+ char)))
+ (setq c2 c1))
+ (setq c (or c2 char)))
+ (if ingroup (push tg (car groups)))
+ (setq tg (org-add-props tg nil 'face
+ (cond
+ ((not (assoc tg table))
+ (org-get-todo-face tg))
+ ((member tg current) c-face)
+ ((member tg inherited) i-face))))
+ (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (insert "[" c "] " tg (make-string
+ (- fwidth 4 (length tg)) ?\ ))
+ (push (cons tg c) ntable)
+ (when (= (setq cnt (1+ cnt)) ncol)
+ (insert "\n")
+ (if ingroup (insert " "))
+ (setq cnt 0)))))
+ (setq ntable (nreverse ntable))
+ (insert "\n")
+ (goto-char (point-min))
+ (if (not expert) (org-fit-window-to-buffer))
+ (setq rtn
+ (catch 'exit
+ (while t
+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
+ (if (not groups) "no " "")
+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
+ (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
+ (setq org-last-tag-selection-key c)
+ (cond
+ ((= c ?\r) (throw 'exit t))
+ ((= c ?!)
+ (setq groups (not groups))
+ (goto-char (point-min))
+ (while (re-search-forward "[{}]" nil t) (replace-match " ")))
+ ((= c ?\C-c)
+ (if (not expert)
+ (org-fast-tag-show-exit
+ (setq exit-after-next (not exit-after-next)))
+ (setq expert nil)
+ (delete-other-windows)
+ (set-window-buffer (split-window-vertically) " *Org tags*")
+ (org-switch-to-buffer-other-window " *Org tags*")
+ (org-fit-window-to-buffer)))
+ ((or (= c ?\C-g)
+ (and (= c ?q) (not (rassoc c ntable))))
+ (org-detach-overlay org-tags-overlay)
+ (setq quit-flag t))
+ ((= c ?\ )
+ (setq current nil)
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((= c ?\t)
+ (condition-case nil
+ (setq tg (org-icompleting-read
+ "Tag: "
+ (or buffer-tags
+ (with-current-buffer buf
+ (org-get-buffer-tags)))))
+ (quit (setq tg "")))
+ (when (string-match "\\S-" tg)
+ (add-to-list 'buffer-tags (list tg))
+ (if (member tg current)
+ (setq current (delete tg current))
+ (push tg current)))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((setq e (rassoc c todo-table) tg (car e))
+ (with-current-buffer buf
+ (save-excursion (org-todo tg)))
+ (if exit-after-next (setq exit-after-next 'now)))
+ ((setq e (rassoc c ntable) tg (car e))
+ (if (member tg current)
+ (setq current (delete tg current))
+ (loop for g in groups do
+ (if (member tg g)
+ (mapc (lambda (x)
+ (setq current (delete x current)))
+ g)))
+ (push tg current))
+ (if exit-after-next (setq exit-after-next 'now))))
+
+ ;; Create a sorted list
+ (setq current
+ (sort current
+ (lambda (a b)
+ (assoc b (cdr (memq (assoc a ntable) ntable))))))
+ (if (eq exit-after-next 'now) (throw 'exit t))
+ (goto-char (point-min))
+ (beginning-of-line 2)
+ (delete-region (point) (point-at-eol))
+ (org-fast-tag-insert "Current" current c-face)
+ (org-set-current-tags-overlay current ov-prefix)
+ (while (re-search-forward
+ (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t)
+ (setq tg (match-string 1))
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list 'face
+ (cond
+ ((member tg current) c-face)
+ ((member tg inherited) i-face)
+ (t (get-text-property (match-beginning 1) 'face))))))
+ (goto-char (point-min)))))
+ (org-detach-overlay org-tags-overlay)
+ (if rtn
+ (mapconcat 'identity current ":")
+ nil))))
+
+(defun org-get-tags-string ()
+ "Get the TAGS string in the current headline."
+ (unless (org-at-heading-p t)
+ (error "Not on a heading"))
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (org-match-string-no-properties 1)
+ "")))
+
+(defun org-get-tags ()
+ "Get the list of tags specified in the current headline."
+ (org-split-string (org-get-tags-string) ":"))
+
+(defun org-get-buffer-tags ()
+ "Get a table of all tags used in the buffer, for completion."
+ (let (tags)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t)
+ (when (equal (char-after (point-at-bol 0)) ?*)
+ (mapc (lambda (x) (add-to-list 'tags x))
+ (org-split-string (org-match-string-no-properties 1) ":")))))
+ (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags)
+ (mapcar 'list tags)))
+
+;;;; The mapping API
+
+;;;###autoload
+(defun org-map-entries (func &optional match scope &rest skip)
+ "Call FUNC at each headline selected by MATCH in SCOPE.
+
+FUNC is a function or a lisp form. The function will be called without
+arguments, with the cursor positioned at the beginning of the headline.
+The return values of all calls to the function will be collected and
+returned as a list.
+
+The call to FUNC will be wrapped into a save-excursion form, so FUNC
+does not need to preserve point. After evaluation, the cursor will be
+moved to the end of the line (presumably of the headline of the
+processed entry) and search continues from there. Under some
+circumstances, this may not produce the wanted results. For example,
+if you have removed (e.g. archived) the current (sub)tree it could
+mean that the next entry will be skipped entirely. In such cases, you
+can specify the position from where search should continue by making
+FUNC set the variable `org-map-continue-from' to the desired buffer
+position.
+
+MATCH is a tags/property/todo match as it is used in the agenda tags view.
+Only headlines that are matched by this query will be considered during
+the iteration. When MATCH is nil or t, all headlines will be
+visited by the iteration.
+
+SCOPE determines the scope of this command. It can be any of:
+
+nil The current buffer, respecting the restriction if any
+tree The subtree started with the entry at point
+region The entries within the active region, if any
+region-start-level
+ The entries within the active region, but only those at
+ the same level than the first one.
+file The current buffer, without restriction
+file-with-archives
+ The current buffer, and any archives associated with it
+agenda All agenda files
+agenda-with-archives
+ All agenda files with any archive files associated with them
+\(file1 file2 ...)
+ If this is a list, all files in the list will be scanned
+
+The remaining args are treated as settings for the skipping facilities of
+the scanner. The following items can be given here:
+
+ archive skip trees with the archive tag.
+ comment skip trees with the COMMENT keyword
+ function or Emacs Lisp form:
+ will be used as value for `org-agenda-skip-function', so whenever
+ the function returns t, FUNC will not be called for that
+ entry and search will continue from the point where the
+ function leaves it.
+
+If your function needs to retrieve the tags including inherited tags
+at the *current* entry, you can use the value of the variable
+`org-scanner-tags' which will be much faster than getting the value
+with `org-get-tags-at'. If your function gets properties with
+`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
+to t around the call to `org-entry-properties' to get the same speedup.
+Note that if your function moves around to retrieve tags and properties at
+a *different* entry, you cannot use these techniques."
+ (unless (and (or (eq scope 'region) (eq scope 'region-start-level))
+ (not (org-region-active-p)))
+ (let* ((org-agenda-archives-mode nil) ; just to make sure
+ (org-agenda-skip-archived-trees (memq 'archive skip))
+ (org-agenda-skip-comment-trees (memq 'comment skip))
+ (org-agenda-skip-function
+ (car (org-delete-all '(comment archive) skip)))
+ (org-tags-match-list-sublevels t)
+ (start-level (eq scope 'region-start-level))
+ matcher file res
+ org-todo-keywords-for-agenda
+ org-done-keywords-for-agenda
+ org-todo-keyword-alist-for-agenda
+ org-drawers-for-agenda
+ org-tag-alist-for-agenda
+ todo-only)
+
+ (cond
+ ((eq match t) (setq matcher t))
+ ((eq match nil) (setq matcher t))
+ (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
+
+ (save-excursion
+ (save-restriction
+ (cond ((eq scope 'tree)
+ (org-back-to-heading t)
+ (org-narrow-to-subtree)
+ (setq scope nil))
+ ((and (or (eq scope 'region) (eq scope 'region-start-level))
+ (org-region-active-p))
+ ;; If needed, set start-level to a string like "2"
+ (when start-level
+ (save-excursion
+ (goto-char (region-beginning))
+ (unless (org-at-heading-p) (outline-next-heading))
+ (setq start-level (org-current-level))))
+ (narrow-to-region (region-beginning)
+ (save-excursion
+ (goto-char (region-end))
+ (unless (and (bolp) (org-at-heading-p))
+ (outline-next-heading))
+ (point)))
+ (setq scope nil)))
+
+ (if (not scope)
+ (progn
+ (org-agenda-prepare-buffers
+ (list (buffer-file-name (current-buffer))))
+ (setq res (org-scan-tags func matcher todo-only start-level)))
+ ;; Get the right scope
+ (cond
+ ((and scope (listp scope) (symbolp (car scope)))
+ (setq scope (eval scope)))
+ ((eq scope 'agenda)
+ (setq scope (org-agenda-files t)))
+ ((eq scope 'agenda-with-archives)
+ (setq scope (org-agenda-files t))
+ (setq scope (org-add-archive-files scope)))
+ ((eq scope 'file)
+ (setq scope (list (buffer-file-name))))
+ ((eq scope 'file-with-archives)
+ (setq scope (org-add-archive-files (list (buffer-file-name))))))
+ (org-agenda-prepare-buffers scope)
+ (while (setq file (pop scope))
+ (with-current-buffer (org-find-base-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (setq res (append res (org-scan-tags func matcher todo-only))))))))))
+ res)))
+
+;;;; Properties
+
+;;; Setting and retrieving properties
+
+(defconst org-special-properties
+ '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
+ "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T")
+ "The special properties valid in Org-mode.
+
+These are properties that are not defined in the property drawer,
+but in some other way.")
+
+(defconst org-default-properties
+ '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
+ "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
+ "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
+ "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
+ "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
+ "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
+ "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
+ "Some properties that are used by Org-mode for various purposes.
+Being in this list makes sure that they are offered for completion.")
+
+(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
+ "Regular expression matching the first line of a property drawer.")
+
+(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the last line of a property drawer.")
+
+(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
+ "Regular expression matching the first line of a property drawer.")
+
+(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the first line of a property drawer.")
+
+(defconst org-property-drawer-re
+ (concat "\\(" org-property-start-re "\\)[^\000]*\\("
+ org-property-end-re "\\)\n?")
+ "Matches an entire property drawer.")
+
+(defconst org-clock-drawer-re
+ (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\("
+ org-property-end-re "\\)\n?")
+ "Matches an entire clock drawer.")
+
+(defsubst org-re-property (property)
+ "Return a regexp matching a PROPERTY line.
+Match group 1 will be set to the value."
+ (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
+
+(defsubst org-re-property-keyword (property)
+ "Return a regexp matching a PROPERTY line, possibly with no
+value for the property."
+ (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?"))
+
+(defun org-property-action ()
+ "Do an action on properties."
+ (interactive)
+ (let (c)
+ (org-at-property-p)
+ (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
+ (setq c (read-char-exclusive))
+ (cond
+ ((equal c ?s)
+ (call-interactively 'org-set-property))
+ ((equal c ?d)
+ (call-interactively 'org-delete-property))
+ ((equal c ?D)
+ (call-interactively 'org-delete-property-globally))
+ ((equal c ?c)
+ (call-interactively 'org-compute-property-at-point))
+ (t (error "No such property action %c" c)))))
+
+(defun org-inc-effort ()
+ "Increment the value of the effort property in the current entry."
+ (interactive)
+ (org-set-effort nil t))
+
+(defun org-set-effort (&optional value increment)
+ "Set the effort property of the current entry.
+With numerical prefix arg, use the nth allowed value, 0 stands for the
+10th allowed value.
+
+When INCREMENT is non-nil, set the property to the next allowed value."
+ (interactive "P")
+ (if (equal value 0) (setq value 10))
+ (let* ((completion-ignore-case t)
+ (prop org-effort-property)
+ (cur (org-entry-get nil prop))
+ (allowed (org-property-get-allowed-values nil prop 'table))
+ (existing (mapcar 'list (org-property-values prop)))
+ rpl
+ (val (cond
+ ((stringp value) value)
+ ((and allowed (integerp value))
+ (or (car (nth (1- value) allowed))
+ (car (org-last allowed))))
+ ((and allowed increment)
+ (or (caadr (member (list cur) allowed))
+ (error "Allowed effort values are not set")))
+ (allowed
+ (message "Select 1-9,0, [RET%s]: %s"
+ (if cur (concat "=" cur) "")
+ (mapconcat 'car allowed " "))
+ (setq rpl (read-char-exclusive))
+ (if (equal rpl ?\r)
+ cur
+ (setq rpl (- rpl ?0))
+ (if (equal rpl 0) (setq rpl 10))
+ (if (and (> rpl 0) (<= rpl (length allowed)))
+ (car (nth (1- rpl) allowed))
+ (org-completing-read "Effort: " allowed nil))))
+ (t
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (org-completing-read
+ (concat "Effort " (if (and cur (string-match "\\S-" cur))
+ (concat "[" cur "]") "")
+ ": ")
+ existing nil nil "" nil cur))))))
+ (unless (equal (org-entry-get nil prop) val)
+ (org-entry-put nil prop val))
+ (message "%s is now %s" prop val)))
+
+(defun org-at-property-p ()
+ "Is cursor inside a property drawer?"
+ (save-excursion
+ (beginning-of-line 1)
+ (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)"))
+ (save-match-data ;; Used by calling procedures
+ (let ((p (point))
+ (range (unless (org-before-first-heading-p)
+ (org-get-property-block))))
+ (and range (<= (car range) p) (< p (cdr range))))))))
+
+(defun org-get-property-block (&optional beg end force)
+ "Return the (beg . end) range of the body of the property drawer.
+BEG and END are the beginning and end of the current subtree, or of
+the part before the first headline. If they are not given, they will
+be found. If the drawer does not exist and FORCE is non-nil, create
+the drawer."
+ (catch 'exit
+ (save-excursion
+ (let* ((beg (or beg (and (org-before-first-heading-p) (point-min))
+ (progn (org-back-to-heading t) (point))))
+ (end (or end (and (not (outline-next-heading)) (point-max))
+ (point))))
+ (goto-char beg)
+ (if (re-search-forward org-property-start-re end t)
+ (setq beg (1+ (match-end 0)))
+ (if force
+ (save-excursion
+ (org-insert-property-drawer)
+ (setq end (progn (outline-next-heading) (point))))
+ (throw 'exit nil))
+ (goto-char beg)
+ (if (re-search-forward org-property-start-re end t)
+ (setq beg (1+ (match-end 0)))))
+ (if (re-search-forward org-property-end-re end t)
+ (setq end (match-beginning 0))
+ (or force (throw 'exit nil))
+ (goto-char beg)
+ (setq end beg)
+ (org-indent-line)
+ (insert ":END:\n"))
+ (cons beg end)))))
+
+(defun org-entry-properties (&optional pom which specific)
+ "Get all properties of the entry at point-or-marker POM.
+This includes the TODO keyword, the tags, time strings for deadline,
+scheduled, and clocking, and any additional properties defined in the
+entry. The return value is an alist, keys may occur multiple times
+if the property key was used several times.
+POM may also be nil, in which case the current entry is used.
+If WHICH is nil or `all', get all properties. If WHICH is
+`special' or `standard', only get that subclass. If WHICH
+is a string only get exactly this property. SPECIFIC can be a string, the
+specific property we are interested in. Specifying it can speed
+things up because then unnecessary parsing is avoided."
+ (setq which (or which 'all))
+ (org-with-point-at pom
+ (let ((clockstr (substring org-clock-string 0 -1))
+ (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
+ (case-fold-search nil)
+ beg end range props sum-props key key1 value string clocksum clocksumt)
+ (save-excursion
+ (when (condition-case nil
+ (and (derived-mode-p 'org-mode) (org-back-to-heading t))
+ (error nil))
+ (setq beg (point))
+ (setq sum-props (get-text-property (point) 'org-summaries))
+ (setq clocksum (get-text-property (point) :org-clock-minutes)
+ clocksumt (get-text-property (point) :org-clock-minutes-today))
+ (outline-next-heading)
+ (setq end (point))
+ (when (memq which '(all special))
+ ;; Get the special properties, like TODO and tags
+ (goto-char beg)
+ (when (and (or (not specific) (string= specific "TODO"))
+ (looking-at org-todo-line-regexp) (match-end 2))
+ (push (cons "TODO" (org-match-string-no-properties 2)) props))
+ (when (and (or (not specific) (string= specific "PRIORITY"))
+ (looking-at org-priority-regexp))
+ (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
+ (when (or (not specific) (string= specific "FILE"))
+ (push (cons "FILE" buffer-file-name) props))
+ (when (and (or (not specific) (string= specific "TAGS"))
+ (setq value (org-get-tags-string))
+ (string-match "\\S-" value))
+ (push (cons "TAGS" value) props))
+ (when (and (or (not specific) (string= specific "ALLTAGS"))
+ (setq value (org-get-tags-at)))
+ (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
+ ":"))
+ props))
+ (when (or (not specific) (string= specific "BLOCKED"))
+ (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
+ (when (or (not specific)
+ (member specific
+ '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
+ "TIMESTAMP" "TIMESTAMP_IA")))
+ (catch 'match
+ (while (re-search-forward org-maybe-keyword-time-regexp end t)
+ (setq key (if (match-end 1)
+ (substring (org-match-string-no-properties 1)
+ 0 -1))
+ string (if (equal key clockstr)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-beginning 3) (goto-char
+ (point-at-eol))))
+ (substring (org-match-string-no-properties 3)
+ 1 -1)))
+ ;; Get the correct property name from the key. This is
+ ;; necessary if the user has configured time keywords.
+ (setq key1 (concat key ":"))
+ (cond
+ ((not key)
+ (setq key
+ (if (= (char-after (match-beginning 3)) ?\[)
+ "TIMESTAMP_IA" "TIMESTAMP")))
+ ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
+ ((equal key1 org-deadline-string) (setq key "DEADLINE"))
+ ((equal key1 org-closed-string) (setq key "CLOSED"))
+ ((equal key1 org-clock-string) (setq key "CLOCK")))
+ (if (and specific (equal key specific) (not (equal key "CLOCK")))
+ (progn
+ (push (cons key string) props)
+ ;; no need to search further if match is found
+ (throw 'match t))
+ (when (or (equal key "CLOCK") (not (assoc key props)))
+ (push (cons key string) props)))))))
+
+ (when (memq which '(all standard))
+ ;; Get the standard properties, like :PROP: ...
+ (setq range (org-get-property-block beg end))
+ (when range
+ (goto-char (car range))
+ (while (re-search-forward
+ (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?")
+ (cdr range) t)
+ (setq key (org-match-string-no-properties 1)
+ value (org-trim (or (org-match-string-no-properties 2) "")))
+ (unless (member key excluded)
+ (push (cons key (or value "")) props)))))
+ (if clocksum
+ (push (cons "CLOCKSUM"
+ (org-columns-number-to-string (/ (float clocksum) 60.)
+ 'add_times))
+ props))
+ (if clocksumt
+ (push (cons "CLOCKSUM_T"
+ (org-columns-number-to-string (/ (float clocksumt) 60.)
+ 'add_times))
+ props))
+ (unless (assoc "CATEGORY" props)
+ (push (cons "CATEGORY" (org-get-category)) props))
+ (append sum-props (nreverse props)))))))
+
+(defun org-entry-get (pom property &optional inherit literal-nil)
+ "Get value of PROPERTY for entry or content at point-or-marker POM.
+If INHERIT is non-nil and the entry does not have the property,
+then also check higher levels of the hierarchy.
+If INHERIT is the symbol `selective', use inheritance only if the setting
+in `org-use-property-inheritance' selects PROPERTY for inheritance.
+If the property is present but empty, the return value is the empty string.
+If the property is not present at all, nil is returned.
+
+If LITERAL-NIL is set, return the string value \"nil\" as a string,
+do not interpret it as the list atom nil. This is used for inheritance
+when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
+ (org-with-point-at pom
+ (if (and inherit (if (eq inherit 'selective)
+ (org-property-inherit-p property)
+ t))
+ (org-entry-get-with-inheritance property literal-nil)
+ (if (member property org-special-properties)
+ ;; We need a special property. Use `org-entry-properties' to
+ ;; retrieve it, but specify the wanted property
+ (cdr (assoc property (org-entry-properties nil 'special property)))
+ (let* ((range (org-get-property-block))
+ (props (list (or (assoc property org-file-properties)
+ (assoc property org-global-properties)
+ (assoc property org-global-properties-fixed))))
+ (ap (lambda (key)
+ (when (re-search-forward
+ (org-re-property key) (cdr range) t)
+ (setq props
+ (org-update-property-plist
+ key
+ (if (match-end 1)
+ (org-match-string-no-properties 1) "")
+ props)))))
+ val)
+ (when (and range (goto-char (car range)))
+ (funcall ap property)
+ (goto-char (car range))
+ (while (funcall ap (concat property "+")))
+ (setq val (cdr (assoc property props)))
+ (when val (if literal-nil val (org-not-nil val)))))))))
+
+(defun org-property-or-variable-value (var &optional inherit)
+ "Check if there is a property fixing the value of VAR.
+If yes, return this value. If not, return the current value of the variable."
+ (let ((prop (org-entry-get nil (symbol-name var) inherit)))
+ (if (and prop (stringp prop) (string-match "\\S-" prop))
+ (read prop)
+ (symbol-value var))))
+
+(defun org-entry-delete (pom property)
+ "Delete the property PROPERTY from entry at point-or-marker POM."
+ (org-with-point-at pom
+ (if (member property org-special-properties)
+ nil ; cannot delete these properties.
+ (let ((range (org-get-property-block)))
+ (if (and range
+ (goto-char (car range))
+ (re-search-forward
+ (org-re-property property)
+ (cdr range) t))
+ (progn
+ (delete-region (match-beginning 0) (1+ (point-at-eol)))
+ t)
+ nil)))))
+
+;; Multi-values properties are properties that contain multiple values
+;; These values are assumed to be single words, separated by whitespace.
+(defun org-entry-add-to-multivalued-property (pom property value)
+ "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (setq value (org-entry-protect-space value))
+ (unless (member value values)
+ (setq values (cons value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-remove-from-multivalued-property (pom property value)
+ "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (setq value (org-entry-protect-space value))
+ (when (member value values)
+ (setq values (delete value values))
+ (org-entry-put pom property
+ (mapconcat 'identity values " ")))))
+
+(defun org-entry-member-in-multivalued-property (pom property value)
+ "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
+ (let* ((old (org-entry-get pom property))
+ (values (and old (org-split-string old "[ \t]"))))
+ (setq value (org-entry-protect-space value))
+ (member value values)))
+
+(defun org-entry-get-multivalued-property (pom property)
+ "Return a list of values in a multivalued property."
+ (let* ((value (org-entry-get pom property))
+ (values (and value (org-split-string value "[ \t]"))))
+ (mapcar 'org-entry-restore-space values)))
+
+(defun org-entry-put-multivalued-property (pom property &rest values)
+ "Set multivalued PROPERTY at point-or-marker POM to VALUES.
+VALUES should be a list of strings. Spaces will be protected."
+ (org-entry-put pom property
+ (mapconcat 'org-entry-protect-space values " "))
+ (let* ((value (org-entry-get pom property))
+ (values (and value (org-split-string value "[ \t]"))))
+ (mapcar 'org-entry-restore-space values)))
+
+(defun org-entry-protect-space (s)
+ "Protect spaces and newline in string S."
+ (while (string-match " " s)
+ (setq s (replace-match "%20" t t s)))
+ (while (string-match "\n" s)
+ (setq s (replace-match "%0A" t t s)))
+ s)
+
+(defun org-entry-restore-space (s)
+ "Restore spaces and newline in string S."
+ (while (string-match "%20" s)
+ (setq s (replace-match " " t t s)))
+ (while (string-match "%0A" s)
+ (setq s (replace-match "\n" t t s)))
+ s)
+
+(defvar org-entry-property-inherited-from (make-marker)
+ "Marker pointing to the entry from where a property was inherited.
+Each call to `org-entry-get-with-inheritance' will set this marker to the
+location of the entry where the inheritance search matched. If there was
+no match, the marker will point nowhere.
+Note that also `org-entry-get' calls this function, if the INHERIT flag
+is set.")
+
+(defun org-entry-get-with-inheritance (property &optional literal-nil)
+ "Get PROPERTY of entry or content at point, search higher levels if needed.
+The search will stop at the first ancestor which has the property defined.
+If the value found is \"nil\", return nil to show that the property
+should be considered as undefined (this is the meaning of nil here).
+However, if LITERAL-NIL is set, return the string value \"nil\" instead."
+ (move-marker org-entry-property-inherited-from nil)
+ (let (tmp)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'ex
+ (while t
+ (when (setq tmp (org-entry-get nil property nil 'literal-nil))
+ (or (ignore-errors (org-back-to-heading t))
+ (goto-char (point-min)))
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'ex tmp))
+ (or (ignore-errors (org-up-heading-safe))
+ (throw 'ex nil))))))
+ (setq tmp (or tmp
+ (cdr (assoc property org-file-properties))
+ (cdr (assoc property org-global-properties))
+ (cdr (assoc property org-global-properties-fixed))))
+ (if literal-nil tmp (org-not-nil tmp))))
+
+(defvar org-property-changed-functions nil
+ "Hook called when the value of a property has changed.
+Each hook function should accept two arguments, the name of the property
+and the new value.")
+
+(defun org-entry-put (pom property value)
+ "Set PROPERTY to VALUE for entry at point-or-marker POM."
+ (org-with-point-at pom
+ (org-back-to-heading t)
+ (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
+ range)
+ (cond
+ ((equal property "TODO")
+ (when (and (stringp value) (string-match "\\S-" value)
+ (not (member value org-todo-keywords-1)))
+ (error "\"%s\" is not a valid TODO state" value))
+ (if (or (not value)
+ (not (string-match "\\S-" value)))
+ (setq value 'none))
+ (org-todo value)
+ (org-set-tags nil 'align))
+ ((equal property "PRIORITY")
+ (org-priority (if (and value (stringp value) (string-match "\\S-" value))
+ (string-to-char value) ?\ ))
+ (org-set-tags nil 'align))
+ ((equal property "SCHEDULED")
+ (if (re-search-forward org-scheduled-time-regexp end t)
+ (cond
+ ((eq value 'earlier) (org-timestamp-change -1 'day))
+ ((eq value 'later) (org-timestamp-change 1 'day))
+ (t (call-interactively 'org-schedule)))
+ (call-interactively 'org-schedule)))
+ ((equal property "DEADLINE")
+ (if (re-search-forward org-deadline-time-regexp end t)
+ (cond
+ ((eq value 'earlier) (org-timestamp-change -1 'day))
+ ((eq value 'later) (org-timestamp-change 1 'day))
+ (t (call-interactively 'org-deadline)))
+ (call-interactively 'org-deadline)))
+ ((member property org-special-properties)
+ (error "The %s property can not yet be set with `org-entry-put'"
+ property))
+ (t ; a non-special property
+ (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21
+ (setq range (org-get-property-block beg end 'force))
+ (goto-char (car range))
+ (if (re-search-forward
+ (org-re-property-keyword property) (cdr range) t)
+ (progn
+ (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char (cdr range))
+ (insert "\n")
+ (backward-char 1)
+ (org-indent-line))
+ (insert ":" property ":")
+ (and value (insert " " value))
+ (org-indent-line)))))
+ (run-hook-with-args 'org-property-changed-functions property value)))
+
+(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
+ "Get all property keys in the current buffer.
+With INCLUDE-SPECIALS, also list the special properties that reflect things
+like tags and TODO state.
+With INCLUDE-DEFAULTS, also include properties that has special meaning
+internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING
+and others.
+With INCLUDE-COLUMNS, also include property names given in COLUMN
+formats in the current buffer."
+ (let (rtn range cfmt s p)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward org-property-start-re nil t)
+ (setq range (org-get-property-block))
+ (goto-char (car range))
+ (while (re-search-forward
+ (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):")
+ (cdr range) t)
+ (add-to-list 'rtn (org-match-string-no-properties 1)))
+ (outline-next-heading))))
+
+ (when include-specials
+ (setq rtn (append org-special-properties rtn)))
+
+ (when include-defaults
+ (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
+ (add-to-list 'rtn org-effort-property))
+
+ (when include-columns
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)"
+ nil t)
+ (setq cfmt (match-string 2) s 0)
+ (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)")
+ cfmt s)
+ (setq s (match-end 0)
+ p (match-string 1 cfmt))
+ (unless (or (equal p "ITEM")
+ (member p org-special-properties))
+ (add-to-list 'rtn (match-string 1 cfmt))))))))
+
+ (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
+
+(defun org-property-values (key)
+ "Return a list of all values of property KEY in the current buffer."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((re (org-re-property key))
+ values)
+ (while (re-search-forward re nil t)
+ (add-to-list 'values (org-trim (match-string 1))))
+ (delete "" values)))))
+
+(defun org-insert-property-drawer ()
+ "Insert a property drawer into the current entry."
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (let ((indent (if org-adapt-indentation
+ (- (match-end 0) (match-beginning 0))
+ 0))
+ (beg (point))
+ (re (concat "^[ \t]*" org-keyword-time-regexp))
+ end hiddenp)
+ (outline-next-heading)
+ (setq end (point))
+ (goto-char beg)
+ (while (re-search-forward re end t))
+ (setq hiddenp (outline-invisible-p))
+ (end-of-line 1)
+ (and (equal (char-after) ?\n) (forward-char 1))
+ (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
+ (if (member (match-string 1) '("CLOCK:" ":END:"))
+ ;; just skip this line
+ (beginning-of-line 2)
+ ;; Drawer start, find the end
+ (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
+ (beginning-of-line 1)))
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n\r")
+ (if (eq (char-before) ?*) (forward-char 1))
+ (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
+ (beginning-of-line 0)
+ (org-indent-to-column indent)
+ (beginning-of-line 2)
+ (org-indent-to-column indent)
+ (beginning-of-line 0)
+ (if hiddenp
+ (save-excursion
+ (org-back-to-heading t)
+ (hide-entry))
+ (org-flag-drawer t))))
+
+(defun org-insert-drawer (&optional arg drawer)
+ "Insert a drawer at point.
+
+Optional argument DRAWER, when non-nil, is a string representing
+drawer's name. Otherwise, the user is prompted for a name.
+
+If a region is active, insert the drawer around that region
+instead.
+
+Point is left between drawer's boundaries."
+ (interactive "P")
+ (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer
+ "LOGBOOK"))
+ ;; SYSTEM-DRAWERS is a list of drawer names that are used
+ ;; internally by Org. They are meant to be inserted
+ ;; automatically.
+ (system-drawers `("CLOCK" ,logbook "PROPERTIES"))
+ ;; Remove system drawers from list. Note: For some reason,
+ ;; `org-completing-read' ignores the predicate while
+ ;; `completing-read' handles it fine.
+ (drawer (if arg "PROPERTIES"
+ (or drawer
+ (completing-read
+ "Drawer: " org-drawers
+ (lambda (d) (not (member d system-drawers))))))))
+ (cond
+ ;; With C-u, fall back on `org-insert-property-drawer'
+ (arg (org-insert-property-drawer))
+ ;; With an active region, insert a drawer at point.
+ ((not (org-region-active-p))
+ (progn
+ (unless (bolp) (insert "\n"))
+ (insert (format ":%s:\n\n:END:\n" drawer))
+ (forward-line -2)))
+ ;; Otherwise, insert the drawer at point
+ (t
+ (let ((rbeg (region-beginning))
+ (rend (copy-marker (region-end))))
+ (unwind-protect
+ (progn
+ (goto-char rbeg)
+ (beginning-of-line)
+ (when (save-excursion
+ (re-search-forward org-outline-regexp-bol rend t))
+ (error "Drawers cannot contain headlines"))
+ ;; Position point at the beginning of the first
+ ;; non-blank line in region. Insert drawer's opening
+ ;; there, then indent it.
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (insert ":" drawer ":\n")
+ (forward-line -1)
+ (indent-for-tab-command)
+ ;; Move point to the beginning of the first blank line
+ ;; after the last non-blank line in region. Insert
+ ;; drawer's closing, then indent it.
+ (goto-char rend)
+ (skip-chars-backward " \r\t\n")
+ (insert "\n:END:")
+ (deactivate-mark t)
+ (indent-for-tab-command)
+ (unless (eolp) (insert "\n")))
+ ;; Clear marker, whatever the outcome of insertion is.
+ (set-marker rend nil)))))))
+
+(defvar org-property-set-functions-alist nil
+ "Property set function alist.
+Each entry should have the following format:
+
+ (PROPERTY . READ-FUNCTION)
+
+The read function will be called with the same argument as
+`org-completing-read'.")
+
+(defun org-set-property-function (property)
+ "Get the function that should be used to set PROPERTY.
+This is computed according to `org-property-set-functions-alist'."
+ (or (cdr (assoc property org-property-set-functions-alist))
+ 'org-completing-read))
+
+(defun org-read-property-value (property)
+ "Read PROPERTY value from user."
+ (let* ((completion-ignore-case t)
+ (allowed (org-property-get-allowed-values nil property 'table))
+ (cur (org-entry-get nil property))
+ (prompt (concat property " value"
+ (if (and cur (string-match "\\S-" cur))
+ (concat " [" cur "]") "") ": "))
+ (set-function (org-set-property-function property))
+ (val (if allowed
+ (funcall set-function prompt allowed nil
+ (not (get-text-property 0 'org-unrestricted
+ (caar allowed))))
+ (let (org-completion-use-ido org-completion-use-iswitchb)
+ (funcall set-function prompt
+ (mapcar 'list (org-property-values property))
+ nil nil "" nil cur)))))
+ (if (equal val "")
+ cur
+ val)))
+
+(defvar org-last-set-property nil)
+(defun org-read-property-name ()
+ "Read a property name."
+ (let* ((completion-ignore-case t)
+ (keys (org-buffer-property-keys nil t t))
+ (default-prop (or (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (and (looking-at "^\\s-*:\\([^:\n]+\\):")
+ (null (string= (match-string 1) "END"))
+ (match-string 1))))
+ org-last-set-property))
+ (property (org-icompleting-read
+ (concat "Property"
+ (if default-prop (concat " [" default-prop "]") "")
+ ": ")
+ (mapcar 'list keys)
+ nil nil nil nil
+ default-prop
+ )))
+ (if (member property keys)
+ property
+ (or (cdr (assoc (downcase property)
+ (mapcar (lambda (x) (cons (downcase x) x))
+ keys)))
+ property))))
+
+(defun org-set-property (property value)
+ "In the current entry, set PROPERTY to VALUE.
+When called interactively, this will prompt for a property name, offering
+completion on existing and default properties. And then it will prompt
+for a value, offering completion either on allowed values (via an inherited
+xxx_ALL property) or on existing values in other instances of this property
+in the current file."
+ (interactive (list nil nil))
+ (let* ((property (or property (org-read-property-name)))
+ (value (or value (org-read-property-value property)))
+ (fn (cdr (assoc property org-properties-postprocess-alist))))
+ (setq org-last-set-property property)
+ ;; Possibly postprocess the inserted value:
+ (when fn (setq value (funcall fn value)))
+ (unless (equal (org-entry-get nil property) value)
+ (org-entry-put nil property value))))
+
+(defun org-delete-property (property)
+ "In the current entry, delete PROPERTY."
+ (interactive
+ (let* ((completion-ignore-case t)
+ (prop (org-icompleting-read "Property: "
+ (org-entry-properties nil 'standard))))
+ (list prop)))
+ (message "Property %s %s" property
+ (if (org-entry-delete nil property)
+ "deleted"
+ "was not present in the entry")))
+
+(defun org-delete-property-globally (property)
+ "Remove PROPERTY globally, from all entries."
+ (interactive
+ (let* ((completion-ignore-case t)
+ (prop (org-icompleting-read
+ "Globally remove property: "
+ (mapcar 'list (org-buffer-property-keys)))))
+ (list prop)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((cnt 0))
+ (while (re-search-forward
+ (org-re-property property)
+ nil t)
+ (setq cnt (1+ cnt))
+ (delete-region (match-beginning 0) (1+ (point-at-eol))))
+ (message "Property \"%s\" removed from %d entries" property cnt)))))
+
+(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
+
+(defun org-compute-property-at-point ()
+ "Compute the property at point.
+This looks for an enclosing column format, extracts the operator and
+then applies it to the property in the column format's scope."
+ (interactive)
+ (unless (org-at-property-p)
+ (error "Not at a property"))
+ (let ((prop (org-match-string-no-properties 2)))
+ (org-columns-get-format-and-top-level)
+ (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
+ (error "No operator defined for property %s" prop))
+ (org-columns-compute prop)))
+
+(defvar org-property-allowed-value-functions nil
+ "Hook for functions supplying allowed values for a specific property.
+The functions must take a single argument, the name of the property, and
+return a flat list of allowed values. If \":ETC\" is one of
+the values, this means that these values are intended as defaults for
+completion, but that other values should be allowed too.
+The functions must return nil if they are not responsible for this
+property.")
+
+(defun org-property-get-allowed-values (pom property &optional table)
+ "Get allowed values for the property PROPERTY.
+When TABLE is non-nil, return an alist that can directly be used for
+completion."
+ (let (vals)
+ (cond
+ ((equal property "TODO")
+ (setq vals (org-with-point-at pom
+ (append org-todo-keywords-1 '("")))))
+ ((equal property "PRIORITY")
+ (let ((n org-lowest-priority))
+ (while (>= n org-highest-priority)
+ (push (char-to-string n) vals)
+ (setq n (1- n)))))
+ ((member property org-special-properties))
+ ((setq vals (run-hook-with-args-until-success
+ 'org-property-allowed-value-functions property)))
+ (t
+ (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
+ (when (and vals (string-match "\\S-" vals))
+ (setq vals (car (read-from-string (concat "(" vals ")"))))
+ (setq vals (mapcar (lambda (x)
+ (cond ((stringp x) x)
+ ((numberp x) (number-to-string x))
+ ((symbolp x) (symbol-name x))
+ (t "???")))
+ vals)))))
+ (when (member ":ETC" vals)
+ (setq vals (remove ":ETC" vals))
+ (org-add-props (car vals) '(org-unrestricted t)))
+ (if table (mapcar 'list vals) vals)))
+
+(defun org-property-previous-allowed-value (&optional previous)
+ "Switch to the next allowed value for this property."
+ (interactive)
+ (org-property-next-allowed-value t))
+
+(defun org-property-next-allowed-value (&optional previous)
+ "Switch to the next allowed value for this property."
+ (interactive)
+ (unless (org-at-property-p)
+ (error "Not at a property"))
+ (let* ((key (match-string 2))
+ (value (match-string 3))
+ (allowed (or (org-property-get-allowed-values (point) key)
+ (and (member value '("[ ]" "[-]" "[X]"))
+ '("[ ]" "[X]"))))
+ nval)
+ (unless allowed
+ (error "Allowed values for this property have not been defined"))
+ (if previous (setq allowed (reverse allowed)))
+ (if (member value allowed)
+ (setq nval (car (cdr (member value allowed)))))
+ (setq nval (or nval (car allowed)))
+ (if (equal nval value)
+ (error "Only one allowed value for this property"))
+ (org-at-property-p)
+ (replace-match (concat " :" key ": " nval) t t)
+ (org-indent-line)
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (run-hook-with-args 'org-property-changed-functions key nval)))
+
+(defun org-find-olp (path &optional this-buffer)
+ "Return a marker pointing to the entry at outline path OLP.
+If anything goes wrong, throw an error.
+You can wrap this call to catch the error like this:
+
+ (condition-case msg
+ (org-mobile-locate-entry (match-string 4))
+ (error (nth 1 msg)))
+
+The return value will then be either a string with the error message,
+or a marker if everything is OK.
+
+If THIS-BUFFER is set, the outline path does not contain a file,
+only headings."
+ (let* ((file (if this-buffer buffer-file-name (pop path)))
+ (buffer (if this-buffer (current-buffer) (find-file-noselect file)))
+ (level 1)
+ (lmin 1)
+ (lmax 1)
+ limit re end found pos heading cnt flevel)
+ (unless buffer (error "File not found :%s" file))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq limit (point-max))
+ (goto-char (point-min))
+ (while (setq heading (pop path))
+ (setq re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (setq cnt 0 pos (point))
+ (while (re-search-forward re end t)
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (if (and (>= level lmin) (<= level lmax))
+ (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
+ (when (= cnt 0) (error "Heading not found on level %d: %s"
+ lmax heading))
+ (when (> cnt 1) (error "Heading not unique on level %d: %s"
+ lmax heading))
+ (goto-char found)
+ (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
+ (setq end (save-excursion (org-end-of-subtree t t))))
+ (when (org-at-heading-p)
+ (move-marker (make-marker) (point))))))))
+
+(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
+ "Find node HEADING in BUFFER.
+Return a marker to the heading if it was found, or nil if not.
+If POS-ONLY is set, return just the position instead of a marker.
+
+The heading text must match exact, but it may have a TODO keyword,
+a priority cookie and tags in the standard locations."
+ (with-current-buffer (or buffer (current-buffer))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let (case-fold-search)
+ (if (re-search-forward
+ (format org-complex-heading-regexp-format
+ (regexp-quote heading)) nil t)
+ (if pos-only
+ (match-beginning 0)
+ (move-marker (make-marker) (match-beginning 0)))))))))
+
+(defun org-find-exact-heading-in-directory (heading &optional dir)
+ "Find Org node headline HEADING in all .org files in directory DIR.
+When the target headline is found, return a marker to this location."
+ (let ((files (directory-files (or dir default-directory)
+ nil "\\`[^.#].*\\.org\\'"))
+ file visiting m buffer)
+ (catch 'found
+ (while (setq file (pop files))
+ (message "trying %s" file)
+ (setq visiting (org-find-base-buffer-visiting file))
+ (setq buffer (or visiting (find-file-noselect file)))
+ (setq m (org-find-exact-headline-in-buffer
+ heading buffer))
+ (when (and (not m) (not visiting)) (kill-buffer buffer))
+ (and m (throw 'found m))))))
+
+(defun org-find-entry-with-id (ident)
+ "Locate the entry that contains the ID property with exact value IDENT.
+IDENT can be a string, a symbol or a number, this function will search for
+the string representation of it.
+Return the position where this entry starts, or nil if there is no such entry."
+ (interactive "sID: ")
+ (let ((id (cond
+ ((stringp ident) ident)
+ ((symbol-name ident) (symbol-name ident))
+ ((numberp ident) (number-to-string ident))
+ (t (error "IDENT %s must be a string, symbol or number" ident))))
+ (case-fold-search nil))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
+ nil t)
+ (org-back-to-heading t)
+ (point))))))
+
+;;;; Timestamps
+
+(defvar org-last-changed-timestamp nil)
+(defvar org-last-inserted-timestamp nil
+ "The last time stamp inserted with `org-insert-time-stamp'.")
+(defvar org-time-was-given) ; dynamically scoped parameter
+(defvar org-end-time-was-given) ; dynamically scoped parameter
+(defvar org-ts-what) ; dynamically scoped parameter
+
+(defun org-time-stamp (arg &optional inactive)
+ "Prompt for a date/time and insert a time stamp.
+If the user specifies a time like HH:MM or if this command is
+called with at least one prefix argument, the time stamp contains
+the date and the time. Otherwise, only the date is be included.
+
+All parts of a date not specified by the user is filled in from
+the current date/time. So if you just press return without
+typing anything, the time stamp will represent the current
+date/time.
+
+If there is already a timestamp at the cursor, it will be
+modified.
+
+With two universal prefix arguments, insert an active timestamp
+with the current time without prompting the user."
+ (interactive "P")
+ (let* ((ts nil)
+ (default-time
+ ;; Default time is either today, or, when entering a range,
+ ;; the range start.
+ (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
+ (save-excursion
+ (re-search-backward
+ (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
+ (- (point) 20) t)))
+ (apply 'encode-time (org-parse-time-string (match-string 1)))
+ (current-time)))
+ (default-input (and ts (org-get-compact-tod ts)))
+ (repeater (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (when (re-search-forward
+ "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
+ (save-excursion (progn (end-of-line) (point))) t)
+ (match-string 0)))))
+ org-time-was-given org-end-time-was-given time)
+ (cond
+ ((and (org-at-timestamp-p t)
+ (memq last-command '(org-time-stamp org-time-stamp-inactive))
+ (memq this-command '(org-time-stamp org-time-stamp-inactive)))
+ (insert "--")
+ (setq time (let ((this-command this-command))
+ (org-read-date arg 'totime nil nil
+ default-time default-input inactive)))
+ (org-insert-time-stamp time (or org-time-was-given arg) inactive))
+ ((org-at-timestamp-p t)
+ (setq time (let ((this-command this-command))
+ (org-read-date arg 'totime nil nil default-time default-input inactive)))
+ (when (org-at-timestamp-p t) ; just to get the match data
+ ; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
+ (replace-match "")
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp
+ time (or org-time-was-given arg)
+ inactive nil nil (list org-end-time-was-given)))
+ (when repeater (goto-char (1- (point))) (insert " " repeater)
+ (setq org-last-changed-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater ">"))))
+ (message "Timestamp updated"))
+ ((equal arg '(16))
+ (org-insert-time-stamp (current-time) t))
+ (t
+ (setq time (let ((this-command this-command))
+ (org-read-date arg 'totime nil nil default-time default-input inactive)))
+ (org-insert-time-stamp time (or org-time-was-given arg) inactive
+ nil nil (list org-end-time-was-given))))))
+
+;; FIXME: can we use this for something else, like computing time differences?
+(defun org-get-compact-tod (s)
+ (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
+ (let* ((t1 (match-string 1 s))
+ (h1 (string-to-number (match-string 2 s)))
+ (m1 (string-to-number (match-string 3 s)))
+ (t2 (and (match-end 4) (match-string 5 s)))
+ (h2 (and t2 (string-to-number (match-string 6 s))))
+ (m2 (and t2 (string-to-number (match-string 7 s))))
+ dh dm)
+ (if (not t2)
+ t1
+ (setq dh (- h2 h1) dm (- m2 m1))
+ (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
+ (concat t1 "+" (number-to-string dh)
+ (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
+
+(defun org-time-stamp-inactive (&optional arg)
+ "Insert an inactive time stamp.
+An inactive time stamp is enclosed in square brackets instead of angle
+brackets. It is inactive in the sense that it does not trigger agenda entries,
+does not link to the calendar and cannot be changed with the S-cursor keys.
+So these are more for recording a certain time/date."
+ (interactive "P")
+ (org-time-stamp arg 'inactive))
+
+(defvar org-date-ovl (make-overlay 1 1))
+(overlay-put org-date-ovl 'face 'org-date-selected)
+(org-detach-overlay org-date-ovl)
+
+(defvar org-ans1) ; dynamically scoped parameter
+(defvar org-ans2) ; dynamically scoped parameter
+
+(defvar org-plain-time-of-day-regexp) ; defined below
+
+(defvar org-overriding-default-time nil) ; dynamically scoped
+(defvar org-read-date-overlay nil)
+(defvar org-dcst nil) ; dynamically scoped
+(defvar org-read-date-history nil)
+(defvar org-read-date-final-answer nil)
+(defvar org-read-date-analyze-futurep nil)
+(defvar org-read-date-analyze-forced-year nil)
+(defvar org-read-date-inactive)
+
+(defun org-read-date (&optional org-with-time to-time from-string prompt
+ default-time default-input inactive)
+ "Read a date, possibly a time, and make things smooth for the user.
+The prompt will suggest to enter an ISO date, but you can also enter anything
+which will at least partially be understood by `parse-time-string'.
+Unrecognized parts of the date will default to the current day, month, year,
+hour and minute. If this command is called to replace a timestamp at point,
+or to enter the second timestamp of a range, the default time is taken
+from the existing stamp. Furthermore, the command prefers the future,
+so if you are giving a date where the year is not given, and the day-month
+combination is already past in the current year, it will assume you
+mean next year. For details, see the manual. A few examples:
+
+ 3-2-5 --> 2003-02-05
+ feb 15 --> currentyear-02-15
+ 2/15 --> currentyear-02-15
+ sep 12 9 --> 2009-09-12
+ 12:45 --> today 12:45
+ 22 sept 0:34 --> currentyear-09-22 0:34
+ 12 --> currentyear-currentmonth-12
+ Fri --> nearest Friday (today or later)
+ etc.
+
+Furthermore you can specify a relative date by giving, as the *first* thing
+in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate
+change in days weeks, months, years.
+With a single plus or minus, the date is relative to today. With a double
+plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
+ +4d --> four days from today
+ +4 --> same as above
+ +2w --> two weeks from today
+ ++5 --> five days from default date
+
+The function understands only English month and weekday abbreviations.
+
+While prompting, a calendar is popped up - you can also select the
+date with the mouse (button 1). The calendar shows a period of three
+months. To scroll it to other months, use the keys `>' and `<'.
+If you don't like the calendar, turn it off with
+ \(setq org-read-date-popup-calendar nil)
+
+With optional argument TO-TIME, the date will immediately be converted
+to an internal time.
+With an optional argument ORG-WITH-TIME, the prompt will suggest to
+also insert a time. Note that when ORG-WITH-TIME is not set, you can
+still enter a time, and this function will inform the calling routine
+about this change. The calling routine may then choose to change the
+format used to insert the time stamp into the buffer to include the time.
+With optional argument FROM-STRING, read from this string instead from
+the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
+the time/date that is used for everything that is not specified by the
+user."
+ (require 'parse-time)
+ (let* ((org-time-stamp-rounding-minutes
+ (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
+ (org-dcst org-display-custom-times)
+ (ct (org-current-time))
+ (org-def (or org-overriding-default-time default-time ct))
+ (org-defdecode (decode-time org-def))
+ (dummy (progn
+ (when (< (nth 2 org-defdecode) org-extend-today-until)
+ (setcar (nthcdr 2 org-defdecode) -1)
+ (setcar (nthcdr 1 org-defdecode) 59)
+ (setq org-def (apply 'encode-time org-defdecode)
+ org-defdecode (decode-time org-def)))))
+ (calendar-frame-setup nil)
+ (calendar-setup nil)
+ (calendar-move-hook nil)
+ (calendar-view-diary-initially-flag nil)
+ (calendar-view-holidays-initially-flag nil)
+ (timestr (format-time-string
+ (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
+ (prompt (concat (if prompt (concat prompt " ") "")
+ (format "Date+time [%s]: " timestr)))
+ ans (org-ans0 "") org-ans1 org-ans2 final)
+
+ (cond
+ (from-string (setq ans from-string))
+ (org-read-date-popup-calendar
+ (save-excursion
+ (save-window-excursion
+ (calendar)
+ (org-eval-in-calendar '(setq cursor-type nil) t)
+ (unwind-protect
+ (progn
+ (calendar-forward-day (- (time-to-days org-def)
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))
+ (org-eval-in-calendar nil t)
+ (let* ((old-map (current-local-map))
+ (map (copy-keymap calendar-mode-map))
+ (minibuffer-local-map (copy-keymap minibuffer-local-map)))
+ (org-defkey map (kbd "RET") 'org-calendar-select)
+ (org-defkey map [mouse-1] 'org-calendar-select-mouse)
+ (org-defkey map [mouse-2] 'org-calendar-select-mouse)
+ (org-defkey minibuffer-local-map [(meta shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey minibuffer-local-map [(meta shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey minibuffer-local-map [(meta shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey minibuffer-local-map [(meta shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey minibuffer-local-map [?\e (shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey minibuffer-local-map [?\e (shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey minibuffer-local-map [?\e (shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey minibuffer-local-map [?\e (shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey minibuffer-local-map [(shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-week 1))))
+ (org-defkey minibuffer-local-map [(shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-week 1))))
+ (org-defkey minibuffer-local-map [(shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-day 1))))
+ (org-defkey minibuffer-local-map [(shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-day 1))))
+ (org-defkey minibuffer-local-map ">"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-left 1))))
+ (org-defkey minibuffer-local-map "<"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (org-defkey minibuffer-local-map "\C-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-left-three-months 1))))
+ (org-defkey minibuffer-local-map "\M-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-right-three-months 1))))
+ (run-hooks 'org-read-date-minibuffer-setup-hook)
+ (unwind-protect
+ (progn
+ (use-local-map map)
+ (setq org-read-date-inactive inactive)
+ (add-hook 'post-command-hook 'org-read-date-display)
+ (setq org-ans0 (read-string prompt default-input
+ 'org-read-date-history nil))
+ ;; org-ans0: from prompt
+ ;; org-ans1: from mouse click
+ ;; org-ans2: from calendar motion
+ (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
+ (remove-hook 'post-command-hook 'org-read-date-display)
+ (use-local-map old-map)
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil)))))
+ (bury-buffer "*Calendar*")))))
+
+ (t ; Naked prompt only
+ (unwind-protect
+ (setq ans (read-string prompt default-input
+ 'org-read-date-history timestr))
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil)))))
+
+ (setq final (org-read-date-analyze ans org-def org-defdecode))
+
+ (when org-read-date-analyze-forced-year
+ (message "Year was forced into %s"
+ (if org-read-date-force-compatible-dates
+ "compatible range (1970-2037)"
+ "range representable on this machine"))
+ (ding))
+
+ ;; One round trip to get rid of 34th of August and stuff like that....
+ (setq final (decode-time (apply 'encode-time final)))
+
+ (setq org-read-date-final-answer ans)
+
+ (if to-time
+ (apply 'encode-time final)
+ (if (and (boundp 'org-time-was-given) org-time-was-given)
+ (format "%04d-%02d-%02d %02d:%02d"
+ (nth 5 final) (nth 4 final) (nth 3 final)
+ (nth 2 final) (nth 1 final))
+ (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
+
+(defvar org-def)
+(defvar org-defdecode)
+(defvar org-with-time)
+(defun org-read-date-display ()
+ "Display the current date prompt interpretation in the minibuffer."
+ (when org-read-date-display-live
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay))
+ (when (minibufferp (current-buffer))
+ (save-excursion
+ (end-of-line 1)
+ (while (not (equal (buffer-substring
+ (max (point-min) (- (point) 4)) (point))
+ " "))
+ (insert " ")))
+ (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
+ " " (or org-ans1 org-ans2)))
+ (org-end-time-was-given nil)
+ (f (org-read-date-analyze ans org-def org-defdecode))
+ (fmts (if org-dcst
+ org-time-stamp-custom-formats
+ org-time-stamp-formats))
+ (fmt (if (or org-with-time
+ (and (boundp 'org-time-was-given) org-time-was-given))
+ (cdr fmts)
+ (car fmts)))
+ (txt (format-time-string fmt (apply 'encode-time f)))
+ (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt))
+ (txt (concat "=> " txt)))
+ (when (and org-end-time-was-given
+ (string-match org-plain-time-of-day-regexp txt))
+ (setq txt (concat (substring txt 0 (match-end 0)) "-"
+ org-end-time-was-given
+ (substring txt (match-end 0)))))
+ (when org-read-date-analyze-futurep
+ (setq txt (concat txt " (=>F)")))
+ (setq org-read-date-overlay
+ (make-overlay (1- (point-at-eol)) (point-at-eol)))
+ (org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
+
+(defun org-read-date-analyze (ans org-def org-defdecode)
+ "Analyze the combined answer of the date prompt."
+ ;; FIXME: cleanup and comment
+ (let ((nowdecode (decode-time (current-time)))
+ delta deltan deltaw deltadef year month day
+ hour minute second wday pm h2 m2 tl wday1
+ iso-year iso-weekday iso-week iso-year iso-date futurep kill-year)
+ (setq org-read-date-analyze-futurep nil
+ org-read-date-analyze-forced-year nil)
+ (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
+ (setq ans "+0"))
+
+ (when (setq delta (org-read-date-get-relative ans (current-time) org-def))
+ (setq ans (replace-match "" t t ans)
+ deltan (car delta)
+ deltaw (nth 1 delta)
+ deltadef (nth 2 delta)))
+
+ ;; Check if there is an iso week date in there. If yes, store the
+ ;; info and postpone interpreting it until the rest of the parsing
+ ;; is done.
+ (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
+ (setq iso-year (if (match-end 1)
+ (org-small-year-to-year
+ (string-to-number (match-string 1 ans))))
+ iso-weekday (if (match-end 3)
+ (string-to-number (match-string 3 ans)))
+ iso-week (string-to-number (match-string 2 ans)))
+ (setq ans (replace-match "" t t ans)))
+
+ ;; Help matching ISO dates with single digit month or day, like 2006-8-11.
+ (when (string-match
+ "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
+ (setq year (if (match-end 2)
+ (string-to-number (match-string 2 ans))
+ (progn (setq kill-year t)
+ (string-to-number (format-time-string "%Y"))))
+ month (string-to-number (match-string 3 ans))
+ day (string-to-number (match-string 4 ans)))
+ (if (< year 100) (setq year (+ 2000 year)))
+ (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
+ t nil ans)))
+
+ ;; Help matching dotted european dates
+ (when (string-match
+ "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\. ?\\([1-9][0-9][0-9][0-9]\\)?" ans)
+ (setq year (if (match-end 3)
+ (string-to-number (match-string 3 ans))
+ (progn (setq kill-year t)
+ (string-to-number (format-time-string "%Y"))))
+ day (string-to-number (match-string 1 ans))
+ month (string-to-number (match-string 2 ans))
+ ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
+ t nil ans)))
+
+ ;; Help matching american dates, like 5/30 or 5/30/7
+ (when (string-match
+ "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
+ (setq year (if (match-end 4)
+ (string-to-number (match-string 4 ans))
+ (progn (setq kill-year t)
+ (string-to-number (format-time-string "%Y"))))
+ month (string-to-number (match-string 1 ans))
+ day (string-to-number (match-string 2 ans)))
+ (if (< year 100) (setq year (+ 2000 year)))
+ (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
+ t nil ans)))
+ ;; Help matching am/pm times, because `parse-time-string' does not do that.
+ ;; If there is a time with am/pm, and *no* time without it, we convert
+ ;; so that matching will be successful.
+ (loop for i from 1 to 2 do ; twice, for end time as well
+ (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
+ (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
+ (setq hour (string-to-number (match-string 1 ans))
+ minute (if (match-end 3)
+ (string-to-number (match-string 3 ans))
+ 0)
+ pm (equal ?p
+ (string-to-char (downcase (match-string 4 ans)))))
+ (if (and (= hour 12) (not pm))
+ (setq hour 0)
+ (if (and pm (< hour 12)) (setq hour (+ 12 hour))))
+ (setq ans (replace-match (format "%02d:%02d" hour minute)
+ t t ans))))
+
+ ;; Check if a time range is given as a duration
+ (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
+ (setq hour (string-to-number (match-string 1 ans))
+ h2 (+ hour (string-to-number (match-string 3 ans)))
+ minute (string-to-number (match-string 2 ans))
+ m2 (+ minute (if (match-end 5) (string-to-number
+ (match-string 5 ans))0)))
+ (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
+ (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
+ t t ans)))
+
+ ;; Check if there is a time range
+ (when (boundp 'org-end-time-was-given)
+ (setq org-time-was-given nil)
+ (when (and (string-match org-plain-time-of-day-regexp ans)
+ (match-end 8))
+ (setq org-end-time-was-given (match-string 8 ans))
+ (setq ans (concat (substring ans 0 (match-beginning 7))
+ (substring ans (match-end 7))))))
+
+ (setq tl (parse-time-string ans)
+ day (or (nth 3 tl) (nth 3 org-defdecode))
+ month (or (nth 4 tl)
+ (if (and org-read-date-prefer-future
+ (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
+ (prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
+ (nth 4 org-defdecode)))
+ year (or (and (not kill-year) (nth 5 tl))
+ (if (and org-read-date-prefer-future
+ (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
+ (prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
+ (nth 5 org-defdecode)))
+ hour (or (nth 2 tl) (nth 2 org-defdecode))
+ minute (or (nth 1 tl) (nth 1 org-defdecode))
+ second (or (nth 0 tl) 0)
+ wday (nth 6 tl))
+
+ (when (and (eq org-read-date-prefer-future 'time)
+ (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
+ (equal day (nth 3 nowdecode))
+ (equal month (nth 4 nowdecode))
+ (equal year (nth 5 nowdecode))
+ (nth 2 tl)
+ (or (< (nth 2 tl) (nth 2 nowdecode))
+ (and (= (nth 2 tl) (nth 2 nowdecode))
+ (nth 1 tl)
+ (< (nth 1 tl) (nth 1 nowdecode)))))
+ (setq day (1+ day)
+ futurep t))
+
+ ;; Special date definitions below
+ (cond
+ (iso-week
+ ;; There was an iso week
+ (require 'cal-iso)
+ (setq futurep nil)
+ (setq year (or iso-year year)
+ day (or iso-weekday wday 1)
+ wday nil ; to make sure that the trigger below does not match
+ iso-date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso
+ (list iso-week day year))))
+ ; FIXME: Should we also push ISO weeks into the future?
+ ; (when (and org-read-date-prefer-future
+ ; (not iso-year)
+ ; (< (calendar-absolute-from-gregorian iso-date)
+ ; (time-to-days (current-time))))
+ ; (setq year (1+ year)
+ ; iso-date (calendar-gregorian-from-absolute
+ ; (calendar-absolute-from-iso
+ ; (list iso-week day year)))))
+ (setq month (car iso-date)
+ year (nth 2 iso-date)
+ day (nth 1 iso-date)))
+ (deltan
+ (setq futurep nil)
+ (unless deltadef
+ (let ((now (decode-time (current-time))))
+ (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
+ (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
+ ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
+ ((equal deltaw "m") (setq month (+ month deltan)))
+ ((equal deltaw "y") (setq year (+ year deltan)))))
+ ((and wday (not (nth 3 tl)))
+ ;; Weekday was given, but no day, so pick that day in the week
+ ;; on or after the derived date.
+ (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
+ (unless (equal wday wday1)
+ (setq day (+ day (% (- wday wday1 -7) 7))))))
+ (if (and (boundp 'org-time-was-given)
+ (nth 2 tl))
+ (setq org-time-was-given t))
+ (if (< year 100) (setq year (+ 2000 year)))
+ ;; Check of the date is representable
+ (if org-read-date-force-compatible-dates
+ (progn
+ (if (< year 1970)
+ (setq year 1970 org-read-date-analyze-forced-year t))
+ (if (> year 2037)
+ (setq year 2037 org-read-date-analyze-forced-year t)))
+ (condition-case nil
+ (ignore (encode-time second minute hour day month year))
+ (error
+ (setq year (nth 5 org-defdecode))
+ (setq org-read-date-analyze-forced-year t))))
+ (setq org-read-date-analyze-futurep futurep)
+ (list second minute hour day month year)))
+
+(defvar parse-time-weekdays)
+(defun org-read-date-get-relative (s today default)
+ "Check string S for special relative date string.
+TODAY and DEFAULT are internal times, for today and for a default.
+Return shift list (N what def-flag)
+WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
+N is the number of WHATs to shift.
+DEF-FLAG is t when a double ++ or -- indicates shift relative to
+ the DEFAULT date rather than TODAY."
+ (require 'parse-time)
+ (when (and
+ (string-match
+ (concat
+ "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
+ "\\([0-9]+\\)?"
+ "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
+ "\\([ \t]\\|$\\)") s)
+ (or (> (match-end 1) (match-beginning 1)) (match-end 4)))
+ (let* ((dir (if (> (match-end 1) (match-beginning 1))
+ (string-to-char (substring (match-string 1 s) -1))
+ ?+))
+ (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
+ (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
+ (what (if (match-end 3) (match-string 3 s) "d"))
+ (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
+ (date (if rel default today))
+ (wday (nth 6 (decode-time date)))
+ delta)
+ (if wday1
+ (progn
+ (setq delta (mod (+ 7 (- wday1 wday)) 7))
+ (if (= dir ?-) (setq delta (- delta 7)))
+ (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
+ (list delta "d" rel))
+ (list (* n (if (= dir ?-) -1 1)) what rel)))))
+
+(defun org-order-calendar-date-args (arg1 arg2 arg3)
+ "Turn a user-specified date into the internal representation.
+The internal representation needed by the calendar is (month day year).
+This is a wrapper to handle the brain-dead convention in calendar that
+user function argument order change dependent on argument order."
+ (if (boundp 'calendar-date-style)
+ (cond
+ ((eq calendar-date-style 'american)
+ (list arg1 arg2 arg3))
+ ((eq calendar-date-style 'european)
+ (list arg2 arg1 arg3))
+ ((eq calendar-date-style 'iso)
+ (list arg2 arg3 arg1)))
+ (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1
+ (if (org-bound-and-true-p european-calendar-style)
+ (list arg2 arg1 arg3)
+ (list arg1 arg2 arg3)))))
+
+(defun org-eval-in-calendar (form &optional keepdate)
+ "Eval FORM in the calendar window and return to current window.
+When KEEPDATE is non-nil, update `org-ans2' from the cursor date,
+otherwise stick to the current value of `org-ans2'."
+ (let ((sf (selected-frame))
+ (sw (selected-window)))
+ (select-window (get-buffer-window "*Calendar*" t))
+ (eval form)
+ (when (and (not keepdate) (calendar-cursor-to-date))
+ (let* ((date (calendar-cursor-to-date))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
+ (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
+ (select-window sw)
+ (org-select-frame-set-input-focus sf)))
+
+(defun org-calendar-select ()
+ "Return to `org-read-date' with the date currently selected.
+This is used by `org-read-date' in a temporary keymap for the calendar buffer."
+ (interactive)
+ (when (calendar-cursor-to-date)
+ (let* ((date (calendar-cursor-to-date))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
+ (if (active-minibuffer-window) (exit-minibuffer))))
+
+(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
+ "Insert a date stamp for the date given by the internal TIME.
+WITH-HM means use the stamp format that includes the time of the day.
+INACTIVE means use square brackets instead of angular ones, so that the
+stamp will not contribute to the agenda.
+PRE and POST are optional strings to be inserted before and after the
+stamp.
+The command returns the inserted time stamp."
+ (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
+ stamp)
+ (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (insert-before-markers (or pre ""))
+ (when (listp extra)
+ (setq extra (car extra))
+ (if (and (stringp extra)
+ (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
+ (setq extra (format "-%02d:%02d"
+ (string-to-number (match-string 1 extra))
+ (string-to-number (match-string 2 extra))))
+ (setq extra nil)))
+ (when extra
+ (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
+ (insert-before-markers (setq stamp (format-time-string fmt time)))
+ (insert-before-markers (or post ""))
+ (setq org-last-inserted-timestamp stamp)))
+
+(defun org-toggle-time-stamp-overlays ()
+ "Toggle the use of custom time stamp formats."
+ (interactive)
+ (setq org-display-custom-times (not org-display-custom-times))
+ (unless org-display-custom-times
+ (let ((p (point-min)) (bmp (buffer-modified-p)))
+ (while (setq p (next-single-property-change p 'display))
+ (if (and (get-text-property p 'display)
+ (eq (get-text-property p 'face) 'org-date))
+ (remove-text-properties
+ p (setq p (next-single-property-change p 'display))
+ '(display t))))
+ (set-buffer-modified-p bmp)))
+ (if (featurep 'xemacs)
+ (remove-text-properties (point-min) (point-max) '(end-glyph t)))
+ (org-restart-font-lock)
+ (setq org-table-may-need-update t)
+ (if org-display-custom-times
+ (message "Time stamps are overlaid with custom format")
+ (message "Time stamp overlays removed")))
+
+(defun org-display-custom-time (beg end)
+ "Overlay modified time stamp format over timestamp between BEG and END."
+ (let* ((ts (buffer-substring beg end))
+ t1 w1 with-hm tf time str w2 (off 0))
+ (save-match-data
+ (setq t1 (org-parse-time-string ts t))
+ (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
+ (setq off (- (match-end 0) (match-beginning 0)))))
+ (setq end (- end off))
+ (setq w1 (- end beg)
+ with-hm (and (nth 1 t1) (nth 2 t1))
+ tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
+ time (org-fix-decoded-time t1)
+ str (org-add-props
+ (format-time-string
+ (substring tf 1 -1) (apply 'encode-time time))
+ nil 'mouse-face 'highlight)
+ w2 (length str))
+ (if (not (= w2 w1))
+ (add-text-properties (1+ beg) (+ 2 beg)
+ (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
+ (if (featurep 'xemacs)
+ (progn
+ (put-text-property beg end 'invisible t)
+ (put-text-property beg end 'end-glyph (make-glyph str)))
+ (put-text-property beg end 'display str))))
+
+(defun org-translate-time (string)
+ "Translate all timestamps in STRING to custom format.
+But do this only if the variable `org-display-custom-times' is set."
+ (when org-display-custom-times
+ (save-match-data
+ (let* ((start 0)
+ (re org-ts-regexp-both)
+ t1 with-hm inactive tf time str beg end)
+ (while (setq start (string-match re string start))
+ (setq beg (match-beginning 0)
+ end (match-end 0)
+ t1 (save-match-data
+ (org-parse-time-string (substring string beg end) t))
+ with-hm (and (nth 1 t1) (nth 2 t1))
+ inactive (equal (substring string beg (1+ beg)) "[")
+ tf (funcall (if with-hm 'cdr 'car)
+ org-time-stamp-custom-formats)
+ time (org-fix-decoded-time t1)
+ str (format-time-string
+ (concat
+ (if inactive "[" "<") (substring tf 1 -1)
+ (if inactive "]" ">"))
+ (apply 'encode-time time))
+ string (replace-match str t t string)
+ start (+ start (length str)))))))
+ string)
+
+(defun org-fix-decoded-time (time)
+ "Set 0 instead of nil for the first 6 elements of time.
+Don't touch the rest."
+ (let ((n 0))
+ (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
+
+(defun org-days-to-time (timestamp-string)
+ "Difference between TIMESTAMP-STRING and now in days."
+ (- (time-to-days (org-time-string-to-time timestamp-string))
+ (time-to-days (current-time))))
+
+(defun org-deadline-close (timestamp-string &optional ndays)
+ "Is the time in TIMESTAMP-STRING close to the current date?"
+ (setq ndays (or ndays (org-get-wdays timestamp-string)))
+ (and (< (org-days-to-time timestamp-string) ndays)
+ (not (org-entry-is-done-p))))
+
+(defun org-get-wdays (ts)
+ "Get the deadline lead time appropriate for timestring TS."
+ (cond
+ ((<= org-deadline-warning-days 0)
+ ;; 0 or negative, enforce this value no matter what
+ (- org-deadline-warning-days))
+ ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
+ ;; lead time is specified.
+ (floor (* (string-to-number (match-string 1 ts))
+ (cdr (assoc (match-string 2 ts)
+ '(("d" . 1) ("w" . 7)
+ ("m" . 30.4) ("y" . 365.25)))))))
+ ;; go for the default.
+ (t org-deadline-warning-days)))
+
+(defun org-calendar-select-mouse (ev)
+ "Return to `org-read-date' with the date currently selected.
+This is used by `org-read-date' in a temporary keymap for the calendar buffer."
+ (interactive "e")
+ (mouse-set-point ev)
+ (when (calendar-cursor-to-date)
+ (let* ((date (calendar-cursor-to-date))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
+ (if (active-minibuffer-window) (exit-minibuffer))))
+
+(defun org-check-deadlines (ndays)
+ "Check if there are any deadlines due or past due.
+A deadline is considered due if it happens within `org-deadline-warning-days'
+days from today's date. If the deadline appears in an entry marked DONE,
+it is not shown. The prefix arg NDAYS can be used to test that many
+days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
+ (interactive "P")
+ (let* ((org-warn-days
+ (cond
+ ((equal ndays '(4)) 100000)
+ (ndays (prefix-numeric-value ndays))
+ (t (abs org-deadline-warning-days))))
+ (case-fold-search nil)
+ (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
+ (callback
+ (lambda () (org-deadline-close (match-string 1) org-warn-days))))
+
+ (message "%d deadlines past-due or due within %d days"
+ (org-occur regexp nil callback)
+ org-warn-days)))
+
+(defsubst org-re-timestamp (type)
+ "Return a regexp for timestamp TYPE.
+Allowed values for TYPE are:
+
+ all: all timestamps
+ active: only active timestamps (<...>)
+ inactive: only inactive timestamps ([...])
+ scheduled: only scheduled timestamps
+ deadline: only deadline timestamps
+
+When TYPE is nil, fall back on returning a regexp that matches
+both scheduled and deadline timestamps."
+ (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
+ ((eq type 'active) org-ts-regexp)
+ ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")
+ ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
+ ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
+ ((eq type 'scheduled-or-deadline)
+ (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
+
+(defun org-check-before-date (date)
+ "Check if there are deadlines or scheduled entries before DATE."
+ (interactive (list (org-read-date)))
+ (let ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (callback
+ (lambda () (time-less-p
+ (org-time-string-to-time (match-string 1))
+ (org-time-string-to-time date)))))
+ (message "%d entries before %s"
+ (org-occur regexp nil callback) date)))
+
+(defun org-check-after-date (date)
+ "Check if there are deadlines or scheduled entries after DATE."
+ (interactive (list (org-read-date)))
+ (let ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (callback
+ (lambda () (not
+ (time-less-p
+ (org-time-string-to-time (match-string 1))
+ (org-time-string-to-time date))))))
+ (message "%d entries after %s"
+ (org-occur regexp nil callback) date)))
+
+(defun org-check-dates-range (start-date end-date)
+ "Check for deadlines/scheduled entries between START-DATE and END-DATE."
+ (interactive (list (org-read-date nil nil nil "Range starts")
+ (org-read-date nil nil nil "Range end")))
+ (let ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (callback
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date)))))))
+ (message "%d entries between %s and %s"
+ (org-occur regexp nil callback) start-date end-date)))
+
+(defun org-evaluate-time-range (&optional to-buffer)
+ "Evaluate a time range by computing the difference between start and end.
+Normally the result is just printed in the echo area, but with prefix arg
+TO-BUFFER, the result is inserted just after the date stamp into the buffer.
+If the time range is actually in a table, the result is inserted into the
+next column.
+For time difference computation, a year is assumed to be exactly 365
+days in order to avoid rounding problems."
+ (interactive "P")
+ (or
+ (org-clock-update-time-maybe)
+ (save-excursion
+ (unless (org-at-date-range-p t)
+ (goto-char (point-at-bol))
+ (re-search-forward org-tr-regexp-both (point-at-eol) t))
+ (if (not (org-at-date-range-p t))
+ (error "Not at a time-stamp range, and none found in current line")))
+ (let* ((ts1 (match-string 1))
+ (ts2 (match-string 2))
+ (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
+ (match-end (match-end 0))
+ (time1 (org-time-string-to-time ts1))
+ (time2 (org-time-string-to-time ts2))
+ (t1 (org-float-time time1))
+ (t2 (org-float-time time2))
+ (diff (abs (- t2 t1)))
+ (negative (< (- t2 t1) 0))
+ ;; (ys (floor (* 365 24 60 60)))
+ (ds (* 24 60 60))
+ (hs (* 60 60))
+ (fy "%dy %dd %02d:%02d")
+ (fy1 "%dy %dd")
+ (fd "%dd %02d:%02d")
+ (fd1 "%dd")
+ (fh "%02d:%02d")
+ y d h m align)
+ (if havetime
+ (setq ; y (floor (/ diff ys)) diff (mod diff ys)
+ y 0
+ d (floor (/ diff ds)) diff (mod diff ds)
+ h (floor (/ diff hs)) diff (mod diff hs)
+ m (floor (/ diff 60)))
+ (setq ; y (floor (/ diff ys)) diff (mod diff ys)
+ y 0
+ d (floor (+ (/ diff ds) 0.5))
+ h 0 m 0))
+ (if (not to-buffer)
+ (message "%s" (org-make-tdiff-string y d h m))
+ (if (org-at-table-p)
+ (progn
+ (goto-char match-end)
+ (setq align t)
+ (and (looking-at " *|") (goto-char (match-end 0))))
+ (goto-char match-end))
+ (if (looking-at
+ "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
+ (replace-match ""))
+ (if negative (insert " -"))
+ (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
+ (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
+ (insert " " (format fh h m))))
+ (if align (org-table-align))
+ (message "Time difference inserted")))))
+
+(defun org-make-tdiff-string (y d h m)
+ (let ((fmt "")
+ (l nil))
+ (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")
+ l (push y l)))
+ (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")
+ l (push d l)))
+ (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")
+ l (push h l)))
+ (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")
+ l (push m l)))
+ (apply 'format fmt (nreverse l))))
+
+(defun org-time-string-to-time (s &optional buffer pos)
+ "Convert a timestamp string into internal time."
+ (condition-case errdata
+ (apply 'encode-time (org-parse-time-string s))
+ (error (error "Bad timestamp `%s'%s\nError was: %s"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (cdr errdata)))))
+
+(defun org-time-string-to-seconds (s)
+ "Convert a timestamp string to a number of seconds."
+ (org-float-time (org-time-string-to-time s)))
+
+(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
+ "Convert a time stamp to an absolute day number.
+If there is a specifier for a cyclic time stamp, get the closest date to
+DAYNR.
+PREFER and SHOW-ALL are passed through to `org-closest-date'.
+The variable date is bound by the calendar when this is called."
+ (cond
+ ((and daynr (string-match "\\`%%\\((.*)\\)" s))
+ (if (org-diary-sexp-entry (match-string 1 s) "" date)
+ daynr
+ (+ daynr 1000)))
+ ((and daynr (string-match "\\+[0-9]+[hdwmy]" s))
+ (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
+ (time-to-days (current-time))) (match-string 0 s)
+ prefer show-all))
+ (t (time-to-days
+ (condition-case errdata
+ (apply 'encode-time (org-parse-time-string s))
+ (error (error "Bad timestamp `%s'%s\nError was: %s"
+ s (if (not (and buffer pos))
+ ""
+ (format " at %d in buffer `%s'" pos buffer))
+ (cdr errdata))))))))
+
+(defun org-days-to-iso-week (days)
+ "Return the iso week number."
+ (require 'cal-iso)
+ (car (calendar-iso-from-absolute days)))
+
+(defun org-small-year-to-year (year)
+ "Convert 2-digit years into 4-digit years.
+38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007.
+The year 2000 cannot be abbreviated. Any year larger than 99
+is returned unchanged."
+ (if (< year 38)
+ (setq year (+ 2000 year))
+ (if (< year 100)
+ (setq year (+ 1900 year))))
+ year)
+
+(defun org-time-from-absolute (d)
+ "Return the time corresponding to date D.
+D may be an absolute day number, or a calendar-type list (month day year)."
+ (if (numberp d) (setq d (calendar-gregorian-from-absolute d)))
+ (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
+
+(defun org-calendar-holiday ()
+ "List of holidays, for Diary display in Org-mode."
+ (require 'holidays)
+ (let ((hl (funcall
+ (if (fboundp 'calendar-check-holidays)
+ 'calendar-check-holidays 'check-calendar-holidays) date)))
+ (if hl (mapconcat 'identity hl "; "))))
+
+(defun org-diary-sexp-entry (sexp entry date)
+ "Process a SEXP diary ENTRY for DATE."
+ (require 'diary-lib)
+ (let ((result (if calendar-debug-sexp
+ (let ((stack-trace-on-error t))
+ (eval (car (read-from-string sexp))))
+ (condition-case nil
+ (eval (car (read-from-string sexp)))
+ (error
+ (beep)
+ (message "Bad sexp at line %d in %s: %s"
+ (org-current-line)
+ (buffer-file-name) sexp)
+ (sleep-for 2))))))
+ (cond ((stringp result) (split-string result "; "))
+ ((and (consp result)
+ (not (consp (cdr result)))
+ (stringp (cdr result))) (cdr result))
+ ((and (consp result)
+ (stringp (car result))) result)
+ (result entry))))
+
+(defun org-diary-to-ical-string (frombuf)
+ "Get iCalendar entries from diary entries in buffer FROMBUF.
+This uses the icalendar.el library."
+ (let* ((tmpdir (if (featurep 'xemacs)
+ (temp-directory)
+ temporary-file-directory))
+ (tmpfile (make-temp-name
+ (expand-file-name "orgics" tmpdir)))
+ buf rtn b e)
+ (with-current-buffer frombuf
+ (icalendar-export-region (point-min) (point-max) tmpfile)
+ (setq buf (find-buffer-visiting tmpfile))
+ (set-buffer buf)
+ (goto-char (point-min))
+ (if (re-search-forward "^BEGIN:VEVENT" nil t)
+ (setq b (match-beginning 0)))
+ (goto-char (point-max))
+ (if (re-search-backward "^END:VEVENT" nil t)
+ (setq e (match-end 0)))
+ (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
+ (kill-buffer buf)
+ (delete-file tmpfile)
+ rtn))
+
+(defun org-closest-date (start current change prefer show-all)
+ "Find the date closest to CURRENT that is consistent with START and CHANGE.
+When PREFER is `past', return a date that is either CURRENT or past.
+When PREFER is `future', return a date that is either CURRENT or future.
+When SHOW-ALL is nil, only return the current occurrence of a time stamp."
+ ;; Make the proper lists from the dates
+ (catch 'exit
+ (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year)))
+ dn dw sday cday n1 n2 n0
+ d m y y1 y2 date1 date2 nmonths nm ny m2)
+
+ (setq start (org-date-to-gregorian start)
+ current (org-date-to-gregorian
+ (if show-all
+ current
+ (time-to-days (current-time))))
+ sday (calendar-absolute-from-gregorian start)
+ cday (calendar-absolute-from-gregorian current))
+
+ (if (<= cday sday) (throw 'exit sday))
+
+ (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
+ (setq dn (string-to-number (match-string 1 change))
+ dw (cdr (assoc (match-string 2 change) a1)))
+ (error "Invalid change specifier: %s" change))
+ (if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
+ (cond
+ ((eq dw 'day)
+ (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
+ n2 (+ n1 dn)))
+ ((eq dw 'year)
+ (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
+ (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
+ (setq date1 (list m d y1)
+ n1 (calendar-absolute-from-gregorian date1)
+ date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
+ n2 (calendar-absolute-from-gregorian date2)))
+ ((eq dw 'month)
+ ;; approx number of month between the two dates
+ (setq nmonths (floor (/ (- cday sday) 30.436875)))
+ ;; How often does dn fit in there?
+ (setq d (nth 1 start) m (car start) y (nth 2 start)
+ nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
+ m (+ m nm)
+ ny (floor (/ m 12))
+ y (+ y ny)
+ m (- m (* ny 12)))
+ (while (> m 12) (setq m (- m 12) y (1+ y)))
+ (setq n1 (calendar-absolute-from-gregorian (list m d y)))
+ (setq m2 (+ m dn) y2 y)
+ (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
+ (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
+ (while (<= n2 cday)
+ (setq n1 n2 m m2 y y2)
+ (setq m2 (+ m dn) y2 y)
+ (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
+ (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
+ ;; Make sure n1 is the earlier date
+ (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
+ (if show-all
+ (cond
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
+ ((eq prefer 'future) (if (= cday n1) n1 n2))
+ (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
+ (cond
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
+ ((eq prefer 'future) (if (= cday n1) n1 n2))
+ (t (if (= cday n1) n1 n2)))))))
+
+(defun org-date-to-gregorian (date)
+ "Turn any specification of DATE into a Gregorian date for the calendar."
+ (cond ((integerp date) (calendar-gregorian-from-absolute date))
+ ((and (listp date) (= (length date) 3)) date)
+ ((stringp date)
+ (setq date (org-parse-time-string date))
+ (list (nth 4 date) (nth 3 date) (nth 5 date)))
+ ((listp date)
+ (list (nth 4 date) (nth 3 date) (nth 5 date)))))
+
+(defun org-parse-time-string (s &optional nodefault)
+ "Parse the standard Org-mode time string.
+This should be a lot faster than the normal `parse-time-string'.
+If time is not given, defaults to 0:00. However, with optional NODEFAULT,
+hour and minute fields will be nil if not given."
+ (if (string-match org-ts-regexp0 s)
+ (list 0
+ (if (or (match-beginning 8) (not nodefault))
+ (string-to-number (or (match-string 8 s) "0")))
+ (if (or (match-beginning 7) (not nodefault))
+ (string-to-number (or (match-string 7 s) "0")))
+ (string-to-number (match-string 4 s))
+ (string-to-number (match-string 3 s))
+ (string-to-number (match-string 2 s))
+ nil nil nil)
+ (error "Not a standard Org-mode time string: %s" s)))
+
+(defun org-timestamp-up (&optional arg)
+ "Increase the date item at the cursor by one.
+If the cursor is on the year, change the year. If it is on the month,
+the day or the time, change that.
+With prefix ARG, change by that many units."
+ (interactive "p")
+ (org-timestamp-change (prefix-numeric-value arg) nil 'updown))
+
+(defun org-timestamp-down (&optional arg)
+ "Decrease the date item at the cursor by one.
+If the cursor is on the year, change the year. If it is on the month,
+the day or the time, change that.
+With prefix ARG, change by that many units."
+ (interactive "p")
+ (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
+
+(defun org-timestamp-up-day (&optional arg)
+ "Increase the date in the time stamp by one day.
+With prefix ARG, change that many days."
+ (interactive "p")
+ (if (and (not (org-at-timestamp-p t))
+ (org-at-heading-p))
+ (org-todo 'up)
+ (org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
+
+(defun org-timestamp-down-day (&optional arg)
+ "Decrease the date in the time stamp by one day.
+With prefix ARG, change that many days."
+ (interactive "p")
+ (if (and (not (org-at-timestamp-p t))
+ (org-at-heading-p))
+ (org-todo 'down)
+ (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
+
+(defun org-at-timestamp-p (&optional inactive-ok)
+ "Determine if the cursor is in or at a timestamp."
+ (interactive)
+ (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
+ (pos (point))
+ (ans (or (looking-at tsr)
+ (save-excursion
+ (skip-chars-backward "^[<\n\r\t")
+ (if (> (point) (point-min)) (backward-char 1))
+ (and (looking-at tsr)
+ (> (- (match-end 0) pos) -1))))))
+ (and ans
+ (boundp 'org-ts-what)
+ (setq org-ts-what
+ (cond
+ ((= pos (match-beginning 0)) 'bracket)
+ ;; Point is considered to be "on the bracket" whether
+ ;; it's really on it or right after it.
+ ((= pos (1- (match-end 0))) 'bracket)
+ ((= pos (match-end 0)) 'after)
+ ((org-pos-in-match-range pos 2) 'year)
+ ((org-pos-in-match-range pos 3) 'month)
+ ((org-pos-in-match-range pos 7) 'hour)
+ ((org-pos-in-match-range pos 8) 'minute)
+ ((or (org-pos-in-match-range pos 4)
+ (org-pos-in-match-range pos 5)) 'day)
+ ((and (> pos (or (match-end 8) (match-end 5)))
+ (< pos (match-end 0)))
+ (- pos (or (match-end 8) (match-end 5))))
+ (t 'day))))
+ ans))
+
+(defun org-toggle-timestamp-type ()
+ "Toggle the type (<active> or [inactive]) of a time stamp."
+ (interactive)
+ (when (org-at-timestamp-p t)
+ (let ((beg (match-beginning 0)) (end (match-end 0))
+ (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "[][<>]" end t)
+ (replace-match (cdr (assoc (char-after (match-beginning 0)) map))
+ t t)))
+ (message "Timestamp is now %sactive"
+ (if (equal (char-after beg) ?<) "" "in")))))
+
+(defvar org-clock-history) ; defined in org-clock.el
+(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
+(defun org-timestamp-change (n &optional what updown)
+ "Change the date in the time stamp at point.
+The date will be changed by N times WHAT. WHAT can be `day', `month',
+`year', `minute', `second'. If WHAT is not given, the cursor position
+in the timestamp determines what will be changed."
+ (let ((origin (point)) origin-cat
+ with-hm inactive
+ (dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
+ org-ts-what
+ extra rem
+ ts time time0 fixnext clrgx)
+ (if (not (org-at-timestamp-p t))
+ (error "Not at a timestamp"))
+ (if (and (not what) (eq org-ts-what 'bracket))
+ (org-toggle-timestamp-type)
+ ;; Point isn't on brackets. Remember the part of the time-stamp
+ ;; the point was in. Indeed, size of time-stamps may change,
+ ;; but point must be kept in the same category nonetheless.
+ (setq origin-cat org-ts-what)
+ (if (and (not what) (not (eq org-ts-what 'day))
+ org-display-custom-times
+ (get-text-property (point) 'display)
+ (not (get-text-property (1- (point)) 'display)))
+ (setq org-ts-what 'day))
+ (setq org-ts-what (or what org-ts-what)
+ inactive (= (char-after (match-beginning 0)) ?\[)
+ ts (match-string 0))
+ (replace-match "")
+ (if (string-match
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
+ ts)
+ (setq extra (match-string 1 ts)))
+ (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
+ (setq with-hm t))
+ (setq time0 (org-parse-time-string ts))
+ (when (and updown
+ (eq org-ts-what 'minute)
+ (not current-prefix-arg))
+ ;; This looks like s-up and s-down. Change by one rounding step.
+ (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
+ (when (not (= 0 (setq rem (% (nth 1 time0) dm))))
+ (setcar (cdr time0) (+ (nth 1 time0)
+ (if (> n 0) (- rem) (- dm rem))))))
+ (setq time
+ (encode-time (or (car time0) 0)
+ (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
+ (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
+ (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
+ (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
+ (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0)))
+ (when (and (member org-ts-what '(hour minute))
+ extra
+ (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
+ (setq extra (org-modify-ts-extra
+ extra
+ (if (eq org-ts-what 'hour) 2 5)
+ n dm)))
+ (when (integerp org-ts-what)
+ (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
+ (if (eq what 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
+ (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
+ (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
+ (setcar time0 (or (car time0) 0))
+ (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
+ (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
+ (setq time (apply 'encode-time time0))))
+ ;; Insert the new time-stamp, and ensure point stays in the same
+ ;; category as before (i.e. not after the last position in that
+ ;; category).
+ (let ((pos (point)))
+ ;; Stay before inserted string. `save-excursion' is of no use.
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp time with-hm inactive nil nil extra))
+ (goto-char pos))
+ (save-match-data
+ (looking-at org-ts-regexp3)
+ (goto-char (cond
+ ;; `day' category ends before `hour' if any, or at
+ ;; the end of the day name.
+ ((eq origin-cat 'day)
+ (min (or (match-beginning 7) (1- (match-end 5))) origin))
+ ((eq origin-cat 'hour) (min (match-end 7) origin))
+ ((eq origin-cat 'minute) (min (1- (match-end 8)) origin))
+ ((integerp origin-cat) (min (1- (match-end 0)) origin))
+ ;; `year' and `month' have both fixed size: point
+ ;; couldn't have moved into another part.
+ (t origin))))
+ ;; Update clock if on a CLOCK line.
+ (org-clock-update-time-maybe)
+ ;; Maybe adjust the closest clock in `org-clock-history'
+ (when org-clock-adjust-closest
+ (if (not (and (org-at-clock-log-p)
+ (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m))
+ org-clock-history))))))
+ (message "No clock to adjust")
+ (cond ((save-excursion ; fix previous clock?
+ (re-search-backward org-ts-regexp0 nil t)
+ (org-looking-back (concat org-clock-string " \\[")))
+ (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
+ ((save-excursion ; fix next clock?
+ (re-search-backward org-ts-regexp0 nil t)
+ (looking-at (concat org-ts-regexp0 "\\] =>")))
+ (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
+ (save-window-excursion
+ ;; Find closest clock to point, adjust the previous/next one in history
+ (let* ((p (save-excursion (org-back-to-heading t)))
+ (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
+ (clfixnth
+ (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100))))
+ (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
+ (if (not clfixpos)
+ (message "No clock to adjust")
+ (save-excursion
+ (org-goto-marker-or-bmk clfixpos)
+ (org-show-subtree)
+ (when (re-search-forward clrgx nil t)
+ (goto-char (match-beginning 1))
+ (let (org-clock-adjust-closest)
+ (org-timestamp-change n org-ts-what updown))
+ (message "Clock adjusted in %s for heading: %s"
+ (file-name-nondirectory (buffer-file-name))
+ (org-get-heading t t)))))))))
+ ;; Try to recenter the calendar window, if any.
+ (if (and org-calendar-follow-timestamp-change
+ (get-buffer-window "*Calendar*" t)
+ (memq org-ts-what '(day month year)))
+ (org-recenter-calendar (time-to-days time))))))
+
+(defun org-modify-ts-extra (s pos n dm)
+ "Change the different parts of the lead-time and repeat fields in timestamp."
+ (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
+ ng h m new rem)
+ (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
+ (cond
+ ((or (org-pos-in-match-range pos 2)
+ (org-pos-in-match-range pos 3))
+ (setq m (string-to-number (match-string 3 s))
+ h (string-to-number (match-string 2 s)))
+ (if (org-pos-in-match-range pos 2)
+ (setq h (+ h n))
+ (setq n (* dm (org-no-warnings (signum n))))
+ (when (not (= 0 (setq rem (% m dm))))
+ (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
+ (setq m (+ m n)))
+ (if (< m 0) (setq m (+ m 60) h (1- h)))
+ (if (> m 59) (setq m (- m 60) h (1+ h)))
+ (setq h (min 24 (max 0 h)))
+ (setq ng 1 new (format "-%02d:%02d" h m)))
+ ((org-pos-in-match-range pos 6)
+ (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
+ ((org-pos-in-match-range pos 5)
+ (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
+
+ ((org-pos-in-match-range pos 9)
+ (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
+ ((org-pos-in-match-range pos 8)
+ (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
+
+ (when ng
+ (setq s (concat
+ (substring s 0 (match-beginning ng))
+ new
+ (substring s (match-end ng))))))
+ s))
+
+(defun org-recenter-calendar (date)
+ "If the calendar is visible, recenter it to DATE."
+ (let ((cwin (get-buffer-window "*Calendar*" t)))
+ (when cwin
+ (let ((calendar-move-hook nil))
+ (with-selected-window cwin
+ (calendar-goto-date (if (listp date) date
+ (calendar-gregorian-from-absolute date))))))))
+
+(defun org-goto-calendar (&optional arg)
+ "Go to the Emacs calendar at the current date.
+If there is a time stamp in the current line, go to that date.
+A prefix ARG can be used to force the current date."
+ (interactive "P")
+ (let ((tsr org-ts-regexp) diff
+ (calendar-move-hook nil)
+ (calendar-view-holidays-initially-flag nil)
+ (calendar-view-diary-initially-flag nil))
+ (if (or (org-at-timestamp-p)
+ (save-excursion
+ (beginning-of-line 1)
+ (looking-at (concat ".*" tsr))))
+ (let ((d1 (time-to-days (current-time)))
+ (d2 (time-to-days
+ (org-time-string-to-time (match-string 1)))))
+ (setq diff (- d2 d1))))
+ (calendar)
+ (calendar-goto-today)
+ (if (and diff (not arg)) (calendar-forward-day diff))))
+
+(defun org-get-date-from-calendar ()
+ "Return a list (month day year) of date at point in calendar."
+ (with-current-buffer "*Calendar*"
+ (save-match-data
+ (calendar-cursor-to-date))))
+
+(defun org-date-from-calendar ()
+ "Insert time stamp corresponding to cursor date in *Calendar* buffer.
+If there is already a time stamp at the cursor position, update it."
+ (interactive)
+ (if (org-at-timestamp-p t)
+ (org-timestamp-change 0 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (org-insert-time-stamp
+ (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
+
+(defun org-minutes-to-hh:mm-string (m)
+ "Compute H:MM from a number of minutes."
+ (let ((h (/ m 60)))
+ (setq m (- m (* 60 h)))
+ (format org-time-clocksum-format h m)))
+
+(defun org-hh:mm-string-to-minutes (s)
+ "Convert a string H:MM to a number of minutes.
+If the string is just a number, interpret it as minutes.
+In fact, the first hh:mm or number in the string will be taken,
+there can be extra stuff in the string.
+If no number is found, the return value is 0."
+ (cond
+ ((integerp s) s)
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
+ (+ (* (string-to-number (match-string 1 s)) 60)
+ (string-to-number (match-string 2 s))))
+ ((string-match "\\([0-9]+\\)" s)
+ (string-to-number (match-string 1 s)))
+ (t 0)))
+
+(defcustom org-effort-durations
+ `(("h" . 60)
+ ("d" . ,(* 60 8))
+ ("w" . ,(* 60 8 5))
+ ("m" . ,(* 60 8 5 4))
+ ("y" . ,(* 60 8 5 40)))
+ "Conversion factor to minutes for an effort modifier.
+
+Each entry has the form (MODIFIER . MINUTES).
+
+In an effort string, a number followed by MODIFIER is multiplied
+by the specified number of MINUTES to obtain an effort in
+minutes.
+
+For example, if the value of this variable is ((\"hours\" . 60)), then an
+effort string \"2hours\" is equivalent to 120 minutes."
+ :group 'org-agenda
+ :version "24.1"
+ :type '(alist :key-type (string :tag "Modifier")
+ :value-type (number :tag "Minutes")))
+
+(defun org-duration-string-to-minutes (s &optional output-to-string)
+ "Convert a duration string S to minutes.
+
+A bare number is interpreted as minutes, modifiers can be set by
+customizing `org-effort-durations' (which see).
+
+Entries containing a colon are interpreted as H:MM by
+`org-hh:mm-string-to-minutes'."
+ (let ((result 0)
+ (re (concat "\\([0-9.]+\\) *\\("
+ (regexp-opt (mapcar 'car org-effort-durations))
+ "\\)")))
+ (while (string-match re s)
+ (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
+ (string-to-number (match-string 1 s))))
+ (setq s (replace-match "" nil t s)))
+ (setq result (floor result))
+ (incf result (org-hh:mm-string-to-minutes s))
+ (if output-to-string (number-to-string result) result)))
+
+;;;; Files
+
+(defun org-save-all-org-buffers ()
+ "Save all Org-mode buffers without user confirmation."
+ (interactive)
+ (message "Saving all Org-mode buffers...")
+ (save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
+ (when (featurep 'org-id) (org-id-locations-save))
+ (message "Saving all Org-mode buffers... done"))
+
+(defun org-revert-all-org-buffers ()
+ "Revert all Org-mode buffers.
+Prompt for confirmation when there are unsaved changes.
+Be sure you know what you are doing before letting this function
+overwrite your changes.
+
+This function is useful in a setup where one tracks org files
+with a version control system, to revert on one machine after pulling
+changes from another. I believe the procedure must be like this:
+
+1. M-x org-save-all-org-buffers
+2. Pull changes from the other machine, resolve conflicts
+3. M-x org-revert-all-org-buffers"
+ (interactive)
+ (unless (yes-or-no-p "Revert all Org buffers from their files? ")
+ (error "Abort"))
+ (save-excursion
+ (save-window-excursion
+ (mapc
+ (lambda (b)
+ (when (and (with-current-buffer b (derived-mode-p 'org-mode))
+ (with-current-buffer b buffer-file-name))
+ (org-pop-to-buffer-same-window b)
+ (revert-buffer t 'no-confirm)))
+ (buffer-list))
+ (when (and (featurep 'org-id) org-id-track-globally)
+ (org-id-locations-load)))))
+
+;;;; Agenda files
+
+;;;###autoload
+(defun org-switchb (&optional arg)
+ "Switch between Org buffers.
+With one prefix argument, restrict available buffers to files.
+With two prefix arguments, restrict available buffers to agenda files.
+
+Defaults to `iswitchb' for buffer name completion.
+Set `org-completion-use-ido' to make it use ido instead."
+ (interactive "P")
+ (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files))
+ ((equal arg '(16)) (org-buffer-list 'agenda))
+ (t (org-buffer-list))))
+ (org-completion-use-iswitchb org-completion-use-iswitchb)
+ (org-completion-use-ido org-completion-use-ido))
+ (unless (or org-completion-use-ido org-completion-use-iswitchb)
+ (setq org-completion-use-iswitchb t))
+ (org-pop-to-buffer-same-window
+ (org-icompleting-read "Org buffer: "
+ (mapcar 'list (mapcar 'buffer-name blist))
+ nil t))))
+
+;;; Define some older names previously used for this functionality
+;;;###autoload
+(defalias 'org-ido-switchb 'org-switchb)
+;;;###autoload
+(defalias 'org-iswitchb 'org-switchb)
+
+(defun org-buffer-list (&optional predicate exclude-tmp)
+ "Return a list of Org buffers.
+PREDICATE can be `export', `files' or `agenda'.
+
+export restrict the list to Export buffers.
+files restrict the list to buffers visiting Org files.
+agenda restrict the list to buffers visiting agenda files.
+
+If EXCLUDE-TMP is non-nil, ignore temporary buffers."
+ (let* ((bfn nil)
+ (agenda-files (and (eq predicate 'agenda)
+ (mapcar 'file-truename (org-agenda-files t))))
+ (filter
+ (cond
+ ((eq predicate 'files)
+ (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
+ ((eq predicate 'export)
+ (lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
+ ((eq predicate 'agenda)
+ (lambda (b)
+ (with-current-buffer b
+ (and (derived-mode-p 'org-mode)
+ (setq bfn (buffer-file-name b))
+ (member (file-truename bfn) agenda-files)))))
+ (t (lambda (b) (with-current-buffer b
+ (or (derived-mode-p 'org-mode)
+ (string-match "\*Org .*Export"
+ (buffer-name b)))))))))
+ (delq nil
+ (mapcar
+ (lambda(b)
+ (if (and (funcall filter b)
+ (or (not exclude-tmp)
+ (not (string-match "tmp" (buffer-name b)))))
+ b
+ nil))
+ (buffer-list)))))
+
+(defun org-agenda-files (&optional unrestricted archives)
+ "Get the list of agenda files.
+Optional UNRESTRICTED means return the full list even if a restriction
+is currently in place.
+When ARCHIVES is t, include all archive files that are really being
+used by the agenda files. If ARCHIVE is `ifmode', do this only if
+`org-agenda-archives-mode' is t."
+ (let ((files
+ (cond
+ ((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
+ ((stringp org-agenda-files) (org-read-agenda-file-list))
+ ((listp org-agenda-files) org-agenda-files)
+ (t (error "Invalid value of `org-agenda-files'")))))
+ (setq files (apply 'append
+ (mapcar (lambda (f)
+ (if (file-directory-p f)
+ (directory-files
+ f t org-agenda-file-regexp)
+ (list f)))
+ files)))
+ (when org-agenda-skip-unavailable-files
+ (setq files (delq nil
+ (mapcar (function
+ (lambda (file)
+ (and (file-readable-p file) file)))
+ files))))
+ (when (or (eq archives t)
+ (and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
+ (setq files (org-add-archive-files files)))
+ files))
+
+(defun org-agenda-file-p (&optional file)
+ "Return non-nil, if FILE is an agenda file.
+If FILE is omitted, use the file associated with the current
+buffer."
+ (member (or file (buffer-file-name))
+ (org-agenda-files t)))
+
+(defun org-edit-agenda-file-list ()
+ "Edit the list of agenda files.
+Depending on setup, this either uses customize to edit the variable
+`org-agenda-files', or it visits the file that is holding the list. In the
+latter case, the buffer is set up in a way that saving it automatically kills
+the buffer and restores the previous window configuration."
+ (interactive)
+ (if (stringp org-agenda-files)
+ (let ((cw (current-window-configuration)))
+ (find-file org-agenda-files)
+ (org-set-local 'org-window-configuration cw)
+ (org-add-hook 'after-save-hook
+ (lambda ()
+ (set-window-configuration
+ (prog1 org-window-configuration
+ (kill-buffer (current-buffer))))
+ (org-install-agenda-files-menu)
+ (message "New agenda file list installed"))
+ nil 'local)
+ (message "%s" (substitute-command-keys
+ "Edit list and finish with \\[save-buffer]")))
+ (customize-variable 'org-agenda-files)))
+
+(defun org-store-new-agenda-file-list (list)
+ "Set new value for the agenda file list and save it correctly."
+ (if (stringp org-agenda-files)
+ (let ((fe (org-read-agenda-file-list t)) b u)
+ (while (setq b (find-buffer-visiting org-agenda-files))
+ (kill-buffer b))
+ (with-temp-file org-agenda-files
+ (insert
+ (mapconcat
+ (lambda (f) ;; Keep un-expanded entries.
+ (if (setq u (assoc f fe))
+ (cdr u)
+ f))
+ list "\n")
+ "\n")))
+ (let ((org-mode-hook nil) (org-inhibit-startup t)
+ (org-insert-mode-line-in-empty-file nil))
+ (setq org-agenda-files list)
+ (customize-save-variable 'org-agenda-files org-agenda-files))))
+
+(defun org-read-agenda-file-list (&optional pair-with-expansion)
+ "Read the list of agenda files from a file.
+If PAIR-WITH-EXPANSION is t return pairs with un-expanded
+filenames, used by `org-store-new-agenda-file-list' to write back
+un-expanded file names."
+ (when (file-directory-p org-agenda-files)
+ (error "`org-agenda-files' cannot be a single directory"))
+ (when (stringp org-agenda-files)
+ (with-temp-buffer
+ (insert-file-contents org-agenda-files)
+ (mapcar
+ (lambda (f)
+ (let ((e (expand-file-name (substitute-in-file-name f)
+ org-directory)))
+ (if pair-with-expansion
+ (cons e f)
+ e)))
+ (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))))
+
+;;;###autoload
+(defun org-cycle-agenda-files ()
+ "Cycle through the files in `org-agenda-files'.
+If the current buffer visits an agenda file, find the next one in the list.
+If the current buffer does not, find the first agenda file."
+ (interactive)
+ (let* ((fs (org-agenda-files t))
+ (files (append fs (list (car fs))))
+ (tcf (if buffer-file-name (file-truename buffer-file-name)))
+ file)
+ (unless files (error "No agenda files"))
+ (catch 'exit
+ (while (setq file (pop files))
+ (if (equal (file-truename file) tcf)
+ (when (car files)
+ (find-file (car files))
+ (throw 'exit t))))
+ (find-file (car fs)))
+ (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer)))))
+
+(defun org-agenda-file-to-front (&optional to-end)
+ "Move/add the current file to the top of the agenda file list.
+If the file is not present in the list, it is added to the front. If it is
+present, it is moved there. With optional argument TO-END, add/move to the
+end of the list."
+ (interactive "P")
+ (let ((org-agenda-skip-unavailable-files nil)
+ (file-alist (mapcar (lambda (x)
+ (cons (file-truename x) x))
+ (org-agenda-files t)))
+ (ctf (file-truename buffer-file-name))
+ x had)
+ (setq x (assoc ctf file-alist) had x)
+
+ (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
+ (if to-end
+ (setq file-alist (append (delq x file-alist) (list x)))
+ (setq file-alist (cons x (delq x file-alist))))
+ (org-store-new-agenda-file-list (mapcar 'cdr file-alist))
+ (org-install-agenda-files-menu)
+ (message "File %s to %s of agenda file list"
+ (if had "moved" "added") (if to-end "end" "front"))))
+
+(defun org-remove-file (&optional file)
+ "Remove current file from the list of files in variable `org-agenda-files'.
+These are the files which are being checked for agenda entries.
+Optional argument FILE means use this file instead of the current."
+ (interactive)
+ (let* ((org-agenda-skip-unavailable-files nil)
+ (file (or file buffer-file-name))
+ (true-file (file-truename file))
+ (afile (abbreviate-file-name file))
+ (files (delq nil (mapcar
+ (lambda (x)
+ (if (equal true-file
+ (file-truename x))
+ nil x))
+ (org-agenda-files t)))))
+ (if (not (= (length files) (length (org-agenda-files t))))
+ (progn
+ (org-store-new-agenda-file-list files)
+ (org-install-agenda-files-menu)
+ (message "Removed file: %s" afile))
+ (message "File was not in list: %s (not removed)" afile))))
+
+(defun org-file-menu-entry (file)
+ (vector file (list 'find-file file) t))
+
+(defun org-check-agenda-file (file)
+ "Make sure FILE exists. If not, ask user what to do."
+ (when (not (file-exists-p file))
+ (message "non-existent agenda file %s. [R]emove from list or [A]bort?"
+ (abbreviate-file-name file))
+ (let ((r (downcase (read-char-exclusive))))
+ (cond
+ ((equal r ?r)
+ (org-remove-file file)
+ (throw 'nextfile t))
+ (t (error "Abort"))))))
+
+(defun org-get-agenda-file-buffer (file)
+ "Get a buffer visiting FILE. If the buffer needs to be created, add
+it to the list of buffers which might be released later."
+ (let ((buf (org-find-base-buffer-visiting file)))
+ (if buf
+ buf ; just return it
+ ;; Make a new buffer and remember it
+ (setq buf (find-file-noselect file))
+ (if buf (push buf org-agenda-new-buffers))
+ buf)))
+
+(defun org-release-buffers (blist)
+ "Release all buffers in list, asking the user for confirmation when needed.
+When a buffer is unmodified, it is just killed. When modified, it is saved
+\(if the user agrees) and then killed."
+ (let (buf file)
+ (while (setq buf (pop blist))
+ (setq file (buffer-file-name buf))
+ (when (and (buffer-modified-p buf)
+ file
+ (y-or-n-p (format "Save file %s? " file)))
+ (with-current-buffer buf (save-buffer)))
+ (kill-buffer buf))))
+
+(defun org-agenda-prepare-buffers (files)
+ "Create buffers for all agenda files, protect archived trees and comments."
+ (interactive)
+ (let ((pa '(:org-archived t))
+ (pc '(:org-comment t))
+ (pall '(:org-archived t :org-comment t))
+ (inhibit-read-only t)
+ (rea (concat ":" org-archive-tag ":"))
+ bmp file re)
+ (save-excursion
+ (save-restriction
+ (while (setq file (pop files))
+ (catch 'nextfile
+ (if (bufferp file)
+ (set-buffer file)
+ (org-check-agenda-file file)
+ (set-buffer (org-get-agenda-file-buffer file)))
+ (widen)
+ (setq bmp (buffer-modified-p))
+ (org-refresh-category-properties)
+ (setq org-todo-keywords-for-agenda
+ (append org-todo-keywords-for-agenda org-todo-keywords-1))
+ (setq org-done-keywords-for-agenda
+ (append org-done-keywords-for-agenda org-done-keywords))
+ (setq org-todo-keyword-alist-for-agenda
+ (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
+ (setq org-drawers-for-agenda
+ (append org-drawers-for-agenda org-drawers))
+ (setq org-tag-alist-for-agenda
+ (append org-tag-alist-for-agenda org-tag-alist))
+
+ (save-excursion
+ (remove-text-properties (point-min) (point-max) pall)
+ (when org-agenda-skip-archived-trees
+ (goto-char (point-min))
+ (while (re-search-forward rea nil t)
+ (if (org-at-heading-p t)
+ (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
+ (goto-char (point-min))
+ (setq re (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (while (re-search-forward re nil t)
+ (add-text-properties
+ (match-beginning 0) (org-end-of-subtree t) pc)))
+ (set-buffer-modified-p bmp)))))
+ (setq org-todo-keywords-for-agenda
+ (org-uniquify org-todo-keywords-for-agenda))
+ (setq org-todo-keyword-alist-for-agenda
+ (org-uniquify org-todo-keyword-alist-for-agenda)
+ org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda))))
+
+;;;; Embedded LaTeX
+
+(defvar org-cdlatex-mode-map (make-sparse-keymap)
+ "Keymap for the minor `org-cdlatex-mode'.")
+
+(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret)
+(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
+(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
+(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
+(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment)
+
+(defvar org-cdlatex-texmathp-advice-is-done nil
+ "Flag remembering if we have applied the advice to texmathp already.")
+
+(define-minor-mode org-cdlatex-mode
+ "Toggle the minor `org-cdlatex-mode'.
+This mode supports entering LaTeX environment and math in LaTeX fragments
+in Org-mode.
+\\{org-cdlatex-mode-map}"
+ nil " OCDL" nil
+ (when org-cdlatex-mode
+ (require 'cdlatex)
+ (run-hooks 'cdlatex-mode-hook)
+ (cdlatex-compute-tables))
+ (unless org-cdlatex-texmathp-advice-is-done
+ (setq org-cdlatex-texmathp-advice-is-done t)
+ (defadvice texmathp (around org-math-always-on activate)
+ "Always return t in org-mode buffers.
+This is because we want to insert math symbols without dollars even outside
+the LaTeX math segments. If Orgmode thinks that point is actually inside
+an embedded LaTeX fragment, let texmathp do its job.
+\\[org-cdlatex-mode-map]"
+ (interactive)
+ (let (p)
+ (cond
+ ((not (derived-mode-p 'org-mode)) ad-do-it)
+ ((eq this-command 'cdlatex-math-symbol)
+ (setq ad-return-value t
+ texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
+ (t
+ (let ((p (org-inside-LaTeX-fragment-p)))
+ (if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
+ (setq ad-return-value t
+ texmathp-why '("Org-mode embedded math" . 0))
+ (if p ad-do-it)))))))))
+
+(defun turn-on-org-cdlatex ()
+ "Unconditionally turn on `org-cdlatex-mode'."
+ (org-cdlatex-mode 1))
+
+(defun org-inside-LaTeX-fragment-p ()
+ "Test if point is inside a LaTeX fragment.
+I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
+sequence appearing also before point.
+Even though the matchers for math are configurable, this function assumes
+that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
+delimiters are skipped when they have been removed by customization.
+The return value is nil, or a cons cell with the delimiter and the
+position of this delimiter.
+
+This function does a reasonably good job, but can locally be fooled by
+for example currency specifications. For example it will assume being in
+inline math after \"$22.34\". The LaTeX fragment formatter will only format
+fragments that are properly closed, but during editing, we have to live
+with the uncertainty caused by missing closing delimiters. This function
+looks only before point, not after."
+ (catch 'exit
+ (let ((pos (point))
+ (dodollar (member "$" (plist-get org-format-latex-options :matchers)))
+ (lim (progn
+ (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t)
+ (point)))
+ dd-on str (start 0) m re)
+ (goto-char pos)
+ (when dodollar
+ (setq str (concat (buffer-substring lim (point)) "\000 X$.")
+ re (nth 1 (assoc "$" org-latex-regexps)))
+ (while (string-match re str start)
+ (cond
+ ((= (match-end 0) (length str))
+ (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
+ ((= (match-end 0) (- (length str) 5))
+ (throw 'exit nil))
+ (t (setq start (match-end 0))))))
+ (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
+ (goto-char pos)
+ (and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
+ (and (match-beginning 2) (throw 'exit nil))
+ ;; count $$
+ (while (re-search-backward "\\$\\$" lim t)
+ (setq dd-on (not dd-on)))
+ (goto-char pos)
+ (if dd-on (cons "$$" m))))))
+
+(defun org-inside-latex-macro-p ()
+ "Is point inside a LaTeX macro or its arguments?"
+ (save-match-data
+ (org-in-regexp
+ "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
+
+(defun org-try-cdlatex-tab ()
+ "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
+It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
+ - inside a LaTeX fragment, or
+ - after the first word in a line, where an abbreviation expansion could
+ insert a LaTeX environment."
+ (when org-cdlatex-mode
+ (cond
+ ;; Before any word on the line: No expansion possible.
+ ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
+ ;; Just after first word on the line: Expand it. Make sure it
+ ;; cannot happen on headlines, though.
+ ((save-excursion
+ (skip-chars-backward "a-zA-Z0-9*")
+ (skip-chars-backward " \t")
+ (and (bolp) (not (org-at-heading-p))))
+ (cdlatex-tab) t)
+ ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
+
+(defun org-cdlatex-underscore-caret (&optional arg)
+ "Execute `cdlatex-sub-superscript' in LaTeX fragments.
+Revert to the normal definition outside of these fragments."
+ (interactive "P")
+ (if (org-inside-LaTeX-fragment-p)
+ (call-interactively 'cdlatex-sub-superscript)
+ (let (org-cdlatex-mode)
+ (call-interactively (key-binding (vector last-input-event))))))
+
+(defun org-cdlatex-math-modify (&optional arg)
+ "Execute `cdlatex-math-modify' in LaTeX fragments.
+Revert to the normal definition outside of these fragments."
+ (interactive "P")
+ (if (org-inside-LaTeX-fragment-p)
+ (call-interactively 'cdlatex-math-modify)
+ (let (org-cdlatex-mode)
+ (call-interactively (key-binding (vector last-input-event))))))
+
+(defvar org-latex-fragment-image-overlays nil
+ "List of overlays carrying the images of latex fragments.")
+(make-variable-buffer-local 'org-latex-fragment-image-overlays)
+
+(defun org-remove-latex-fragment-image-overlays ()
+ "Remove all overlays with LaTeX fragment images in current buffer."
+ (mapc 'delete-overlay org-latex-fragment-image-overlays)
+ (setq org-latex-fragment-image-overlays nil))
+
+(defun org-preview-latex-fragment (&optional subtree)
+ "Preview the LaTeX fragment at point, or all locally or globally.
+If the cursor is in a LaTeX fragment, create the image and overlay
+it over the source code. If there is no fragment at point, display
+all fragments in the current text, from one headline to the next. With
+prefix SUBTREE, display all fragments in the current subtree. With a
+double prefix arg \\[universal-argument] \\[universal-argument], or when \
+the cursor is before the first headline,
+display all fragments in the buffer.
+The images can be removed again with \\[org-ctrl-c-ctrl-c]."
+ (interactive "P")
+ (unless buffer-file-name
+ (error "Can't preview LaTeX fragment in a non-file buffer"))
+ (org-remove-latex-fragment-image-overlays)
+ (save-excursion
+ (save-restriction
+ (let (beg end at msg)
+ (cond
+ ((or (equal subtree '(16))
+ (not (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t))))
+ (setq beg (point-min) end (point-max)
+ msg "Creating images for buffer...%s"))
+ ((equal subtree '(4))
+ (org-back-to-heading)
+ (setq beg (point) end (org-end-of-subtree t)
+ msg "Creating images for subtree...%s"))
+ (t
+ (if (setq at (org-inside-LaTeX-fragment-p))
+ (goto-char (max (point-min) (- (cdr at) 2)))
+ (org-back-to-heading))
+ (setq beg (point) end (progn (outline-next-heading) (point))
+ msg (if at "Creating image...%s"
+ "Creating images for entry...%s"))))
+ (message msg "")
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (org-format-latex
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
+ (file-name-nondirectory
+ buffer-file-name)))
+ default-directory 'overlays msg at 'forbuffer
+ org-latex-create-formula-image-program)
+ (message msg "done. Use `C-c C-c' to remove images.")))))
+
+(defvar org-latex-regexps
+ '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
+ ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
+ ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
+ ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
+ "Regular expressions for matching embedded LaTeX.")
+
+(defvar org-export-have-math nil) ;; dynamic scoping
+(defun org-format-latex (prefix &optional dir overlays msg at
+ forbuffer processing-type)
+ "Replace LaTeX fragments with links to an image, and produce images.
+Some of the options can be changed using the variable
+`org-format-latex-options'."
+ (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
+ (let* ((prefixnodir (file-name-nondirectory prefix))
+ (absprefix (expand-file-name prefix dir))
+ (todir (file-name-directory absprefix))
+ (opt org-format-latex-options)
+ (matchers (plist-get opt :matchers))
+ (re-list org-latex-regexps)
+ (org-format-latex-header-extra
+ (plist-get (org-infile-export-plist) :latex-header-extra))
+ (cnt 0) txt hash link beg end re e checkdir
+ executables-checked string
+ m n block-type block linkfile movefile ov)
+ ;; Check the different regular expressions
+ (while (setq e (pop re-list))
+ (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
+ block (if block-type "\n\n" ""))
+ (when (member m matchers)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (when (and (or (not at) (equal (cdr at) (match-beginning n)))
+ (not (get-text-property (match-beginning n)
+ 'org-protected))
+ (or (not overlays)
+ (not (eq (get-char-property (match-beginning n)
+ 'org-overlay-type)
+ 'org-latex-overlay))))
+ (setq org-export-have-math t)
+ (cond
+ ((eq processing-type 'verbatim)
+ ;; Leave the text verbatim, just protect it
+ (add-text-properties (match-beginning n) (match-end n)
+ '(org-protected t)))
+ ((eq processing-type 'mathjax)
+ ;; Prepare for MathJax processing
+ (setq string (match-string n))
+ (if (member m '("$" "$1"))
+ (save-excursion
+ (delete-region (match-beginning n) (match-end n))
+ (goto-char (match-beginning n))
+ (insert (org-add-props (concat "\\(" (substring string 1 -1)
+ "\\)")
+ '(org-protected t))))
+ (add-text-properties (match-beginning n) (match-end n)
+ '(org-protected t))))
+ ((or (eq processing-type 'dvipng)
+ (eq processing-type 'imagemagick))
+ ;; Process to an image
+ (setq txt (match-string n)
+ beg (match-beginning n) end (match-end n)
+ cnt (1+ cnt))
+ (let (print-length print-level) ; make sure full list is printed
+ (setq hash (sha1 (prin1-to-string
+ (list org-format-latex-header
+ org-format-latex-header-extra
+ org-export-latex-default-packages-alist
+ org-export-latex-packages-alist
+ org-format-latex-options
+ forbuffer txt)))
+ linkfile (format "%s_%s.png" prefix hash)
+ movefile (format "%s_%s.png" absprefix hash)))
+ (setq link (concat block "[[file:" linkfile "]]" block))
+ (if msg (message msg cnt))
+ (goto-char beg)
+ (unless checkdir ; make sure the directory exists
+ (setq checkdir t)
+ (or (file-directory-p todir) (make-directory todir t)))
+ (cond
+ ((eq processing-type 'dvipng)
+ (unless executables-checked
+ (org-check-external-command
+ "latex" "needed to convert LaTeX fragments to images")
+ (org-check-external-command
+ "dvipng" "needed to convert LaTeX fragments to images")
+ (setq executables-checked t))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image-with-dvipng
+ txt movefile opt forbuffer)))
+ ((eq processing-type 'imagemagick)
+ (unless executables-checked
+ (org-check-external-command
+ "convert" "you need to install imagemagick")
+ (setq executables-checked t))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image-with-imagemagick
+ txt movefile opt forbuffer))))
+ (if overlays
+ (progn
+ (mapc (lambda (o)
+ (if (eq (overlay-get o 'org-overlay-type)
+ 'org-latex-overlay)
+ (delete-overlay o)))
+ (overlays-in beg end))
+ (setq ov (make-overlay beg end))
+ (overlay-put ov 'org-overlay-type 'org-latex-overlay)
+ (if (featurep 'xemacs)
+ (progn
+ (overlay-put ov 'invisible t)
+ (overlay-put
+ ov 'end-glyph
+ (make-glyph (vector 'png :file movefile))))
+ (overlay-put
+ ov 'display
+ (list 'image :type 'png :file movefile :ascent 'center)))
+ (push ov org-latex-fragment-image-overlays)
+ (goto-char end))
+ (delete-region beg end)
+ (insert (org-add-props link
+ (list 'org-latex-src
+ (replace-regexp-in-string
+ "\"" "" txt)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character))))))
+ ((eq processing-type 'mathml)
+ ;; Process to MathML
+ (unless executables-checked
+ (unless (save-match-data (org-format-latex-mathml-available-p))
+ (error "LaTeX to MathML converter not configured"))
+ (setq executables-checked t))
+ (setq txt (match-string n)
+ beg (match-beginning n) end (match-end n)
+ cnt (1+ cnt))
+ (if msg (message msg cnt))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-mathml
+ txt block-type prefix dir)))
+ (t
+ (error "Unknown conversion type %s for latex fragments"
+ processing-type)))))))))
+
+(defun org-create-math-formula (latex-frag &optional mathml-file)
+ "Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
+Use `org-latex-to-mathml-convert-command'. If the conversion is
+sucessful, return the portion between \"<math...> </math>\"
+elements otherwise return nil. When MATHML-FILE is specified,
+write the results in to that file. When invoked as an
+interactive command, prompt for LATEX-FRAG, with initial value
+set to the current active region and echo the results for user
+inspection."
+ (interactive (list (let ((frag (when (org-region-active-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))))
+ (read-string "LaTeX Fragment: " frag nil frag))))
+ (unless latex-frag (error "Invalid latex-frag"))
+ (let* ((tmp-in-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-in"))))
+ (ignore (write-region latex-frag nil tmp-in-file))
+ (tmp-out-file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-out"))))
+ (cmd (format-spec
+ org-latex-to-mathml-convert-command
+ `((?j . ,(shell-quote-argument
+ (expand-file-name org-latex-to-mathml-jar-file)))
+ (?I . ,(shell-quote-argument tmp-in-file))
+ (?o . ,(shell-quote-argument tmp-out-file)))))
+ mathml shell-command-output)
+ (when (org-called-interactively-p 'any)
+ (unless (org-format-latex-mathml-available-p)
+ (error "LaTeX to MathML converter not configured")))
+ (message "Running %s" cmd)
+ (setq shell-command-output (shell-command-to-string cmd))
+ (setq mathml
+ (when (file-readable-p tmp-out-file)
+ (with-current-buffer (find-file-noselect tmp-out-file t)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat
+ (regexp-quote
+ "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">")
+ "\\(.\\|\n\\)*"
+ (regexp-quote "</math>")) nil t)
+ (prog1 (match-string 0) (kill-buffer))))))
+ (cond
+ (mathml
+ (setq mathml
+ (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
+ (when mathml-file
+ (write-region mathml nil mathml-file))
+ (when (org-called-interactively-p 'any)
+ (message mathml)))
+ ((message "LaTeX to MathML conversion failed")
+ (message shell-command-output)))
+ (delete-file tmp-in-file)
+ (when (file-exists-p tmp-out-file)
+ (delete-file tmp-out-file))
+ mathml))
+
+(defun org-format-latex-as-mathml (latex-frag latex-frag-type
+ prefix &optional dir)
+ "Use `org-create-math-formula' but check local cache first."
+ (let* ((absprefix (expand-file-name prefix dir))
+ (print-length nil) (print-level nil)
+ (formula-id (concat
+ "formula-"
+ (sha1
+ (prin1-to-string
+ (list latex-frag
+ org-latex-to-mathml-convert-command)))))
+ (formula-cache (format "%s-%s.mathml" absprefix formula-id))
+ (formula-cache-dir (file-name-directory formula-cache)))
+
+ (unless (file-directory-p formula-cache-dir)
+ (make-directory formula-cache-dir t))
+
+ (unless (file-exists-p formula-cache)
+ (org-create-math-formula latex-frag formula-cache))
+
+ (if (file-exists-p formula-cache)
+ ;; Successful conversion. Return the link to MathML file.
+ (org-add-props
+ (format "[[file:%s]]" (file-relative-name formula-cache dir))
+ (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag)
+ 'org-latex-src-embed-type (if latex-frag-type
+ 'paragraph 'character)))
+ ;; Failed conversion. Return the LaTeX fragment verbatim
+ (add-text-properties
+ 0 (1- (length latex-frag)) '(org-protected t) latex-frag)
+ latex-frag)))
+
+;; This function borrows from Ganesh Swami's latex2png.el
+(defun org-create-formula-image-with-dvipng (string tofile options buffer)
+ "This calls dvipng."
+ (require 'org-latex)
+ (let* ((tmpdir (if (featurep 'xemacs)
+ (temp-directory)
+ temporary-file-directory))
+ (texfilebase (make-temp-name
+ (expand-file-name "orgtex" tmpdir)))
+ (texfile (concat texfilebase ".tex"))
+ (dvifile (concat texfilebase ".dvi"))
+ (pngfile (concat texfilebase ".png"))
+ (fnh (if (featurep 'xemacs)
+ (font-height (face-font 'default))
+ (face-attribute 'default :height nil)))
+ (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
+ (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (fg (or (plist-get options (if buffer :foreground :html-foreground))
+ "Black"))
+ (bg (or (plist-get options (if buffer :background :html-background))
+ "Transparent")))
+ (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)))
+ (if (eq bg 'default) (setq bg (org-dvipng-color :background)))
+ (with-temp-file texfile
+ (insert (org-splice-latex-header
+ org-format-latex-header
+ org-export-latex-default-packages-alist
+ org-export-latex-packages-alist t
+ org-format-latex-header-extra))
+ (insert "\n\\begin{document}\n" string "\n\\end{document}\n")
+ (require 'org-latex)
+ (org-export-latex-fix-inputenc))
+ (let ((dir default-directory))
+ (condition-case nil
+ (progn
+ (cd tmpdir)
+ (call-process "latex" nil nil nil texfile))
+ (error nil))
+ (cd dir))
+ (if (not (file-exists-p dvifile))
+ (progn (message "Failed to create dvi file from %s" texfile) nil)
+ (condition-case nil
+ (if (featurep 'xemacs)
+ (call-process "dvipng" nil nil nil
+ "-fg" fg "-bg" bg
+ "-T" "tight"
+ "-o" pngfile
+ dvifile)
+ (call-process "dvipng" nil nil nil
+ "-fg" fg "-bg" bg
+ "-D" dpi
+ ;;"-x" scale "-y" scale
+ "-T" "tight"
+ "-o" pngfile
+ dvifile))
+ (error nil))
+ (if (not (file-exists-p pngfile))
+ (if org-format-latex-signal-error
+ (error "Failed to create png file from %s" texfile)
+ (message "Failed to create png file from %s" texfile)
+ nil)
+ ;; Use the requested file name and clean up
+ (copy-file pngfile tofile 'replace)
+ (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do
+ (if (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
+ pngfile))))
+
+(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el
+(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
+ "This calls convert, which is included into imagemagick."
+ (require 'org-latex)
+ (let* ((tmpdir (if (featurep 'xemacs)
+ (temp-directory)
+ temporary-file-directory))
+ (texfilebase (make-temp-name
+ (expand-file-name "orgtex" tmpdir)))
+ (texfile (concat texfilebase ".tex"))
+ (pdffile (concat texfilebase ".pdf"))
+ (pngfile (concat texfilebase ".png"))
+ (fnh (if (featurep 'xemacs)
+ (font-height (face-font 'default))
+ (face-attribute 'default :height nil)))
+ (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
+ (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (fg (or (plist-get options (if buffer :foreground :html-foreground))
+ "black"))
+ (bg (or (plist-get options (if buffer :background :html-background))
+ "white")))
+ (if (eq fg 'default) (setq fg (org-latex-color :foreground))
+ (setq fg (org-latex-color-format fg)))
+ (if (eq bg 'default) (setq bg (org-latex-color :background))
+ (setq bg (org-latex-color-format
+ (if (string= bg "Transparent")(setq bg "white")))))
+ (with-temp-file texfile
+ (insert (org-splice-latex-header
+ org-format-latex-header
+ org-export-latex-default-packages-alist
+ org-export-latex-packages-alist t
+ org-format-latex-header-extra))
+ (insert "\n\\begin{document}\n"
+ "\\definecolor{fg}{rgb}{" fg "}\n"
+ "\\definecolor{bg}{rgb}{" bg "}\n"
+ "\n\\pagecolor{bg}\n"
+ "\n{\\color{fg}\n"
+ string
+ "\n}\n"
+ "\n\\end{document}\n" )
+ (require 'org-latex)
+ (org-export-latex-fix-inputenc))
+ (let ((dir default-directory) cmd cmds latex-frags-cmds)
+ (condition-case nil
+ (progn
+ (cd tmpdir)
+ (setq cmds org-latex-to-pdf-process)
+ (while cmds
+ (setq latex-frags-cmds (pop cmds))
+ (if (listp latex-frags-cmds)
+ (setq cmds nil)
+ (setq latex-frags-cmds (list (car org-latex-to-pdf-process)))))
+ (while latex-frags-cmds
+ (setq cmd (pop latex-frags-cmds))
+ (while (string-match "%b" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument texfile))
+ t t cmd)))
+ (while (string-match "%f" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument (file-name-nondirectory texfile)))
+ t t cmd)))
+ (while (string-match "%o" cmd)
+ (setq cmd (replace-match
+ (save-match-data
+ (shell-quote-argument (file-name-directory texfile)))
+ t t cmd)))
+ (setq cmd (split-string cmd))
+ (eval (append (list 'call-process (pop cmd) nil nil nil) cmd))))
+ (error nil))
+ (cd dir))
+ (if (not (file-exists-p pdffile))
+ (progn (message "Failed to create pdf file from %s" texfile) nil)
+ (condition-case nil
+ (if (featurep 'xemacs)
+ (call-process "convert" nil nil nil
+ "-density" "96"
+ "-trim"
+ "-antialias"
+ pdffile
+ "-quality" "100"
+ ;; "-sharpen" "0x1.0"
+ pngfile)
+ (call-process "convert" nil nil nil
+ "-density" dpi
+ "-trim"
+ "-antialias"
+ pdffile
+ "-quality" "100"
+ ; "-sharpen" "0x1.0"
+ pngfile))
+ (error nil))
+ (if (not (file-exists-p pngfile))
+ (if org-format-latex-signal-error
+ (error "Failed to create png file from %s" texfile)
+ (message "Failed to create png file from %s" texfile)
+ nil)
+ ;; Use the requested file name and clean up
+ (copy-file pngfile tofile 'replace)
+ (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do
+ (if (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
+ pngfile))))
+
+(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
+ "Fill a LaTeX header template TPL.
+In the template, the following place holders will be recognized:
+
+ [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG
+ [NO-DEFAULT-PACKAGES] do not include DEF-PKG
+ [PACKAGES] \\usepackage statements for PKG
+ [NO-PACKAGES] do not include PKG
+ [EXTRA] the string EXTRA
+ [NO-EXTRA] do not include EXTRA
+
+For backward compatibility, if both the positive and the negative place
+holder is missing, the positive one (without the \"NO-\") will be
+assumed to be present at the end of the template.
+DEF-PKG and PKG are assumed to be alists of options/packagename lists.
+EXTRA is a string.
+SNIPPETS-P indicates if this is run to create snippet images for HTML."
+ (let (rpl (end ""))
+ (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl)
+ (setq rpl (if (or (match-end 1) (not def-pkg))
+ "" (org-latex-packages-to-string def-pkg snippets-p t))
+ tpl (replace-match rpl t t tpl))
+ (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
+
+ (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
+ (setq rpl (if (or (match-end 1) (not pkg))
+ "" (org-latex-packages-to-string pkg snippets-p t))
+ tpl (replace-match rpl t t tpl))
+ (if pkg (setq end
+ (concat end "\n"
+ (org-latex-packages-to-string pkg snippets-p)))))
+
+ (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
+ (setq rpl (if (or (match-end 1) (not extra))
+ "" (concat extra "\n"))
+ tpl (replace-match rpl t t tpl))
+ (if (and extra (string-match "\\S-" extra))
+ (setq end (concat end "\n" extra))))
+
+ (if (string-match "\\S-" end)
+ (concat tpl "\n" end)
+ tpl)))
+
+(defun org-latex-packages-to-string (pkg &optional snippets-p newline)
+ "Turn an alist of packages into a string with the \\usepackage macros."
+ (setq pkg (mapconcat (lambda(p)
+ (cond
+ ((stringp p) p)
+ ((and snippets-p (>= (length p) 3) (not (nth 2 p)))
+ (format "%% Package %s omitted" (cadr p)))
+ ((equal "" (car p))
+ (format "\\usepackage{%s}" (cadr p)))
+ (t
+ (format "\\usepackage[%s]{%s}"
+ (car p) (cadr p)))))
+ pkg
+ "\n"))
+ (if newline (concat pkg "\n") pkg))
+
+(defun org-dvipng-color (attr)
+ "Return a RGB color specification for dvipng."
+ (apply 'format "rgb %s %s %s"
+ (mapcar 'org-normalize-color
+ (if (featurep 'xemacs)
+ (color-rgb-components
+ (face-property 'default
+ (cond ((eq attr :foreground) 'foreground)
+ ((eq attr :background) 'background))))
+ (color-values (face-attribute 'default attr nil))))))
+
+(defun org-latex-color (attr)
+ "Return a RGB color for the LaTeX color package."
+ (apply 'format "%s,%s,%s"
+ (mapcar 'org-normalize-color
+ (if (featurep 'xemacs)
+ (color-rgb-components
+ (face-property 'default
+ (cond ((eq attr :foreground) 'foreground)
+ ((eq attr :background) 'background))))
+ (color-values (face-attribute 'default attr nil))))))
+
+(defun org-latex-color-format (color-name)
+ "Convert COLOR-NAME to a RGB color value."
+ (apply 'format "%s,%s,%s"
+ (mapcar 'org-normalize-color
+ (color-values color-name))))
+
+(defun org-normalize-color (value)
+ "Return string to be used as color value for an RGB component."
+ (format "%g" (/ value 65535.0)))
+
+;; Image display
+
+
+(defvar org-inline-image-overlays nil)
+(make-variable-buffer-local 'org-inline-image-overlays)
+
+(defun org-toggle-inline-images (&optional include-linked)
+ "Toggle the display of inline images.
+INCLUDE-LINKED is passed to `org-display-inline-images'."
+ (interactive "P")
+ (if org-inline-image-overlays
+ (progn
+ (org-remove-inline-images)
+ (message "Inline image display turned off"))
+ (org-display-inline-images include-linked)
+ (if org-inline-image-overlays
+ (message "%d images displayed inline"
+ (length org-inline-image-overlays))
+ (message "No images to display inline"))))
+
+(defun org-redisplay-inline-images ()
+ "Refresh the display of inline images."
+ (interactive)
+ (if (not org-inline-image-overlays)
+ (org-toggle-inline-images)
+ (org-toggle-inline-images)
+ (org-toggle-inline-images)))
+
+(defun org-display-inline-images (&optional include-linked refresh beg end)
+ "Display inline images.
+Normally only links without a description part are inlined, because this
+is how it will work for export. When INCLUDE-LINKED is set, also links
+with a description part will be inlined. This can be nice for a quick
+look at those images, but it does not reflect what exported files will look
+like.
+When REFRESH is set, refresh existing images between BEG and END.
+This will create new image displays only if necessary.
+BEG and END default to the buffer boundaries."
+ (interactive "P")
+ (unless refresh
+ (org-remove-inline-images)
+ (if (fboundp 'clear-image-cache) (clear-image-cache)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+ (goto-char beg)
+ (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]" (if include-linked "" "\\]")))
+ old file ov img)
+ (while (re-search-forward re end t)
+ (setq old (get-char-property-and-overlay (match-beginning 1)
+ 'org-image-overlay))
+ (setq file (expand-file-name
+ (concat (or (match-string 3) "") (match-string 4))))
+ (when (file-exists-p file)
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (setq img (save-match-data (create-image file)))
+ (when img
+ (setq ov (make-overlay (match-beginning 0) (match-end 0)))
+ (overlay-put ov 'display img)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put ov 'modification-hooks
+ (list 'org-display-inline-remove-overlay))
+ (push ov org-inline-image-overlays)))))))))
+
+(define-obsolete-function-alias
+ 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
+
+(defun org-display-inline-remove-overlay (ov after beg end &optional len)
+ "Remove inline-display overlay if a corresponding region is modified."
+ (let ((inhibit-modification-hooks t))
+ (when (and ov after)
+ (delete ov org-inline-image-overlays)
+ (delete-overlay ov))))
+
+(defun org-remove-inline-images ()
+ "Remove inline display of images."
+ (interactive)
+ (mapc 'delete-overlay org-inline-image-overlays)
+ (setq org-inline-image-overlays nil))
+
+;;;; Key bindings
+
+;; Outline functions from `outline-mode-prefix-map'
+;; that can be remapped in Org:
+(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
+(define-key org-mode-map [remap show-subtree] 'org-show-subtree)
+(define-key org-mode-map [remap outline-forward-same-level]
+ 'org-forward-heading-same-level)
+(define-key org-mode-map [remap outline-backward-same-level]
+ 'org-backward-heading-same-level)
+(define-key org-mode-map [remap show-branches]
+ 'org-kill-note-or-show-branches)
+(define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
+(define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
+(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
+
+;; Outline functions from `outline-mode-prefix-map' that can not
+;; be remapped in Org:
+;;
+;; - the column "key binding" shows whether the Outline function is still
+;; available in Org mode on the same key that it has been bound to in
+;; Outline mode:
+;; - "overridden": key used for a different functionality in Org mode
+;; - else: key still bound to the same Outline function in Org mode
+;;
+;; | Outline function | key binding | Org replacement |
+;; |------------------------------------+-------------+-----------------------|
+;; | `outline-next-visible-heading' | `C-c C-n' | still same function |
+;; | `outline-previous-visible-heading' | `C-c C-p' | still same function |
+;; | `outline-up-heading' | `C-c C-u' | still same function |
+;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
+;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
+;; | `show-entry' | overridden | no replacement |
+;; | `show-children' | `C-c C-i' | visibility cycling |
+;; | `show-branches' | `C-c C-k' | still same function |
+;; | `show-subtree' | overridden | visibility cycling |
+;; | `show-all' | overridden | no replacement |
+;; | `hide-subtree' | overridden | visibility cycling |
+;; | `hide-body' | overridden | no replacement |
+;; | `hide-entry' | overridden | visibility cycling |
+;; | `hide-leaves' | overridden | no replacement |
+;; | `hide-sublevels' | overridden | no replacement |
+;; | `hide-other' | overridden | no replacement |
+
+;; Make `C-c C-x' a prefix key
+(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
+
+;; TAB key with modifiers
+(org-defkey org-mode-map "\C-i" 'org-cycle)
+(org-defkey org-mode-map [(tab)] 'org-cycle)
+(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
+(org-defkey org-mode-map "\M-\t" 'pcomplete)
+;; The following line is necessary under Suse GNU/Linux
+(unless (featurep 'xemacs)
+ (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
+(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
+(define-key org-mode-map [backtab] 'org-shifttab)
+
+(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
+(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
+(org-defkey org-mode-map [(meta return)] 'org-meta-return)
+
+;; Cursor keys with modifiers
+(org-defkey org-mode-map [(meta left)] 'org-metaleft)
+(org-defkey org-mode-map [(meta right)] 'org-metaright)
+(org-defkey org-mode-map [(meta up)] 'org-metaup)
+(org-defkey org-mode-map [(meta down)] 'org-metadown)
+
+(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
+(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
+(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
+(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
+
+(org-defkey org-mode-map [(shift up)] 'org-shiftup)
+(org-defkey org-mode-map [(shift down)] 'org-shiftdown)
+(org-defkey org-mode-map [(shift left)] 'org-shiftleft)
+(org-defkey org-mode-map [(shift right)] 'org-shiftright)
+
+(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
+(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
+(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup)
+(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown)
+
+;; Babel keys
+(define-key org-mode-map org-babel-key-prefix org-babel-map)
+(mapc (lambda (pair)
+ (define-key org-babel-map (car pair) (cdr pair)))
+ org-babel-key-bindings)
+
+;;; Extra keys for tty access.
+;; We only set them when really needed because otherwise the
+;; menus don't show the simple keys
+
+(when (or org-use-extra-keys
+ (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
+ (not window-system))
+ (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
+ (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
+ (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
+ (org-defkey org-mode-map [?\e (return)] 'org-meta-return)
+ (org-defkey org-mode-map [?\e (left)] 'org-metaleft)
+ (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
+ (org-defkey org-mode-map [?\e (right)] 'org-metaright)
+ (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
+ (org-defkey org-mode-map [?\e (up)] 'org-metaup)
+ (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
+ (org-defkey org-mode-map [?\e (down)] 'org-metadown)
+ (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
+ (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
+ (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
+ (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
+ (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
+ (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
+ (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
+ (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
+ (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
+ (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
+ (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
+ (org-defkey org-mode-map [?\e (tab)] 'pcomplete)
+ (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
+ (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
+ (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
+ (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
+ (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
+
+;; All the other keys
+
+(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
+(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
+(if (boundp 'narrow-map)
+ (org-defkey narrow-map "s" 'org-narrow-to-subtree)
+ (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
+(if (boundp 'narrow-map)
+ (org-defkey narrow-map "b" 'org-narrow-to-block)
+ (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block))
+(if (boundp 'narrow-map)
+ (org-defkey narrow-map "e" 'org-narrow-to-element)
+ (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
+(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element)
+(org-defkey org-mode-map "\M-}" 'org-forward-element)
+(org-defkey org-mode-map "\M-{" 'org-backward-element)
+(org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
+(org-defkey org-mode-map "\C-c\C-_" 'org-down-element)
+(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level)
+(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level)
+(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
+(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
+(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
+(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
+(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
+(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
+(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
+(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
+(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
+(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
+(org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
+(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
+(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
+(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
+(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
+(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
+(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
+(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
+(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
+(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
+(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
+(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
+(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
+(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
+(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
+(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
+(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
+(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
+(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
+(org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding
+(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
+(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
+(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
+(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
+(org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
+(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
+(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
+(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
+(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
+(org-defkey org-mode-map "\C-c]" 'org-remove-file)
+(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
+(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
+(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
+(org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star)
+(org-defkey org-mode-map "\C-c^" 'org-sort)
+(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
+(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
+(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
+(org-defkey org-mode-map "\C-m" 'org-return)
+(org-defkey org-mode-map "\C-j" 'org-return-indent)
+(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
+(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
+(org-defkey org-mode-map "\C-c+" 'org-table-sum)
+(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
+(org-defkey org-mode-map "\C-c'" 'org-edit-special)
+(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
+(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
+(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
+(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
+(org-defkey org-mode-map "\C-c\C-a" 'org-attach)
+(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
+(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
+(org-defkey org-mode-map "\C-c\C-e" 'org-export)
+(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
+(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
+(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
+(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
+(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
+(org-defkey org-mode-map "\C-c@" 'org-mark-subtree)
+(org-defkey org-mode-map "\M-h" 'org-mark-element)
+(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
+;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
+
+(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
+(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
+(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
+(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
+
+(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
+(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
+(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last)
+(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks)
+(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
+(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
+(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel)
+(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
+(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
+(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
+(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
+(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
+(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
+(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
+(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
+(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
+(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
+(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
+(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
+(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
+(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
+(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer)
+
+(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
+(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
+(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
+(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop)
+(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
+
+(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
+
+(define-key org-mode-map "\C-c\C-x!" 'org-reload)
+
+(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
+(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
+
+(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
+
+
+(when (featurep 'xemacs)
+ (org-defkey org-mode-map 'button3 'popup-mode-menu))
+
+
+(defconst org-speed-commands-default
+ '(
+ ("Outline Navigation")
+ ("n" . (org-speed-move-safe 'outline-next-visible-heading))
+ ("p" . (org-speed-move-safe 'outline-previous-visible-heading))
+ ("f" . (org-speed-move-safe 'org-forward-heading-same-level))
+ ("b" . (org-speed-move-safe 'org-backward-heading-same-level))
+ ("u" . (org-speed-move-safe 'outline-up-heading))
+ ("j" . org-goto)
+ ("g" . (org-refile t))
+ ("Outline Visibility")
+ ("c" . org-cycle)
+ ("C" . org-shifttab)
+ (" " . org-display-outline-path)
+ (":" . org-columns)
+ ("Outline Structure Editing")
+ ("U" . org-shiftmetaup)
+ ("D" . org-shiftmetadown)
+ ("r" . org-metaright)
+ ("l" . org-metaleft)
+ ("R" . org-shiftmetaright)
+ ("L" . org-shiftmetaleft)
+ ("i" . (progn (forward-char 1) (call-interactively
+ 'org-insert-heading-respect-content)))
+ ("^" . org-sort)
+ ("w" . org-refile)
+ ("a" . org-archive-subtree-default-with-confirmation)
+ ("." . org-mark-subtree)
+ ("#" . org-toggle-comment)
+ ("Clock Commands")
+ ("I" . org-clock-in)
+ ("O" . org-clock-out)
+ ("Meta Data Editing")
+ ("t" . org-todo)
+ ("," . (org-priority))
+ ("0" . (org-priority ?\ ))
+ ("1" . (org-priority ?A))
+ ("2" . (org-priority ?B))
+ ("3" . (org-priority ?C))
+ (";" . org-set-tags-command)
+ ("e" . org-set-effort)
+ ("E" . org-inc-effort)
+ ("W" . (lambda(m) (interactive "sMinutes before warning: ")
+ (org-entry-put (point) "APPT_WARNTIME" m)))
+ ("Agenda Views etc")
+ ("v" . org-agenda)
+ ("/" . org-sparse-tree)
+ ("Misc")
+ ("o" . org-open-at-point)
+ ("?" . org-speed-command-help)
+ ("<" . (org-agenda-set-restriction-lock 'subtree))
+ (">" . (org-agenda-remove-restriction-lock))
+ )
+ "The default speed commands.")
+
+(defun org-print-speed-command (e)
+ (if (> (length (car e)) 1)
+ (progn
+ (princ "\n")
+ (princ (car e))
+ (princ "\n")
+ (princ (make-string (length (car e)) ?-))
+ (princ "\n"))
+ (princ (car e))
+ (princ " ")
+ (if (symbolp (cdr e))
+ (princ (symbol-name (cdr e)))
+ (prin1 (cdr e)))
+ (princ "\n")))
+
+(defun org-speed-command-help ()
+ "Show the available speed commands."
+ (interactive)
+ (if (not org-use-speed-commands)
+ (error "Speed commands are not activated, customize `org-use-speed-commands'")
+ (with-output-to-temp-buffer "*Help*"
+ (princ "User-defined Speed commands\n===========================\n")
+ (mapc 'org-print-speed-command org-speed-commands-user)
+ (princ "\n")
+ (princ "Built-in Speed commands\n=======================\n")
+ (mapc 'org-print-speed-command org-speed-commands-default))
+ (with-current-buffer "*Help*"
+ (setq truncate-lines t))))
+
+(defun org-speed-move-safe (cmd)
+ "Execute CMD, but make sure that the cursor always ends up in a headline.
+If not, return to the original position and throw an error."
+ (interactive)
+ (let ((pos (point)))
+ (call-interactively cmd)
+ (unless (and (bolp) (org-at-heading-p))
+ (goto-char pos)
+ (error "Boundary reached while executing %s" cmd))))
+
+(defvar org-self-insert-command-undo-counter 0)
+
+(defvar org-table-auto-blank-field) ; defined in org-table.el
+(defvar org-speed-command nil)
+
+(define-obsolete-function-alias
+ 'org-speed-command-default-hook 'org-speed-command-activate "24.3")
+
+(defun org-speed-command-activate (keys)
+ "Hook for activating single-letter speed commands.
+`org-speed-commands-default' specifies a minimal command set.
+Use `org-speed-commands-user' for further customization."
+ (when (or (and (bolp) (looking-at org-outline-regexp))
+ (and (functionp org-use-speed-commands)
+ (funcall org-use-speed-commands)))
+ (cdr (assoc keys (append org-speed-commands-user
+ org-speed-commands-default)))))
+
+(define-obsolete-function-alias
+ 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3")
+
+(defun org-babel-speed-command-activate (keys)
+ "Hook for activating single-letter code block commands."
+ (when (and (bolp) (looking-at org-babel-src-block-regexp))
+ (cdr (assoc keys org-babel-key-bindings))))
+
+(defcustom org-speed-command-hook
+ '(org-speed-command-default-hook org-babel-speed-command-hook)
+ "Hook for activating speed commands at strategic locations.
+Hook functions are called in sequence until a valid handler is
+found.
+
+Each hook takes a single argument, a user-pressed command key
+which is also a `self-insert-command' from the global map.
+
+Within the hook, examine the cursor position and the command key
+and return nil or a valid handler as appropriate. Handler could
+be one of an interactive command, a function, or a form.
+
+Set `org-use-speed-commands' to non-nil value to enable this
+hook. The default setting is `org-speed-command-activate'."
+ :group 'org-structure
+ :version "24.1"
+ :type 'hook)
+
+(defun org-self-insert-command (N)
+ "Like `self-insert-command', use overwrite-mode for whitespace in tables.
+If the cursor is in a table looking at whitespace, the whitespace is
+overwritten, and the table is not marked as requiring realignment."
+ (interactive "p")
+ (org-check-before-invisible-edit 'insert)
+ (cond
+ ((and org-use-speed-commands
+ (setq org-speed-command
+ (run-hook-with-args-until-success
+ 'org-speed-command-hook (this-command-keys))))
+ (cond
+ ((commandp org-speed-command)
+ (setq this-command org-speed-command)
+ (call-interactively org-speed-command))
+ ((functionp org-speed-command)
+ (funcall org-speed-command))
+ ((and org-speed-command (listp org-speed-command))
+ (eval org-speed-command))
+ (t (let (org-use-speed-commands)
+ (call-interactively 'org-self-insert-command)))))
+ ((and
+ (org-table-p)
+ (progn
+ ;; check if we blank the field, and if that triggers align
+ (and (featurep 'org-table) org-table-auto-blank-field
+ (member last-command
+ '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
+ (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
+ ;; got extra space, this field does not determine column width
+ (let (org-table-may-need-update) (org-table-blank-field))
+ ;; no extra space, this field may determine column width
+ (org-table-blank-field)))
+ t)
+ (eq N 1)
+ (looking-at "[^|\n]* |"))
+ (let (org-table-may-need-update)
+ (goto-char (1- (match-end 0)))
+ (backward-delete-char 1)
+ (goto-char (match-beginning 0))
+ (self-insert-command N)))
+ (t
+ (setq org-table-may-need-update t)
+ (self-insert-command N)
+ (org-fix-tags-on-the-fly)
+ (if org-self-insert-cluster-for-undo
+ (if (not (eq last-command 'org-self-insert-command))
+ (setq org-self-insert-command-undo-counter 1)
+ (if (>= org-self-insert-command-undo-counter 20)
+ (setq org-self-insert-command-undo-counter 1)
+ (and (> org-self-insert-command-undo-counter 0)
+ buffer-undo-list (listp buffer-undo-list)
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq org-self-insert-command-undo-counter
+ (1+ org-self-insert-command-undo-counter))))))))
+
+(defun org-check-before-invisible-edit (kind)
+ "Check is editing if kind KIND would be dangerous with invisible text around.
+The detailed reaction depends on the user option `org-catch-invisible-edits'."
+ ;; First, try to get out of here as quickly as possible, to reduce overhead
+ (if (and org-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look
+ (let* ((invisible-at-point (get-char-property (point) 'invisible))
+ (invisible-before-point (if (bobp) nil (get-char-property
+ (1- (point)) 'invisible)))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible text
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or (memq invisible-at-point '(outline org-hide-block t))
+ (memq invisible-before-point '(outline org-hide-block t)))
+ (if (eq org-catch-invisible-edits 'error)
+ (error "Editing in invisible areas is prohibited - make visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (if invisible-before-point
+ (goto-char (previous-single-char-property-change
+ (point) 'invisible)))
+ (org-cycle))
+ (cond
+ ((eq org-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+
+(defun org-fix-tags-on-the-fly ()
+ (when (and (equal (char-after (point-at-bol)) ?*)
+ (org-at-heading-p))
+ (org-align-tags-here org-tags-column)))
+
+(defun org-delete-backward-char (N)
+ "Like `delete-backward-char', insert whitespace at field end in tables.
+When deleting backwards, in tables this function will insert whitespace in
+front of the next \"|\" separator, to keep the table aligned. The table will
+still be marked for re-alignment if the field did fill the entire column,
+because, in this case the deletion might narrow the column."
+ (interactive "p")
+ (org-check-before-invisible-edit 'delete-backward)
+ (if (and (org-table-p)
+ (eq N 1)
+ (string-match "|" (buffer-substring (point-at-bol) (point)))
+ (looking-at ".*?|"))
+ (let ((pos (point))
+ (noalign (looking-at "[^|\n\r]* |"))
+ (c org-table-may-need-update))
+ (backward-delete-char N)
+ (if (not overwrite-mode)
+ (progn
+ (skip-chars-forward "^|")
+ (insert " ")
+ (goto-char (1- pos))))
+ ;; noalign: if there were two spaces at the end, this field
+ ;; does not determine the width of the column.
+ (if noalign (setq org-table-may-need-update c)))
+ (backward-delete-char N)
+ (org-fix-tags-on-the-fly)))
+
+(defun org-delete-char (N)
+ "Like `delete-char', but insert whitespace at field end in tables.
+When deleting characters, in tables this function will insert whitespace in
+front of the next \"|\" separator, to keep the table aligned. The table will
+still be marked for re-alignment if the field did fill the entire column,
+because, in this case the deletion might narrow the column."
+ (interactive "p")
+ (org-check-before-invisible-edit 'delete)
+ (if (and (org-table-p)
+ (not (bolp))
+ (not (= (char-after) ?|))
+ (eq N 1))
+ (if (looking-at ".*?|")
+ (let ((pos (point))
+ (noalign (looking-at "[^|\n\r]* |"))
+ (c org-table-may-need-update))
+ (replace-match (concat
+ (substring (match-string 0) 1 -1)
+ " |"))
+ (goto-char pos)
+ ;; noalign: if there were two spaces at the end, this field
+ ;; does not determine the width of the column.
+ (if noalign (setq org-table-may-need-update c)))
+ (delete-char N))
+ (delete-char N)
+ (org-fix-tags-on-the-fly)))
+
+;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
+(put 'org-self-insert-command 'delete-selection t)
+(put 'orgtbl-self-insert-command 'delete-selection t)
+(put 'org-delete-char 'delete-selection 'supersede)
+(put 'org-delete-backward-char 'delete-selection 'supersede)
+(put 'org-yank 'delete-selection 'yank)
+
+;; Make `flyspell-mode' delay after some commands
+(put 'org-self-insert-command 'flyspell-delayed t)
+(put 'orgtbl-self-insert-command 'flyspell-delayed t)
+(put 'org-delete-char 'flyspell-delayed t)
+(put 'org-delete-backward-char 'flyspell-delayed t)
+
+;; Make pabbrev-mode expand after org-mode commands
+(put 'org-self-insert-command 'pabbrev-expand-after-command t)
+(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
+
+;; How to do this: Measure non-white length of current string
+;; If equal to column width, we should realign.
+
+(defun org-remap (map &rest commands)
+ "In MAP, remap the functions given in COMMANDS.
+COMMANDS is a list of alternating OLDDEF NEWDEF command names."
+ (let (new old)
+ (while commands
+ (setq old (pop commands) new (pop commands))
+ (if (fboundp 'command-remapping)
+ (org-defkey map (vector 'remap old) new)
+ (substitute-key-definition old new map global-map)))))
+
+(when (eq org-enable-table-editor 'optimized)
+ ;; If the user wants maximum table support, we need to hijack
+ ;; some standard editing functions
+ (org-remap org-mode-map
+ 'self-insert-command 'org-self-insert-command
+ 'delete-char 'org-delete-char
+ 'delete-backward-char 'org-delete-backward-char)
+ (org-defkey org-mode-map "|" 'org-force-self-insert))
+
+(defvar org-ctrl-c-ctrl-c-hook nil
+ "Hook for functions attaching themselves to `C-c C-c'.
+
+This can be used to add additional functionality to the C-c C-c
+key which executes context-dependent commands. This hook is run
+before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
+run after the last test.
+
+Each function will be called with no arguments. The function
+must check if the context is appropriate for it to act. If yes,
+it should do its thing and then return a non-nil value. If the
+context is wrong, just do nothing and return nil.")
+
+(defvar org-ctrl-c-ctrl-c-final-hook nil
+ "Hook for functions attaching themselves to `C-c C-c'.
+
+This can be used to add additional functionality to the C-c C-c
+key which executes context-dependent commands. This hook is run
+after any other test, while `org-ctrl-c-ctrl-c-hook' is run
+before the first test.
+
+Each function will be called with no arguments. The function
+must check if the context is appropriate for it to act. If yes,
+it should do its thing and then return a non-nil value. If the
+context is wrong, just do nothing and return nil.")
+
+(defvar org-tab-first-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs as the first action when TAB is pressed, even before
+`org-cycle' messes around with the `outline-regexp' to cater for
+inline tasks and plain list item folding.
+If any function in this hook returns t, any other actions that
+would have been caused by TAB (such as table field motion or visibility
+cycling) will not occur.")
+
+(defvar org-tab-after-check-for-table-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after it has been established that the cursor is not in a
+table, but before checking if the cursor is in a headline or if global cycling
+should be done.
+If any function in this hook returns t, not other actions like visibility
+cycling will be done.")
+
+(defvar org-tab-after-check-for-cycling-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after it has been established that not table field motion and
+not visibility should be done because of current context. This is probably
+the place where a package like yasnippets can hook in.")
+
+(defvar org-tab-before-tab-emulation-hook nil
+ "Hook for functions to attach themselves to TAB.
+See `org-ctrl-c-ctrl-c-hook' for more information.
+This hook runs after every other options for TAB have been exhausted, but
+before indentation and \t insertion takes place.")
+
+(defvar org-metaleft-hook nil
+ "Hook for functions attaching themselves to `M-left'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaright-hook nil
+ "Hook for functions attaching themselves to `M-right'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metaup-hook nil
+ "Hook for functions attaching themselves to `M-up'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metadown-hook nil
+ "Hook for functions attaching themselves to `M-down'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaleft-hook nil
+ "Hook for functions attaching themselves to `M-S-left'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaright-hook nil
+ "Hook for functions attaching themselves to `M-S-right'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetaup-hook nil
+ "Hook for functions attaching themselves to `M-S-up'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftmetadown-hook nil
+ "Hook for functions attaching themselves to `M-S-down'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-metareturn-hook nil
+ "Hook for functions attaching themselves to `M-RET'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftup-hook nil
+ "Hook for functions attaching themselves to `S-up'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftup-final-hook nil
+ "Hook for functions attaching themselves to `S-up'.
+This one runs after all other options except shift-select have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftdown-hook nil
+ "Hook for functions attaching themselves to `S-down'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftdown-final-hook nil
+ "Hook for functions attaching themselves to `S-down'.
+This one runs after all other options except shift-select have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftleft-hook nil
+ "Hook for functions attaching themselves to `S-left'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftleft-final-hook nil
+ "Hook for functions attaching themselves to `S-left'.
+This one runs after all other options except shift-select have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftright-hook nil
+ "Hook for functions attaching themselves to `S-right'.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+(defvar org-shiftright-final-hook nil
+ "Hook for functions attaching themselves to `S-right'.
+This one runs after all other options except shift-select have been excluded.
+See `org-ctrl-c-ctrl-c-hook' for more information.")
+
+(defun org-modifier-cursor-error ()
+ "Throw an error, a modified cursor command was applied in wrong context."
+ (error "This command is active in special context like tables, headlines or items"))
+
+(defun org-shiftselect-error ()
+ "Throw an error because Shift-Cursor command was applied in wrong context."
+ (if (and (boundp 'shift-select-mode) shift-select-mode)
+ (error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (error "This command works only in special context like headlines or timestamps")))
+
+(defun org-call-for-shift-select (cmd)
+ (let ((this-command-keys-shift-translated t))
+ (call-interactively cmd)))
+
+(defun org-shifttab (&optional arg)
+ "Global visibility cycling or move to previous table field.
+Calls `org-cycle' with argument t, or `org-table-previous-field', depending
+on context.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-previous-field))
+ ((integerp arg)
+ (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
+ (message "Content view to level: %d" arg)
+ (org-content (prefix-numeric-value arg2))
+ (setq org-cycle-global-status 'overview)))
+ (t (call-interactively 'org-global-cycle))))
+
+(defun org-shiftmetaleft ()
+ "Promote subtree or delete table column.
+Calls `org-promote-subtree', `org-outdent-item-tree', or
+`org-table-delete-column', depending on context. See the
+individual commands for more information."
+ (interactive)
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
+ ((org-at-table-p) (call-interactively 'org-table-delete-column))
+ ((org-at-heading-p) (call-interactively 'org-promote-subtree))
+ ((if (not (org-region-active-p)) (org-at-item-p)
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p)))
+ (call-interactively 'org-outdent-item-tree))
+ (t (org-modifier-cursor-error))))
+
+(defun org-shiftmetaright ()
+ "Demote subtree or insert table column.
+Calls `org-demote-subtree', `org-indent-item-tree', or
+`org-table-insert-column', depending on context. See the
+individual commands for more information."
+ (interactive)
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
+ ((org-at-table-p) (call-interactively 'org-table-insert-column))
+ ((org-at-heading-p) (call-interactively 'org-demote-subtree))
+ ((if (not (org-region-active-p)) (org-at-item-p)
+ (save-excursion (goto-char (region-beginning))
+ (org-at-item-p)))
+ (call-interactively 'org-indent-item-tree))
+ (t (org-modifier-cursor-error))))
+
+(defun org-shiftmetaup (&optional arg)
+ "Move subtree up or kill table row.
+Calls `org-move-subtree-up' or `org-table-kill-row' or
+`org-move-item-up' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
+ ((org-at-table-p) (call-interactively 'org-table-kill-row))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
+ ((org-at-item-p) (call-interactively 'org-move-item-up))
+ ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+ (call-interactively 'org-timestamp-up)))
+ (t (org-modifier-cursor-error))))
+
+(defun org-shiftmetadown (&optional arg)
+ "Move subtree down or insert table row.
+Calls `org-move-subtree-down' or `org-table-insert-row' or
+`org-move-item-down' or `org-timestamp-up', depending on context.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
+ ((org-at-table-p) (call-interactively 'org-table-insert-row))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
+ ((org-at-item-p) (call-interactively 'org-move-item-down))
+ ((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
+ (call-interactively 'org-timestamp-down)))
+ (t (org-modifier-cursor-error))))
+
+(defsubst org-hidden-tree-error ()
+ (error
+ "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
+
+(defun org-metaleft (&optional arg)
+ "Promote heading or move table column to left.
+Calls `org-do-promote' or `org-table-move-column', depending on context.
+With no specific context, calls the Emacs default `backward-word'.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-metaleft-hook))
+ ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
+ ((org-with-limited-levels
+ (or (org-at-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p)))))
+ (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
+ (call-interactively 'org-do-promote))
+ ;; At an inline task.
+ ((org-at-heading-p)
+ (call-interactively 'org-inlinetask-promote))
+ ((or (org-at-item-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-item-p))))
+ (when (org-check-for-hidden 'items) (org-hidden-tree-error))
+ (call-interactively 'org-outdent-item))
+ (t (call-interactively 'backward-word))))
+
+(defun org-metaright (&optional arg)
+ "Demote a subtree, a list item or move table column to right.
+In front of a drawer or a block keyword, indent it correctly.
+With no specific context, calls the Emacs default `forward-word'.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-metaright-hook))
+ ((org-at-table-p) (call-interactively 'org-table-move-column))
+ ((org-at-drawer-p) (call-interactively 'org-indent-drawer))
+ ((org-at-block-p) (call-interactively 'org-indent-block))
+ ((org-with-limited-levels
+ (or (org-at-heading-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-heading-p)))))
+ (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
+ (call-interactively 'org-do-demote))
+ ;; At an inline task.
+ ((org-at-heading-p)
+ (call-interactively 'org-inlinetask-demote))
+ ((or (org-at-item-p)
+ (and (org-region-active-p)
+ (save-excursion
+ (goto-char (region-beginning))
+ (org-at-item-p))))
+ (when (org-check-for-hidden 'items) (org-hidden-tree-error))
+ (call-interactively 'org-indent-item))
+ (t (call-interactively 'forward-word))))
+
+(defun org-check-for-hidden (what)
+ "Check if there are hidden headlines/items in the current visual line.
+WHAT can be either `headlines' or `items'. If the current line is
+an outline or item heading and it has a folded subtree below it,
+this function returns t, nil otherwise."
+ (let ((re (cond
+ ((eq what 'headlines) org-outline-regexp-bol)
+ ((eq what 'items) (org-item-beginning-re))
+ (t (error "This should not happen"))))
+ beg end)
+ (save-excursion
+ (catch 'exit
+ (unless (org-region-active-p)
+ (setq beg (point-at-bol))
+ (beginning-of-line 2)
+ (while (and (not (eobp)) ;; this is like `next-line'
+ (get-char-property (1- (point)) 'invisible))
+ (beginning-of-line 2))
+ (setq end (point))
+ (goto-char beg)
+ (goto-char (point-at-eol))
+ (setq end (max end (point)))
+ (while (re-search-forward re end t)
+ (if (get-char-property (match-beginning 0) 'invisible)
+ (throw 'exit t))))
+ nil))))
+
+(autoload 'org-element-at-point "org-element")
+
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-context "org-element" ())
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-paragraph-parser "org-element" (limit))
+(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion))
+(declare-function org-element-nested-p "org-element" (elem-a elem-b))
+(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
+(declare-function org-element--parse-objects "org-element" (beg end acc restriction))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
+
+(defun org-metaup (&optional arg)
+ "Move subtree up or move table row up.
+Calls `org-move-subtree-up' or `org-table-move-row' or
+`org-move-item-up', depending on context. See the individual commands
+for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-metaup-hook))
+ ((org-region-active-p)
+ (let* ((a (min (region-beginning) (region-end)))
+ (b (1- (max (region-beginning) (region-end))))
+ (c (save-excursion (goto-char a)
+ (move-beginning-of-line 0)))
+ (d (save-excursion (goto-char a)
+ (move-end-of-line 0) (point))))
+ (transpose-regions a b c d)
+ (goto-char c)))
+ ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
+ ((org-at-item-p) (call-interactively 'org-move-item-up))
+ (t (org-drag-element-backward))))
+
+(defun org-metadown (&optional arg)
+ "Move subtree down or move table row down.
+Calls `org-move-subtree-down' or `org-table-move-row' or
+`org-move-item-down', depending on context. See the individual
+commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-metadown-hook))
+ ((org-region-active-p)
+ (let* ((a (min (region-beginning) (region-end)))
+ (b (max (region-beginning) (region-end)))
+ (c (save-excursion (goto-char b)
+ (move-beginning-of-line 1)))
+ (d (save-excursion (goto-char b)
+ (move-end-of-line 1) (1+ (point)))))
+ (transpose-regions a b c d)
+ (goto-char d)))
+ ((org-at-table-p) (call-interactively 'org-table-move-row))
+ ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
+ ((org-at-item-p) (call-interactively 'org-move-item-down))
+ (t (org-drag-element-forward))))
+
+(defun org-shiftup (&optional arg)
+ "Increase item in timestamp or increase priority of current headline.
+Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
+depending on context. See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftup-hook))
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'previous-line))
+ ((org-at-timestamp-p t)
+ (call-interactively (if org-edit-timestamp-down-means-later
+ 'org-timestamp-down 'org-timestamp-up)))
+ ((and (not (eq org-support-shift-select 'always))
+ org-enable-priority-commands
+ (org-at-heading-p))
+ (call-interactively 'org-priority-up))
+ ((and (not org-support-shift-select) (org-at-item-p))
+ (call-interactively 'org-previous-item))
+ ((org-clocktable-try-shift 'up arg))
+ ((run-hook-with-args-until-success 'org-shiftup-final-hook))
+ (org-support-shift-select
+ (org-call-for-shift-select 'previous-line))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftdown (&optional arg)
+ "Decrease item in timestamp or decrease priority of current headline.
+Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
+depending on context. See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftdown-hook))
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'next-line))
+ ((org-at-timestamp-p t)
+ (call-interactively (if org-edit-timestamp-down-means-later
+ 'org-timestamp-up 'org-timestamp-down)))
+ ((and (not (eq org-support-shift-select 'always))
+ org-enable-priority-commands
+ (org-at-heading-p))
+ (call-interactively 'org-priority-down))
+ ((and (not org-support-shift-select) (org-at-item-p))
+ (call-interactively 'org-next-item))
+ ((org-clocktable-try-shift 'down arg))
+ ((run-hook-with-args-until-success 'org-shiftdown-final-hook))
+ (org-support-shift-select
+ (org-call-for-shift-select 'next-line))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftright (&optional arg)
+ "Cycle the thing at point or in the current line, depending on context.
+Depending on context, this does one of the following:
+
+- switch a timestamp at point one day into the future
+- on a headline, switch to the next TODO keyword.
+- on an item, switch entire list to the next bullet type
+- on a property line, switch to the next allowed value
+- on a clocktable definition line, move time block into the future"
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftright-hook))
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'forward-char))
+ ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-heading-p))
+ (let ((org-inhibit-logging
+ (not org-treat-S-cursor-todo-selection-as-state-change))
+ (org-inhibit-blocking
+ (not org-treat-S-cursor-todo-selection-as-state-change)))
+ (org-call-with-arg 'org-todo 'right)))
+ ((or (and org-support-shift-select
+ (not (eq org-support-shift-select 'always))
+ (org-at-item-bullet-p))
+ (and (not org-support-shift-select) (org-at-item-p)))
+ (org-call-with-arg 'org-cycle-list-bullet nil))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-property-p))
+ (call-interactively 'org-property-next-allowed-value))
+ ((org-clocktable-try-shift 'right arg))
+ ((run-hook-with-args-until-success 'org-shiftright-final-hook))
+ (org-support-shift-select
+ (org-call-for-shift-select 'forward-char))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftleft (&optional arg)
+ "Cycle the thing at point or in the current line, depending on context.
+Depending on context, this does one of the following:
+
+- switch a timestamp at point one day into the past
+- on a headline, switch to the previous TODO keyword.
+- on an item, switch entire list to the previous bullet type
+- on a property line, switch to the previous allowed value
+- on a clocktable definition line, move time block into the past"
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-shiftleft-hook))
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'backward-char))
+ ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-heading-p))
+ (let ((org-inhibit-logging
+ (not org-treat-S-cursor-todo-selection-as-state-change))
+ (org-inhibit-blocking
+ (not org-treat-S-cursor-todo-selection-as-state-change)))
+ (org-call-with-arg 'org-todo 'left)))
+ ((or (and org-support-shift-select
+ (not (eq org-support-shift-select 'always))
+ (org-at-item-bullet-p))
+ (and (not org-support-shift-select) (org-at-item-p)))
+ (org-call-with-arg 'org-cycle-list-bullet 'previous))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-property-p))
+ (call-interactively 'org-property-previous-allowed-value))
+ ((org-clocktable-try-shift 'left arg))
+ ((run-hook-with-args-until-success 'org-shiftleft-final-hook))
+ (org-support-shift-select
+ (org-call-for-shift-select 'backward-char))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftcontrolright ()
+ "Switch to next TODO set."
+ (interactive)
+ (cond
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'forward-word))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-heading-p))
+ (org-call-with-arg 'org-todo 'nextset))
+ (org-support-shift-select
+ (org-call-for-shift-select 'forward-word))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftcontrolleft ()
+ "Switch to previous TODO set."
+ (interactive)
+ (cond
+ ((and org-support-shift-select (org-region-active-p))
+ (org-call-for-shift-select 'backward-word))
+ ((and (not (eq org-support-shift-select 'always))
+ (org-at-heading-p))
+ (org-call-with-arg 'org-todo 'previousset))
+ (org-support-shift-select
+ (org-call-for-shift-select 'backward-word))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftcontrolup ()
+ "Change timestamps synchronously up in CLOCK log lines."
+ (interactive)
+ (cond ((and (not org-support-shift-select)
+ (org-at-clock-log-p)
+ (org-at-timestamp-p t))
+ (org-clock-timestamps-up))
+ (t (org-shiftselect-error))))
+
+(defun org-shiftcontroldown ()
+ "Change timestamps synchronously down in CLOCK log lines."
+ (interactive)
+ (cond ((and (not org-support-shift-select)
+ (org-at-clock-log-p)
+ (org-at-timestamp-p t))
+ (org-clock-timestamps-down))
+ (t (org-shiftselect-error))))
+
+(defun org-ctrl-c-ret ()
+ "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
+ (interactive)
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
+ (t (call-interactively 'org-insert-heading))))
+
+(defun org-find-visible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (get-char-property s 'invisible)))
+ s))
+(defun org-find-invisible ()
+ (let ((s (point)))
+ (while (and (not (= (point-max) (setq s (next-overlay-change s))))
+ (not (get-char-property s 'invisible))))
+ s))
+
+(defun org-copy-visible (beg end)
+ "Copy the visible parts of the region."
+ (interactive "r")
+ (let (snippets s)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (setq s (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (org-find-invisible))
+ (push (buffer-substring s (point)) snippets)
+ (setq s (goto-char (org-find-visible))))))
+ (kill-new (apply 'concat (nreverse snippets)))))
+
+(defun org-copy-special ()
+ "Copy region in table or copy current subtree.
+Calls `org-table-copy' or `org-copy-subtree', depending on context.
+See the individual commands for more information."
+ (interactive)
+ (call-interactively
+ (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
+
+(defun org-cut-special ()
+ "Cut region in table or cut current subtree.
+Calls `org-table-copy' or `org-cut-subtree', depending on context.
+See the individual commands for more information."
+ (interactive)
+ (call-interactively
+ (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
+
+(defun org-paste-special (arg)
+ "Paste rectangular region into table, or past subtree relative to level.
+Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
+See the individual commands for more information."
+ (interactive "P")
+ (if (org-at-table-p)
+ (org-table-paste-rectangle)
+ (org-paste-subtree arg)))
+
+(defun org-edit-special (&optional arg)
+ "Call a special editor for the stuff at point.
+When at a table, call the formula editor with `org-table-edit-formulas'.
+When at the first line of an src example, call `org-edit-src-code'.
+When in an #+include line, visit the include file. Otherwise call
+`ffap' to visit the file at point."
+ (interactive)
+ ;; possibly prep session before editing source
+ (when arg
+ (let* ((info (org-babel-get-src-block-info))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (session (cdr (assoc :session params))))
+ (when (and info session) ;; we are in a source-code block with a session
+ (funcall
+ (intern (concat "org-babel-prep-session:" lang)) session params))))
+ (cond ;; proceed with `org-edit-special'
+ ((save-excursion
+ (beginning-of-line 1)
+ (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)"))
+ (find-file (org-trim (match-string 1))))
+ ((org-edit-src-code))
+ ((org-edit-fixed-width-region))
+ ((org-at-table.el-p)
+ (org-edit-src-code))
+ ((or (org-at-table-p)
+ (save-excursion
+ (beginning-of-line 1)
+ (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:"))))
+ (call-interactively 'org-table-edit-formulas))
+ (t (call-interactively 'ffap))))
+
+(defvar org-table-coordinate-overlays) ; defined in org-table.el
+(defun org-ctrl-c-ctrl-c (&optional arg)
+ "Set tags in headline, or update according to changed information at point.
+
+This command does many different things, depending on context:
+
+- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
+ this is what we do.
+
+- If the cursor is on a statistics cookie, update it.
+
+- If the cursor is in a headline, prompt for tags and insert them
+ into the current line, aligned to `org-tags-column'. When called
+ with prefix arg, realign all tags in the current buffer.
+
+- If the cursor is in one of the special #+KEYWORD lines, this
+ triggers scanning the buffer for these lines and updating the
+ information.
+
+- If the cursor is inside a table, realign the table. This command
+ works even if the automatic table editor has been turned off.
+
+- If the cursor is on a #+TBLFM line, re-apply the formulas to
+ the entire table.
+
+- If the cursor is at a footnote reference or definition, jump to
+ the corresponding definition or references, respectively.
+
+- If the cursor is a the beginning of a dynamic block, update it.
+
+- If the current buffer is a capture buffer, close note and file it.
+
+- If the cursor is on a <<<target>>>, update radio targets and
+ corresponding links in this buffer.
+
+- If the cursor is on a numbered item in a plain list, renumber the
+ ordered list.
+
+- If the cursor is on a checkbox, toggle it.
+
+- If the cursor is on a code block, evaluate it. The variable
+ `org-confirm-babel-evaluate' can be used to control prompting
+ before code block evaluation, by default every code block
+ evaluation requires confirmation. Code block evaluation can be
+ inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
+ (interactive "P")
+ (let ((org-enable-table-editor t))
+ (cond
+ ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
+ org-occur-highlights
+ org-latex-fragment-image-overlays)
+ (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
+ (org-remove-occur-highlights)
+ (org-remove-latex-fragment-image-overlays)
+ (message "Temporary highlights/overlays removed from current buffer"))
+ ((and (local-variable-p 'org-finish-function (current-buffer))
+ (fboundp org-finish-function))
+ (funcall org-finish-function))
+ ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
+ ((org-in-regexp org-ts-regexp-both)
+ (org-timestamp-change 0 'day))
+ ((or (looking-at org-property-start-re)
+ (org-at-property-p))
+ (call-interactively 'org-property-action))
+ ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp))
+ ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
+ (or (org-at-heading-p) (org-at-item-p)))
+ (call-interactively 'org-update-statistics-cookies))
+ ((org-at-heading-p) (call-interactively 'org-set-tags))
+ ((org-at-table.el-p)
+ (message "Use C-c ' to edit table.el tables"))
+ ((org-at-table-p)
+ (org-table-maybe-eval-formula)
+ (if arg
+ (call-interactively 'org-table-recalculate)
+ (org-table-maybe-recalculate-line))
+ (call-interactively 'org-table-align)
+ (orgtbl-send-table 'maybe))
+ ((or (org-footnote-at-reference-p)
+ (org-footnote-at-definition-p))
+ (call-interactively 'org-footnote-action))
+ ((org-at-item-checkbox-p)
+ ;; Cursor at a checkbox: repair list and update checkboxes. Send
+ ;; list only if at top item.
+ (let* ((cbox (match-string 1))
+ (struct (org-list-struct))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (orderedp (org-entry-get nil "ORDERED"))
+ (firstp (= (org-list-get-top-point struct) (point-at-bol)))
+ block-item)
+ ;; Use a light version of `org-toggle-checkbox' to avoid
+ ;; computing list structure twice.
+ (let ((new-box (cond
+ ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) nil)
+ ((equal "[X]" cbox) "[ ]")
+ (t "[X]"))))
+ (if (and firstp arg)
+ ;; If at first item of sub-list, remove check-box from
+ ;; every item at the same level.
+ (mapc
+ (lambda (pos) (org-list-set-checkbox pos struct new-box))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct new-box)))
+ ;; Replicate `org-list-write-struct', while grabbing a return
+ ;; value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (let ((prevs (org-list-prevs-alist struct)))
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (setq block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe)
+ (when block-item
+ (message
+ "Checkboxes were removed due to unchecked box at line %d"
+ (org-current-line block-item)))
+ (when firstp (org-list-send-list 'maybe))))
+ ((org-at-item-p)
+ ;; Cursor at an item: repair list. Do checkbox related actions
+ ;; only if function was called with an argument. Send list only
+ ;; if at top item.
+ (let* ((struct (org-list-struct))
+ (firstp (= (org-list-get-top-point struct) (point-at-bol)))
+ old-struct)
+ (when arg
+ (setq old-struct (copy-tree struct))
+ (if firstp
+ ;; If at first item of sub-list, add check-box to every
+ ;; item at the same level.
+ (mapc
+ (lambda (pos)
+ (unless (org-list-get-checkbox pos struct)
+ (org-list-set-checkbox pos struct "[ ]")))
+ (org-list-get-all-items
+ (point-at-bol) struct (org-list-prevs-alist struct)))
+ (org-list-set-checkbox (point-at-bol) struct "[ ]")))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (when arg (org-update-checkbox-count-maybe))
+ (when firstp (org-list-send-list 'maybe))))
+ ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
+ ;; Dynamic block
+ (beginning-of-line 1)
+ (save-excursion (org-update-dblock)))
+ ((save-excursion
+ (let ((case-fold-search t))
+ (beginning-of-line 1)
+ (looking-at "[ \t]*#\\+\\([a-z]+\\)")))
+ (cond
+ ((or (equal (match-string 1) "TBLFM")
+ (equal (match-string 1) "tblfm"))
+ ;; Recalculate the table before this line
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-backward " \r\n\t")
+ (if (org-at-table-p)
+ (org-call-with-arg 'org-table-recalculate (or arg t)))))
+ (t
+ (let ((org-inhibit-startup-visibility-stuff t)
+ (org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
+ (org-save-outline-visibility 'use-markers (org-mode-restart)))
+ (message "Local setup has been refreshed"))))
+ ((org-clock-update-time-maybe))
+ (t
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (error "C-c C-c can do nothing useful at this location"))))))
+
+(defun org-mode-restart ()
+ "Restart Org-mode, to scan again for special lines.
+Also updates the keyword regular expressions."
+ (interactive)
+ (org-mode)
+ (message "Org-mode restarted"))
+
+(defun org-kill-note-or-show-branches ()
+ "If this is a Note buffer, abort storing the note. Else call `show-branches'."
+ (interactive)
+ (if (not org-finish-function)
+ (progn
+ (hide-subtree)
+ (call-interactively 'show-branches))
+ (let ((org-note-abort t))
+ (funcall org-finish-function))))
+
+(defun org-return (&optional indent)
+ "Goto next table row or insert a newline.
+Calls `org-table-next-row' or `newline', depending on context.
+See the individual commands for more information."
+ (interactive)
+ (let (org-ts-what)
+ (cond
+ ((or (bobp) (org-in-src-block-p))
+ (if indent (newline-and-indent) (newline)))
+ ((org-at-table-p)
+ (org-table-justify-field-maybe)
+ (call-interactively 'org-table-next-row))
+ ;; when `newline-and-indent' is called within a list, make sure
+ ;; text moved stays inside the item.
+ ((and (org-in-item-p) indent)
+ (if (and (org-at-item-p) (>= (point) (match-end 0)))
+ (progn
+ (save-match-data (newline))
+ (org-indent-line-to (length (match-string 0))))
+ (let ((ind (org-get-indentation)))
+ (newline)
+ (if (org-looking-back org-list-end-re)
+ (org-indent-line)
+ (org-indent-line-to ind)))))
+ ((and org-return-follows-link
+ (org-at-timestamp-p t)
+ (not (eq org-ts-what 'after)))
+ (org-follow-timestamp-link))
+ ((and org-return-follows-link
+ (let ((tprop (get-text-property (point) 'face)))
+ (or (eq tprop 'org-link)
+ (and (listp tprop) (memq 'org-link tprop)))))
+ (call-interactively 'org-open-at-point))
+ ((and (org-at-heading-p)
+ (looking-at
+ (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
+ (org-show-entry)
+ (end-of-line 1)
+ (newline))
+ (t (if indent (newline-and-indent) (newline))))))
+
+(defun org-return-indent ()
+ "Goto next table row or insert a newline and indent.
+Calls `org-table-next-row' or `newline-and-indent', depending on
+context. See the individual commands for more information."
+ (interactive)
+ (org-return t))
+
+(defun org-ctrl-c-star ()
+ "Compute table, or change heading status of lines.
+Calls `org-table-recalculate' or `org-toggle-heading',
+depending on context."
+ (interactive)
+ (cond
+ ((org-at-table-p)
+ (call-interactively 'org-table-recalculate))
+ (t
+ ;; Convert all lines in region to list items
+ (call-interactively 'org-toggle-heading))))
+
+(defun org-ctrl-c-minus ()
+ "Insert separator line in table or modify bullet status of line.
+Also turns a plain line or a region of lines into list items.
+Calls `org-table-insert-hline', `org-toggle-item', or
+`org-cycle-list-bullet', depending on context."
+ (interactive)
+ (cond
+ ((org-at-table-p)
+ (call-interactively 'org-table-insert-hline))
+ ((org-region-active-p)
+ (call-interactively 'org-toggle-item))
+ ((org-in-item-p)
+ (call-interactively 'org-cycle-list-bullet))
+ (t
+ (call-interactively 'org-toggle-item))))
+
+(defun org-toggle-item (arg)
+ "Convert headings or normal lines to items, items to normal lines.
+If there is no active region, only the current line is considered.
+
+If the first non blank line in the region is an headline, convert
+all headlines to items, shifting text accordingly.
+
+If it is an item, convert all items to normal lines.
+
+If it is normal text, change region into an item. With a prefix
+argument ARG, change each line in region into an item."
+ (interactive "P")
+ (let ((shift-text
+ (function
+ ;; Shift text in current section to IND, from point to END.
+ ;; The function leaves point to END line.
+ (lambda (ind end)
+ (let ((min-i 1000) (end (copy-marker end)))
+ ;; First determine the minimum indentation (MIN-I) of
+ ;; the text.
+ (save-excursion
+ (catch 'exit
+ (while (< (point) end)
+ (let ((i (org-get-indentation)))
+ (cond
+ ;; Skip blank lines and inline tasks.
+ ((looking-at "^[ \t]*$"))
+ ((looking-at org-outline-regexp-bol))
+ ;; We can't find less than 0 indentation.
+ ((zerop i) (throw 'exit (setq min-i 0)))
+ ((< i min-i) (setq min-i i))))
+ (forward-line))))
+ ;; Then indent each line so that a line indented to
+ ;; MIN-I becomes indented to IND. Ignore blank lines
+ ;; and inline tasks in the process.
+ (let ((delta (- ind min-i)))
+ (while (< (point) end)
+ (unless (or (looking-at "^[ \t]*$")
+ (looking-at org-outline-regexp-bol))
+ (org-indent-line-to (+ (org-get-indentation) delta)))
+ (forward-line)))))))
+ (skip-blanks
+ (function
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol)))))
+ beg end)
+ ;; Determine boundaries of changes.
+ (if (org-region-active-p)
+ (setq beg (funcall skip-blanks (region-beginning))
+ end (copy-marker (region-end)))
+ (setq beg (funcall skip-blanks (point-at-bol))
+ end (copy-marker (point-at-eol))))
+ ;; Depending on the starting line, choose an action on the text
+ ;; between BEG and END.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Start at an item: de-itemize. Note that it only
+ ;; happens when a region is active: `org-ctrl-c-minus'
+ ;; would call `org-cycle-list-bullet' otherwise.
+ ((org-at-item-p)
+ (while (< (point) end)
+ (when (org-at-item-p)
+ (skip-chars-forward " \t")
+ (delete-region (point) (match-end 0)))
+ (forward-line)))
+ ;; Case 2. Start at an heading: convert to items.
+ ((org-at-heading-p)
+ (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ ;; Indentation of the first heading. It should be
+ ;; relative to the indentation of its parent, if any.
+ (start-ind (save-excursion
+ (cond
+ ((not org-adapt-indentation) 0)
+ ((not (outline-previous-heading)) 0)
+ (t (length (match-string 0))))))
+ ;; Level of first heading. Further headings will be
+ ;; compared to it to determine hierarchy in the list.
+ (ref-level (org-reduced-level (org-outline-level))))
+ (while (< (point) end)
+ (let* ((level (org-reduced-level (org-outline-level)))
+ (delta (max 0 (- level ref-level))))
+ ;; If current headline is less indented than the first
+ ;; one, set it as reference, in order to preserve
+ ;; subtrees.
+ (when (< level ref-level) (setq ref-level level))
+ (replace-match bul t t)
+ (org-indent-line-to (+ start-ind (* delta bul-len)))
+ ;; Ensure all text down to END (or SECTION-END) belongs
+ ;; to the newly created item.
+ (let ((section-end (save-excursion
+ (or (outline-next-heading) (point)))))
+ (forward-line)
+ (funcall shift-text
+ (+ start-ind (* (1+ delta) bul-len))
+ (min end section-end)))))))
+ ;; Case 3. Normal line with ARG: turn each non-item line into
+ ;; an item.
+ (arg
+ (while (< (point) end)
+ (unless (or (org-at-heading-p) (org-at-item-p))
+ (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+ (replace-match
+ (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+ (forward-line)))
+ ;; Case 4. Normal line without ARG: make the first line of
+ ;; region an item, and shift indentation of others
+ ;; lines to set them as item's body.
+ (t (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ (ref-ind (org-get-indentation)))
+ (skip-chars-forward " \t")
+ (insert bul)
+ (forward-line)
+ (while (< (point) end)
+ ;; Ensure that lines less indented than first one
+ ;; still get included in item body.
+ (funcall shift-text
+ (+ ref-ind bul-len)
+ (min end (save-excursion (or (outline-next-heading)
+ (point)))))
+ (forward-line)))))))))
+
+(defun org-toggle-heading (&optional nstars)
+ "Convert headings to normal text, or items or text to headings.
+If there is no active region, only the current line is considered.
+
+With a \\[universal-argument] prefix, convert the whole list at
+point into heading.
+
+In a region:
+
+- If the first non blank line is an headline, remove the stars
+ from all headlines in the region.
+
+- If it is a normal line turn each and every normal line (i.e. not an
+ heading or an item) in the region into a heading.
+
+- If it is a plain list item, turn all plain list items into headings.
+
+When converting a line into a heading, the number of stars is chosen
+such that the lines become children of the current entry. However,
+when a prefix argument is given, its value determines the number of
+stars to add."
+ (interactive "P")
+ (let ((skip-blanks
+ (function
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (while (org-at-comment-p) (forward-line))
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol)))))
+ beg end toggled)
+ ;; Determine boundaries of changes. If a universal prefix has
+ ;; been given, put the list in a region. If region ends at a bol,
+ ;; do not consider the last line to be in the region.
+
+ (when (and current-prefix-arg (org-at-item-p))
+ (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1))
+ (org-mark-element))
+
+ (if (org-region-active-p)
+ (setq beg (funcall skip-blanks (region-beginning))
+ end (copy-marker (save-excursion
+ (goto-char (region-end))
+ (if (bolp) (point) (point-at-eol)))))
+ (setq beg (funcall skip-blanks (point-at-bol))
+ end (copy-marker (point-at-eol))))
+ ;; Ensure inline tasks don't count as headings.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Started at an heading: de-star headings.
+ ((org-at-heading-p)
+ (while (< (point) end)
+ (when (org-at-heading-p t)
+ (looking-at org-outline-regexp) (replace-match "")
+ (setq toggled t))
+ (forward-line)))
+ ;; Case 2. Started at an item: change items into headlines.
+ ;; One star will be added by `org-list-to-subtree'.
+ ((org-at-item-p)
+ (let* ((stars (make-string
+ (if nstars
+ ;; subtract the star that will be added again by
+ ;; `org-list-to-subtree'
+ (1- (prefix-numeric-value current-prefix-arg))
+ (or (org-current-level) 0))
+ ?*))
+ (add-stars
+ (cond (nstars "") ; stars from prefix only
+ ((equal stars "") "") ; before first heading
+ (org-odd-levels-only "*") ; inside heading, odd
+ (t "")))) ; inside heading, oddeven
+ (while (< (point) end)
+ (when (org-at-item-p)
+ ;; Pay attention to cases when region ends before list.
+ (let* ((struct (org-list-struct))
+ (list-end (min (org-list-get-bottom-point struct) (1+ end))))
+ (save-restriction
+ (narrow-to-region (point) list-end)
+ (insert
+ (org-list-to-subtree
+ (org-list-parse-list t)
+ '(:istart (concat stars add-stars (funcall get-stars depth))
+ :icount (concat stars add-stars (funcall get-stars depth)))))))
+ (setq toggled t))
+ (forward-line))))
+ ;; Case 3. Started at normal text: make every line an heading,
+ ;; skipping headlines and items.
+ (t (let* ((stars (make-string
+ (if nstars
+ (prefix-numeric-value current-prefix-arg)
+ (or (org-current-level) 0))
+ ?*))
+ (add-stars
+ (cond (nstars "") ; stars from prefix only
+ ((equal stars "") "*") ; before first heading
+ (org-odd-levels-only "**") ; inside heading, odd
+ (t "*"))) ; inside heading, oddeven
+ (rpl (concat stars add-stars " ")))
+ (while (< (point) end)
+ (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
+ (looking-at "\\([ \t]*\\)\\(\\S-\\)"))
+ (replace-match (concat rpl (match-string 2))) (setq toggled t))
+ (forward-line)))))))
+ (unless toggled (message "Cannot toggle heading from here"))))
+
+(defun org-meta-return (&optional arg)
+ "Insert a new heading or wrap a region in a table.
+Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
+See the individual commands for more information."
+ (interactive "P")
+ (cond
+ ((run-hook-with-args-until-success 'org-metareturn-hook))
+ ((or (org-at-drawer-p) (org-at-property-p))
+ (newline-and-indent))
+ ((org-at-table-p)
+ (call-interactively 'org-table-wrap-region))
+ (t (call-interactively 'org-insert-heading))))
+
+;;; Menu entries
+
+(defsubst org-in-subtree-not-table-p ()
+ "Are we in a subtree and not in a table?"
+ (and (not (org-before-first-heading-p))
+ (not (org-at-table-p))))
+
+;; Define the Org-mode menus
+(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
+ '("Tbl"
+ ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
+ ["Next Field" org-cycle (org-at-table-p)]
+ ["Previous Field" org-shifttab (org-at-table-p)]
+ ["Next Row" org-return (org-at-table-p)]
+ "--"
+ ["Blank Field" org-table-blank-field (org-at-table-p)]
+ ["Edit Field" org-table-edit-field (org-at-table-p)]
+ ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
+ "--"
+ ("Column"
+ ["Move Column Left" org-metaleft (org-at-table-p)]
+ ["Move Column Right" org-metaright (org-at-table-p)]
+ ["Delete Column" org-shiftmetaleft (org-at-table-p)]
+ ["Insert Column" org-shiftmetaright (org-at-table-p)])
+ ("Row"
+ ["Move Row Up" org-metaup (org-at-table-p)]
+ ["Move Row Down" org-metadown (org-at-table-p)]
+ ["Delete Row" org-shiftmetaup (org-at-table-p)]
+ ["Insert Row" org-shiftmetadown (org-at-table-p)]
+ ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+ "--"
+ ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
+ ("Rectangle"
+ ["Copy Rectangle" org-copy-special (org-at-table-p)]
+ ["Cut Rectangle" org-cut-special (org-at-table-p)]
+ ["Paste Rectangle" org-paste-special (org-at-table-p)]
+ ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
+ "--"
+ ("Calculate"
+ ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
+ ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
+ ["Edit Formulas" org-edit-special (org-at-table-p)]
+ "--"
+ ["Recalculate line" org-table-recalculate (org-at-table-p)]
+ ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
+ ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
+ "--"
+ ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
+ "--"
+ ["Sum Column/Rectangle" org-table-sum
+ (or (org-at-table-p) (org-region-active-p))]
+ ["Which Column?" org-table-current-column (org-at-table-p)])
+ ["Debug Formulas"
+ org-table-toggle-formula-debugger
+ :style toggle :selected (org-bound-and-true-p org-table-formula-debug)]
+ ["Show Col/Row Numbers"
+ org-table-toggle-coordinate-overlays
+ :style toggle
+ :selected (org-bound-and-true-p org-table-overlay-coordinates)]
+ "--"
+ ["Create" org-table-create (and (not (org-at-table-p))
+ org-enable-table-editor)]
+ ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
+ ["Import from File" org-table-import (not (org-at-table-p))]
+ ["Export to File" org-table-export (org-at-table-p)]
+ "--"
+ ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
+
+(easy-menu-define org-org-menu org-mode-map "Org menu"
+ '("Org"
+ ("Show/Hide"
+ ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
+ ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
+ ["Sparse Tree..." org-sparse-tree t]
+ ["Reveal Context" org-reveal t]
+ ["Show All" show-all t]
+ "--"
+ ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
+ "--"
+ ["New Heading" org-insert-heading t]
+ ("Navigate Headings"
+ ["Up" outline-up-heading t]
+ ["Next" outline-next-visible-heading t]
+ ["Previous" outline-previous-visible-heading t]
+ ["Next Same Level" outline-forward-same-level t]
+ ["Previous Same Level" outline-backward-same-level t]
+ "--"
+ ["Jump" org-goto t])
+ ("Edit Structure"
+ ["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
+ "--"
+ ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)]
+ ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)]
+ "--"
+ ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
+ ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
+ ["Paste Subtree" org-paste-special (not (org-at-table-p))]
+ "--"
+ ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
+ "--"
+ ["Copy visible text" org-copy-visible t]
+ "--"
+ ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)]
+ ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)]
+ ["Demote Heading" org-metaright (org-in-subtree-not-table-p)]
+ ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)]
+ "--"
+ ["Sort Region/Children" org-sort t]
+ "--"
+ ["Convert to odd levels" org-convert-to-odd-levels t]
+ ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
+ ("Editing"
+ ["Emphasis..." org-emphasize t]
+ ["Edit Source Example" org-edit-special t]
+ "--"
+ ["Footnote new/jump" org-footnote-action t]
+ ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
+ ("Archive"
+ ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
+ "--"
+ ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)]
+ ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
+ ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
+ )
+ "--"
+ ("Hyperlinks"
+ ["Store Link (Global)" org-store-link t]
+ ["Find existing link to here" org-occur-link-in-agenda-files t]
+ ["Insert Link" org-insert-link t]
+ ["Follow Link" org-open-at-point t]
+ "--"
+ ["Next link" org-next-link t]
+ ["Previous link" org-previous-link t]
+ "--"
+ ["Descriptive Links"
+ org-toggle-link-display
+ :style radio
+ :selected org-descriptive-links
+ ]
+ ["Literal Links"
+ org-toggle-link-display
+ :style radio
+ :selected (not org-descriptive-links)])
+ "--"
+ ("TODO Lists"
+ ["TODO/DONE/-" org-todo t]
+ ("Select keyword"
+ ["Next keyword" org-shiftright (org-at-heading-p)]
+ ["Previous keyword" org-shiftleft (org-at-heading-p)]
+ ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
+ ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
+ ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
+ ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
+ ["Global TODO list" org-todo-list :active t :keys "C-c a t"]
+ "--"
+ ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
+ :selected org-enforce-todo-dependencies :style toggle :active t]
+ "Settings for tree at point"
+ ["Do Children sequentially" org-toggle-ordered-property :style radio
+ :selected (org-entry-get nil "ORDERED")
+ :active org-enforce-todo-dependencies :keys "C-c C-x o"]
+ ["Do Children parallel" org-toggle-ordered-property :style radio
+ :selected (not (org-entry-get nil "ORDERED"))
+ :active org-enforce-todo-dependencies :keys "C-c C-x o"]
+ "--"
+ ["Set Priority" org-priority t]
+ ["Priority Up" org-shiftup t]
+ ["Priority Down" org-shiftdown t]
+ "--"
+ ["Get news from all feeds" org-feed-update-all t]
+ ["Go to the inbox of a feed..." org-feed-goto-inbox t]
+ ["Customize feeds" (customize-variable 'org-feed-alist) t])
+ ("TAGS and Properties"
+ ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))]
+ ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
+ "--"
+ ["Set property" org-set-property (not (org-before-first-heading-p))]
+ ["Column view of properties" org-columns t]
+ ["Insert Column View DBlock" org-insert-columns-dblock t])
+ ("Dates and Scheduling"
+ ["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
+ ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
+ ("Change Date"
+ ["1 Day Later" org-shiftright (org-at-timestamp-p)]
+ ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
+ ["1 ... Later" org-shiftup (org-at-timestamp-p)]
+ ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
+ ["Compute Time Range" org-evaluate-time-range t]
+ ["Schedule Item" org-schedule (not (org-before-first-heading-p))]
+ ["Deadline" org-deadline (not (org-before-first-heading-p))]
+ "--"
+ ["Custom time format" org-toggle-time-stamp-overlays
+ :style radio :selected org-display-custom-times]
+ "--"
+ ["Goto Calendar" org-goto-calendar t]
+ ["Date from Calendar" org-date-from-calendar t]
+ "--"
+ ["Start/Restart Timer" org-timer-start t]
+ ["Pause/Continue Timer" org-timer-pause-or-continue t]
+ ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
+ ["Insert Timer String" org-timer t]
+ ["Insert Timer Item" org-timer-item t])
+ ("Logging work"
+ ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
+ ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
+ ["Clock out" org-clock-out t]
+ ["Clock cancel" org-clock-cancel t]
+ "--"
+ ["Mark as default task" org-clock-mark-default-task t]
+ ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"]
+ ["Goto running clock" org-clock-goto t]
+ "--"
+ ["Display times" org-clock-display t]
+ ["Create clock table" org-clock-report t]
+ "--"
+ ["Record DONE time"
+ (progn (setq org-log-done (not org-log-done))
+ (message "Switching to %s will %s record a timestamp"
+ (car org-done-keywords)
+ (if org-log-done "automatically" "not")))
+ :style toggle :selected org-log-done])
+ "--"
+ ["Agenda Command..." org-agenda t]
+ ["Set Restriction Lock" org-agenda-set-restriction-lock t]
+ ("File List for Agenda")
+ ("Special views current file"
+ ["TODO Tree" org-show-todo-tree t]
+ ["Check Deadlines" org-check-deadlines t]
+ ["Timeline" org-timeline t]
+ ["Tags/Property tree" org-match-sparse-tree t])
+ "--"
+ ["Export/Publish..." org-export t]
+ ("LaTeX"
+ ["Org CDLaTeX mode" org-cdlatex-mode :style toggle
+ :selected org-cdlatex-mode]
+ ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
+ ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
+ ["Modify math symbol" org-cdlatex-math-modify
+ (org-inside-LaTeX-fragment-p)]
+ ["Insert citation" org-reftex-citation t]
+ "--"
+ ["Template for BEAMER" (progn (require 'org-beamer)
+ (org-insert-beamer-options-template)) t])
+ "--"
+ ("MobileOrg"
+ ["Push Files and Views" org-mobile-push t]
+ ["Get Captured and Flagged" org-mobile-pull t]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
+ "--"
+ ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
+ "--"
+ ("Documentation"
+ ["Show Version" org-version t]
+ ["Info Documentation" org-info t])
+ ("Customize"
+ ["Browse Org Group" org-customize t]
+ "--"
+ ["Expand This Menu" org-create-customize-menu
+ (fboundp 'customize-menu-create)])
+ ["Send bug report" org-submit-bug-report t]
+ "--"
+ ("Refresh/Reload"
+ ["Refresh setup current buffer" org-mode-restart t]
+ ["Reload Org (after update)" org-reload t]
+ ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"])
+ ))
+
+(defun org-info (&optional node)
+ "Read documentation for Org-mode in the info system.
+With optional NODE, go directly to that node."
+ (interactive)
+ (info (format "(org)%s" (or node ""))))
+
+;;;###autoload
+(defun org-submit-bug-report ()
+ "Submit a bug report on Org-mode 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 Org-mode version and configuration."
+ (interactive)
+ (require 'reporter)
+ (org-load-modules-maybe)
+ (org-require-autoloaded-modules)
+ (let ((reporter-prompt-for-summary-p "Bug report subject: "))
+ (reporter-submit-bug-report
+ "emacs-orgmode@gnu.org"
+ (org-version nil 'full)
+ (let (list)
+ (save-window-excursion
+ (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
+ (delete-other-windows)
+ (erase-buffer)
+ (insert "You are about to submit a bug report to the Org-mode mailing list.
+
+We would like to add your full Org-mode and Outline configuration to the
+bug report. This greatly simplifies the work of the maintainer and
+other experts on the mailing list.
+
+HOWEVER, some variables you have customized may contain private
+information. The names of customers, colleagues, or friends, might
+appear in the form of file names, tags, todo states, or search strings.
+If you answer yes to the prompt, you might want to check and remove
+such private information before sending the email.")
+ (add-text-properties (point-min) (point-max) '(face org-warning))
+ (when (yes-or-no-p "Include your Org-mode configuration ")
+ (mapatoms
+ (lambda (v)
+ (and (boundp v)
+ (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
+ (or (and (symbol-value v)
+ (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
+ (and
+ (get v 'custom-type) (get v 'standard-value)
+ (not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
+ (push v list)))))
+ (kill-buffer (get-buffer "*Warn about privacy*"))
+ list))
+ nil nil
+ "Remember to cover the basics, that is, what you expected to happen and
+what in fact did happen. You don't know how to make a good report? See
+
+ http://orgmode.org/manual/Feedback.html#Feedback
+
+Your bug report will be posted to the Org-mode mailing list.
+------------------------------------------------------------------------")
+ (save-excursion
+ (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
+ (replace-match "\\1Bug: \\3 [\\2]")))))
+
+
+(defun org-install-agenda-files-menu ()
+ (let ((bl (buffer-list)))
+ (save-excursion
+ (while bl
+ (set-buffer (pop bl))
+ (if (derived-mode-p 'org-mode) (setq bl nil)))
+ (when (derived-mode-p 'org-mode)
+ (easy-menu-change
+ '("Org") "File List for Agenda"
+ (append
+ (list
+ ["Edit File List" (org-edit-agenda-file-list) t]
+ ["Add/Move Current File to Front of List" org-agenda-file-to-front t]
+ ["Remove Current File from List" org-remove-file t]
+ ["Cycle through agenda files" org-cycle-agenda-files t]
+ ["Occur in all agenda files" org-occur-in-agenda-files t]
+ "--")
+ (mapcar 'org-file-menu-entry (org-agenda-files t))))))))
+
+;;;; Documentation
+
+;;;###autoload
+(defun org-require-autoloaded-modules ()
+ (interactive)
+ (mapc 'require
+ '(org-agenda org-archive org-ascii org-attach org-clock org-colview
+ org-docbook org-exp org-html org-icalendar
+ org-id org-latex
+ org-publish org-remember org-table
+ org-timer org-xoxo)))
+
+;;;###autoload
+(defun org-reload (&optional uncompiled)
+ "Reload all org lisp files.
+With prefix arg UNCOMPILED, load the uncompiled versions."
+ (interactive "P")
+ (require 'find-func)
+ (let* ((file-re "^org\\(-.*\\)?\\.el")
+ (dir-org (file-name-directory (org-find-library-dir "org")))
+ (dir-org-contrib (ignore-errors
+ (file-name-directory
+ (org-find-library-dir "org-contribdir"))))
+ (babel-files
+ (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el"))
+ (append (list nil "comint" "eval" "exp" "keys"
+ "lob" "ref" "table" "tangle")
+ (delq nil
+ (mapcar
+ (lambda (lang)
+ (when (cdr lang) (symbol-name (car lang))))
+ org-babel-load-languages)))))
+ (files
+ (append babel-files
+ (and dir-org-contrib
+ (directory-files dir-org-contrib t file-re))
+ (directory-files dir-org t file-re)))
+ (remove-re (concat (if (featurep 'xemacs)
+ "org-colview" "org-colview-xemacs")
+ "\\'")))
+ (setq files (mapcar 'file-name-sans-extension files))
+ (setq files (mapcar
+ (lambda (x) (if (string-match remove-re x) nil x))
+ files))
+ (setq files (delq nil files))
+ (mapc
+ (lambda (f)
+ (when (featurep (intern (file-name-nondirectory f)))
+ (if (and (not uncompiled)
+ (file-exists-p (concat f ".elc")))
+ (load (concat f ".elc") nil nil 'nosuffix)
+ (load (concat f ".el") nil nil 'nosuffix))))
+ files)
+ (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix))
+ (org-version nil 'full 'message))
+
+;;;###autoload
+(defun org-customize ()
+ "Call the customize function with org as argument."
+ (interactive)
+ (org-load-modules-maybe)
+ (org-require-autoloaded-modules)
+ (customize-browse 'org))
+
+(defun org-create-customize-menu ()
+ "Create a full customization menu for Org-mode, insert it into the menu."
+ (interactive)
+ (org-load-modules-maybe)
+ (org-require-autoloaded-modules)
+ (if (fboundp 'customize-menu-create)
+ (progn
+ (easy-menu-change
+ '("Org") "Customize"
+ `(["Browse Org group" org-customize t]
+ "--"
+ ,(customize-menu-create 'org)
+ ["Set" Custom-set t]
+ ["Save" Custom-save t]
+ ["Reset to Current" Custom-reset-current t]
+ ["Reset to Saved" Custom-reset-saved t]
+ ["Reset to Standard Settings" Custom-reset-standard t]))
+ (message "\"Org\"-menu now contains full customization menu"))
+ (error "Cannot expand menu (outdated version of cus-edit.el)")))
+
+;;;; Miscellaneous stuff
+
+;;; Generally useful functions
+
+(defun org-get-at-bol (property)
+ "Get text property PROPERTY at beginning of line."
+ (get-text-property (point-at-bol) property))
+
+(defun org-find-text-property-in-string (prop s)
+ "Return the first non-nil value of property PROP in string S."
+ (or (get-text-property 0 prop s)
+ (get-text-property (or (next-single-property-change 0 prop s) 0)
+ prop s)))
+
+(defun org-display-warning (message) ;; Copied from Emacs-Muse
+ "Display the given MESSAGE as a warning."
+ (if (fboundp 'display-warning)
+ (display-warning 'org message
+ (if (featurep 'xemacs) 'warning :warning))
+ (let ((buf (get-buffer-create "*Org warnings*")))
+ (with-current-buffer buf
+ (goto-char (point-max))
+ (insert "Warning (Org): " message)
+ (unless (bolp)
+ (newline)))
+ (display-buffer buf)
+ (sit-for 0))))
+
+(defun org-eval (form)
+ "Eval FORM and return result."
+ (condition-case error
+ (eval form)
+ (error (format "%%![Error: %s]" error))))
+
+(defun org-in-clocktable-p ()
+ "Check if the cursor is in a clocktable."
+ (let ((pos (point)) start)
+ (save-excursion
+ (end-of-line 1)
+ (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t)
+ (setq start (match-beginning 0))
+ (re-search-forward "^[ \t]*#\\+END:.*" nil t)
+ (>= (match-end 0) pos)
+ start))))
+
+(defun org-in-commented-line ()
+ "Is point in a line starting with `#'?"
+ (equal (char-after (point-at-bol)) ?#))
+
+(defun org-in-indented-comment-line ()
+ "Is point in a line starting with `#' after some white space?"
+ (save-excursion
+ (save-match-data
+ (goto-char (point-at-bol))
+ (looking-at "[ \t]*#"))))
+
+(defun org-in-verbatim-emphasis ()
+ (save-match-data
+ (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~")))))
+
+(defun org-goto-marker-or-bmk (marker &optional bookmark)
+ "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
+ (if (and marker (marker-buffer marker)
+ (buffer-live-p (marker-buffer marker)))
+ (progn
+ (org-pop-to-buffer-same-window (marker-buffer marker))
+ (if (or (> marker (point-max)) (< marker (point-min)))
+ (widen))
+ (goto-char marker)
+ (org-show-context 'org-goto))
+ (if bookmark
+ (bookmark-jump bookmark)
+ (error "Cannot find location"))))
+
+(defun org-quote-csv-field (s)
+ "Quote field for inclusion in CSV material."
+ (if (string-match "[\",]" s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
+ s))
+
+(defun org-force-self-insert (N)
+ "Needed to enforce self-insert under remapping."
+ (interactive "p")
+ (self-insert-command N))
+
+(defun org-string-width (s)
+ "Compute width of string, ignoring invisible characters.
+This ignores character with invisibility property `org-link', and also
+characters with property `org-cwidth', because these will become invisible
+upon the next fontification round."
+ (let (b l)
+ (when (or (eq t buffer-invisibility-spec)
+ (assq 'org-link buffer-invisibility-spec))
+ (while (setq b (text-property-any 0 (length s)
+ 'invisible 'org-link s))
+ (setq s (concat (substring s 0 b)
+ (substring s (or (next-single-property-change
+ b 'invisible s) (length s)))))))
+ (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
+ (setq s (concat (substring s 0 b)
+ (substring s (or (next-single-property-change
+ b 'org-cwidth s) (length s))))))
+ (setq l (string-width s) b -1)
+ (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
+ (setq l (- l (get-text-property b 'org-dwidth-n s))))
+ l))
+
+(defun org-shorten-string (s maxlength)
+ "Shorten string S so tht it is no longer than MAXLENGTH characters.
+If the string is shorter or has length MAXLENGTH, just return the
+original string. If it is longer, the functions finds a space in the
+string, breaks this string off at that locations and adds three dots
+as ellipsis. Including the ellipsis, the string will not be longer
+than MAXLENGTH. If finding a good breaking point in the string does
+not work, the string is just chopped off in the middle of a word
+if necessary."
+ (if (<= (length s) maxlength)
+ s
+ (let* ((n (max (- maxlength 4) 1))
+ (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
+ (if (string-match re s)
+ (concat (match-string 1 s) "...")
+ (concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
+
+(defun org-get-indentation (&optional line)
+ "Get the indentation of the current line, interpreting tabs.
+When LINE is given, assume it represents a line and compute its indentation."
+ (if line
+ (if (string-match "^ *" (org-remove-tabs line))
+ (match-end 0))
+ (save-excursion
+ (beginning-of-line 1)
+ (skip-chars-forward " \t")
+ (current-column))))
+
+(defun org-get-string-indentation (s)
+ "What indentation has S due to SPACE and TAB at the beginning of the string?"
+ (let ((n -1) (i 0) (w tab-width) c)
+ (catch 'exit
+ (while (< (setq n (1+ n)) (length s))
+ (setq c (aref s n))
+ (cond ((= c ?\ ) (setq i (1+ i)))
+ ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
+ (t (throw 'exit t)))))
+ i))
+
+(defun org-remove-tabs (s &optional width)
+ "Replace tabulators in S with spaces.
+Assumes that s is a single line, starting in column 0."
+ (setq width (or width tab-width))
+ (while (string-match "\t" s)
+ (setq s (replace-match
+ (make-string
+ (- (* width (/ (+ (match-beginning 0) width) width))
+ (match-beginning 0)) ?\ )
+ t t s)))
+ s)
+
+(defun org-fix-indentation (line ind)
+ "Fix indentation in LINE.
+IND is a cons cell with target and minimum indentation.
+If the current indentation in LINE is smaller than the minimum,
+leave it alone. If it is larger than ind, set it to the target."
+ (let* ((l (org-remove-tabs line))
+ (i (org-get-indentation l))
+ (i1 (car ind)) (i2 (cdr ind)))
+ (if (>= i i2) (setq l (substring line i2)))
+ (if (> i1 0)
+ (concat (make-string i1 ?\ ) l)
+ l)))
+
+(defun org-remove-indentation (code &optional n)
+ "Remove the maximum common indentation from the lines in CODE.
+N may optionally be the number of spaces to remove."
+ (with-temp-buffer
+ (insert code)
+ (org-do-remove-indentation n)
+ (buffer-string)))
+
+(defun org-do-remove-indentation (&optional n)
+ "Remove the maximum common indentation from the buffer."
+ (untabify (point-min) (point-max))
+ (let ((min 10000) re)
+ (if n
+ (setq min n)
+ (goto-char (point-min))
+ (while (re-search-forward "^ *[^ \n]" nil t)
+ (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
+ (unless (or (= min 0) (= min 10000))
+ (setq re (format "^ \\{%d\\}" min))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (replace-match "")
+ (end-of-line 1))
+ min)))
+
+(defun org-fill-template (template alist)
+ "Find each %key of ALIST in TEMPLATE and replace it."
+ (let ((case-fold-search nil)
+ entry key value)
+ (setq alist (sort (copy-sequence alist)
+ (lambda (a b) (< (length (car a)) (length (car b))))))
+ (while (setq entry (pop alist))
+ (setq template
+ (replace-regexp-in-string
+ (concat "%" (regexp-quote (car entry)))
+ (or (cdr entry) "") template t t)))
+ template))
+
+(defun org-base-buffer (buffer)
+ "Return the base buffer of BUFFER, if it has one. Else return the buffer."
+ (if (not buffer)
+ buffer
+ (or (buffer-base-buffer buffer)
+ buffer)))
+
+(defun org-trim (s)
+ "Remove whitespace at beginning and end of string."
+ (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s)))
+ (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s)))
+ s)
+
+(defun org-wrap (string &optional width lines)
+ "Wrap string to either a number of lines, or a width in characters.
+If WIDTH is non-nil, the string is wrapped to that width, however many lines
+that costs. If there is a word longer than WIDTH, the text is actually
+wrapped to the length of that word.
+IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
+many lines, whatever width that takes.
+The return value is a list of lines, without newlines at the end."
+ (let* ((words (org-split-string string "[ \t\n]+"))
+ (maxword (apply 'max (mapcar 'org-string-width words)))
+ w ll)
+ (cond (width
+ (org-do-wrap words (max maxword width)))
+ (lines
+ (setq w maxword)
+ (setq ll (org-do-wrap words maxword))
+ (if (<= (length ll) lines)
+ ll
+ (setq ll words)
+ (while (> (length ll) lines)
+ (setq w (1+ w))
+ (setq ll (org-do-wrap words w)))
+ ll))
+ (t (error "Cannot wrap this")))))
+
+(defun org-do-wrap (words width)
+ "Create lines of maximum width WIDTH (in characters) from word list WORDS."
+ (let (lines line)
+ (while words
+ (setq line (pop words))
+ (while (and words (< (+ (length line) (length (car words))) width))
+ (setq line (concat line " " (pop words))))
+ (setq lines (push line lines)))
+ (nreverse lines)))
+
+(defun org-split-string (string &optional separators)
+ "Splits STRING into substrings at SEPARATORS.
+No empty strings are returned if there are matches at the beginning
+and end of string."
+ (let ((rexp (or separators "[ \f\t\n\r\v]+"))
+ (start 0)
+ notfirst
+ (list nil))
+ (while (and (string-match rexp string
+ (if (and notfirst
+ (= start (match-beginning 0))
+ (< start (length string)))
+ (1+ start) start))
+ (< (match-beginning 0) (length string)))
+ (setq notfirst t)
+ (or (eq (match-beginning 0) 0)
+ (and (eq (match-beginning 0) (match-end 0))
+ (eq (match-beginning 0) start))
+ (setq list
+ (cons (substring string start (match-beginning 0))
+ list)))
+ (setq start (match-end 0)))
+ (or (eq start (length string))
+ (setq list
+ (cons (substring string start)
+ list)))
+ (nreverse list)))
+
+(defun org-quote-vert (s)
+ "Replace \"|\" with \"\\vert\"."
+ (while (string-match "|" s)
+ (setq s (replace-match "\\vert" t t s)))
+ s)
+
+(defun org-uuidgen-p (s)
+ "Is S an ID created by UUIDGEN?"
+ (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
+
+(defun org-in-src-block-p nil
+ "Whether point is in a code source block."
+ (let (ov)
+ (when (setq ov (overlays-at (point)))
+ (memq 'org-block-background
+ (overlay-properties
+ (car ov))))))
+
+(defun org-context ()
+ "Return a list of contexts of the current cursor position.
+If several contexts apply, all are returned.
+Each context entry is a list with a symbol naming the context, and
+two positions indicating start and end of the context. Possible
+contexts are:
+
+:headline anywhere in a headline
+:headline-stars on the leading stars in a headline
+:todo-keyword on a TODO keyword (including DONE) in a headline
+:tags on the TAGS in a headline
+:priority on the priority cookie in a headline
+:item on the first line of a plain list item
+:item-bullet on the bullet/number of a plain list item
+:checkbox on the checkbox in a plain list item
+:table in an org-mode table
+:table-special on a special filed in a table
+:table-table in a table.el table
+:clocktable in a clocktable
+:src-block in a source block
+:link on a hyperlink
+:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE.
+:target on a <<target>>
+:radio-target on a <<<radio-target>>>
+:latex-fragment on a LaTeX fragment
+:latex-preview on a LaTeX fragment with overlaid preview image
+
+This function expects the position to be visible because it uses font-lock
+faces as a help to recognize the following contexts: :table-special, :link,
+and :keyword."
+ (let* ((f (get-text-property (point) 'face))
+ (faces (if (listp f) f (list f)))
+ (case-fold-search t)
+ (p (point)) clist o)
+ ;; First the large context
+ (cond
+ ((org-at-heading-p t)
+ (push (list :headline (point-at-bol) (point-at-eol)) clist)
+ (when (progn
+ (beginning-of-line 1)
+ (looking-at org-todo-line-tags-regexp))
+ (push (org-point-in-group p 1 :headline-stars) clist)
+ (push (org-point-in-group p 2 :todo-keyword) clist)
+ (push (org-point-in-group p 4 :tags) clist))
+ (goto-char p)
+ (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
+ (if (looking-at "\\[#[A-Z0-9]\\]")
+ (push (org-point-in-group p 0 :priority) clist)))
+
+ ((org-at-item-p)
+ (push (org-point-in-group p 2 :item-bullet) clist)
+ (push (list :item (point-at-bol)
+ (save-excursion (org-end-of-item) (point)))
+ clist)
+ (and (org-at-item-checkbox-p)
+ (push (org-point-in-group p 0 :checkbox) clist)))
+
+ ((org-at-table-p)
+ (push (list :table (org-table-begin) (org-table-end)) clist)
+ (if (memq 'org-formula faces)
+ (push (list :table-special
+ (previous-single-property-change p 'face)
+ (next-single-property-change p 'face)) clist)))
+ ((org-at-table-p 'any)
+ (push (list :table-table) clist)))
+ (goto-char p)
+
+ (let ((case-fold-search t))
+ ;; New the "medium" contexts: clocktables, source blocks
+ (cond ((org-in-clocktable-p)
+ (push (list :clocktable
+ (and (or (looking-at "#\\+BEGIN: clocktable")
+ (search-backward "#+BEGIN: clocktable" nil t))
+ (match-beginning 0))
+ (and (re-search-forward "#\\+END:?" nil t)
+ (match-end 0))) clist))
+ ((org-in-src-block-p)
+ (push (list :src-block
+ (and (or (looking-at "#\\+BEGIN_SRC")
+ (search-backward "#+BEGIN_SRC" nil t))
+ (match-beginning 0))
+ (and (search-forward "#+END_SRC" nil t)
+ (match-beginning 0))) clist))))
+ (goto-char p)
+
+ ;; Now the small context
+ (cond
+ ((org-at-timestamp-p)
+ (push (org-point-in-group p 0 :timestamp) clist))
+ ((memq 'org-link faces)
+ (push (list :link
+ (previous-single-property-change p 'face)
+ (next-single-property-change p 'face)) clist))
+ ((memq 'org-special-keyword faces)
+ (push (list :keyword
+ (previous-single-property-change p 'face)
+ (next-single-property-change p 'face)) clist))
+ ((org-at-target-p)
+ (push (org-point-in-group p 0 :target) clist)
+ (goto-char (1- (match-beginning 0)))
+ (if (looking-at org-radio-target-regexp)
+ (push (org-point-in-group p 0 :radio-target) clist))
+ (goto-char p))
+ ((setq o (car (delq nil
+ (mapcar
+ (lambda (x)
+ (if (memq x org-latex-fragment-image-overlays) x))
+ (overlays-at (point))))))
+ (push (list :latex-fragment
+ (overlay-start o) (overlay-end o)) clist)
+ (push (list :latex-preview
+ (overlay-start o) (overlay-end o)) clist))
+ ((org-inside-LaTeX-fragment-p)
+ ;; FIXME: positions wrong.
+ (push (list :latex-fragment (point) (point)) clist)))
+
+ (setq clist (nreverse (delq nil clist)))
+ clist))
+
+;; FIXME: Compare with at-regexp-p Do we need both?
+(defun org-in-regexp (re &optional nlines visually)
+ "Check if point is inside a match of regexp.
+Normally only the current line is checked, but you can include NLINES extra
+lines both before and after point into the search.
+If VISUALLY is set, require that the cursor is not after the match but
+really on, so that the block visually is on the match."
+ (catch 'exit
+ (let ((pos (point))
+ (eol (point-at-eol (+ 1 (or nlines 0))))
+ (inc (if visually 1 0)))
+ (save-excursion
+ (beginning-of-line (- 1 (or nlines 0)))
+ (while (re-search-forward re eol t)
+ (if (and (<= (match-beginning 0) pos)
+ (>= (+ inc (match-end 0)) pos))
+ (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
+
+(defun org-at-regexp-p (regexp)
+ "Is point inside a match of REGEXP in the current line?"
+ (catch 'exit
+ (save-excursion
+ (let ((pos (point)) (end (point-at-eol)))
+ (beginning-of-line 1)
+ (while (re-search-forward regexp end t)
+ (if (and (<= (match-beginning 0) pos)
+ (>= (match-end 0) pos))
+ (throw 'exit t)))
+ nil))))
+
+(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
+ "Non-nil when point is between matches of START-RE and END-RE.
+
+Also return a non-nil value when point is on one of the matches.
+
+Optional arguments LIM-UP and LIM-DOWN bound the search; they are
+buffer positions. Default values are the positions of headlines
+surrounding the point.
+
+The functions returns a cons cell whose car (resp. cdr) is the
+position before START-RE (resp. after END-RE)."
+ (save-match-data
+ (let ((pos (point))
+ (limit-up (or lim-up (save-excursion (outline-previous-heading))))
+ (limit-down (or lim-down (save-excursion (outline-next-heading))))
+ beg end)
+ (save-excursion
+ ;; Point is on a block when on START-RE or if START-RE can be
+ ;; found before it...
+ (and (or (org-at-regexp-p start-re)
+ (re-search-backward start-re limit-up t))
+ (setq beg (match-beginning 0))
+ ;; ... and END-RE after it...
+ (goto-char (match-end 0))
+ (re-search-forward end-re limit-down t)
+ (> (setq end (match-end 0)) pos)
+ ;; ... without another START-RE in-between.
+ (goto-char (match-beginning 0))
+ (not (re-search-backward start-re (1+ beg) t))
+ ;; Return value.
+ (cons beg end))))))
+
+(defun org-in-block-p (names)
+ "Non-nil when point belongs to a block whose name belongs to NAMES.
+
+NAMES is a list of strings containing names of blocks.
+
+Return first block name matched, or nil. Beware that in case of
+nested blocks, the returned name may not belong to the closest
+block from point."
+ (save-match-data
+ (catch 'exit
+ (let ((case-fold-search t)
+ (lim-up (save-excursion (outline-previous-heading)))
+ (lim-down (save-excursion (outline-next-heading))))
+ (mapc (lambda (name)
+ (let ((n (regexp-quote name)))
+ (when (org-between-regexps-p
+ (concat "^[ \t]*#\\+begin_" n)
+ (concat "^[ \t]*#\\+end_" n)
+ lim-up lim-down)
+ (throw 'exit n))))
+ names))
+ nil)))
+
+(defun org-occur-in-agenda-files (regexp &optional nlines)
+ "Call `multi-occur' with buffers for all agenda files."
+ (interactive "sOrg-files matching: \np")
+ (let* ((files (org-agenda-files))
+ (tnames (mapcar 'file-truename files))
+ (extra org-agenda-text-search-extra-files)
+ f)
+ (when (eq (car extra) 'agenda-archives)
+ (setq extra (cdr extra))
+ (setq files (org-add-archive-files files)))
+ (while (setq f (pop extra))
+ (unless (member (file-truename f) tnames)
+ (add-to-list 'files f 'append)
+ (add-to-list 'tnames (file-truename f) 'append)))
+ (multi-occur
+ (mapcar (lambda (x)
+ (with-current-buffer
+ (or (get-file-buffer x) (find-file-noselect x))
+ (widen)
+ (current-buffer)))
+ files)
+ regexp)))
+
+(if (boundp 'occur-mode-find-occurrence-hook)
+ ;; Emacs 23
+ (add-hook 'occur-mode-find-occurrence-hook
+ (lambda ()
+ (when (derived-mode-p 'org-mode)
+ (org-reveal))))
+ ;; Emacs 22
+ (defadvice occur-mode-goto-occurrence
+ (after org-occur-reveal activate)
+ (and (derived-mode-p 'org-mode) (org-reveal)))
+ (defadvice occur-mode-goto-occurrence-other-window
+ (after org-occur-reveal activate)
+ (and (derived-mode-p 'org-mode) (org-reveal)))
+ (defadvice occur-mode-display-occurrence
+ (after org-occur-reveal activate)
+ (when (derived-mode-p 'org-mode)
+ (let ((pos (occur-mode-find-occurrence)))
+ (with-current-buffer (marker-buffer pos)
+ (save-excursion
+ (goto-char pos)
+ (org-reveal)))))))
+
+(defun org-occur-link-in-agenda-files ()
+ "Create a link and search for it in the agendas.
+The link is not stored in `org-stored-links', it is just created
+for the search purpose."
+ (interactive)
+ (let ((link (condition-case nil
+ (org-store-link nil)
+ (error "Unable to create a link to here"))))
+ (org-occur-in-agenda-files (regexp-quote link))))
+
+(defun org-uniquify (list)
+ "Remove duplicate elements from LIST."
+ (let (res)
+ (mapc (lambda (x) (add-to-list 'res x 'append)) list)
+ res))
+
+(defun org-delete-all (elts list)
+ "Remove all elements in ELTS from LIST."
+ (while elts
+ (setq list (delete (pop elts) list)))
+ list)
+
+(defun org-count (cl-item cl-seq)
+ "Count the number of occurrences of ITEM in SEQ.
+Taken from `count' in cl-seq.el with all keyword arguments removed."
+ (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x)
+ (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
+ (while (< cl-start cl-end)
+ (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
+ (if (equal cl-item cl-x) (setq cl-count (1+ cl-count)))
+ (setq cl-start (1+ cl-start)))
+ cl-count))
+
+(defun org-remove-if (predicate seq)
+ "Remove everything from SEQ that fulfills PREDICATE."
+ (let (res e)
+ (while seq
+ (setq e (pop seq))
+ (if (not (funcall predicate e)) (push e res)))
+ (nreverse res)))
+
+(defun org-remove-if-not (predicate seq)
+ "Remove everything from SEQ that does not fulfill PREDICATE."
+ (let (res e)
+ (while seq
+ (setq e (pop seq))
+ (if (funcall predicate e) (push e res)))
+ (nreverse res)))
+
+(defun org-reduce (cl-func cl-seq &rest cl-keys)
+ "Reduce two-argument FUNCTION across SEQ.
+Taken from `reduce' in cl-seq.el with all keyword arguments but
+\":initial-value\" removed."
+ (let ((cl-accum (cond ((memq :initial-value cl-keys)
+ (cadr (memq :initial-value cl-keys)))
+ (cl-seq (pop cl-seq))
+ (t (funcall cl-func)))))
+ (while cl-seq
+ (setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
+ cl-accum))
+
+(defun org-back-over-empty-lines ()
+ "Move backwards over whitespace, to the beginning of the first empty line.
+Returns the number of empty lines passed."
+ (let ((pos (point)))
+ (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (skip-chars-backward " \t\n\r")
+ (unless (eobp)
+ (forward-line -1)))
+ (beginning-of-line 2)
+ (goto-char (min (point) pos))
+ (count-lines (point) pos)))
+
+(defun org-skip-whitespace ()
+ (skip-chars-forward " \t\n\r"))
+
+(defun org-point-in-group (point group &optional context)
+ "Check if POINT is in match-group GROUP.
+If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
+match. If the match group does not exist or point is not inside it,
+return nil."
+ (and (match-beginning group)
+ (>= point (match-beginning group))
+ (<= point (match-end group))
+ (if context
+ (list context (match-beginning group) (match-end group))
+ t)))
+
+(defun org-switch-to-buffer-other-window (&rest args)
+ "Switch to buffer in a second window on the current frame.
+In particular, do not allow pop-up frames.
+Returns the newly created buffer."
+ (let (pop-up-frames special-display-buffer-names special-display-regexps
+ special-display-function)
+ (apply 'switch-to-buffer-other-window args)))
+
+(defun org-combine-plists (&rest plists)
+ "Create a single property list from all plists in PLISTS.
+The process starts by copying the first list, and then setting properties
+from the other lists. Settings in the last list are the most significant
+ones and overrule settings in the other lists."
+ (let ((rtn (copy-sequence (pop plists)))
+ p v ls)
+ (while plists
+ (setq ls (pop plists))
+ (while ls
+ (setq p (pop ls) v (pop ls))
+ (setq rtn (plist-put rtn p v))))
+ rtn))
+
+(defun org-replace-escapes (string table)
+ "Replace %-escapes in STRING with values in TABLE.
+TABLE is an association list with keys like \"%a\" and string values.
+The sequences in STRING may contain normal field width and padding information,
+for example \"%-5s\". Replacements happen in the sequence given by TABLE,
+so values can contain further %-escapes if they are define later in TABLE."
+ (let ((tbl (copy-alist table))
+ (case-fold-search nil)
+ (pchg 0)
+ e re rpl)
+ (while (setq e (pop tbl))
+ (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
+ (when (and (cdr e) (string-match re (cdr e)))
+ (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
+ (safe "SREF"))
+ (add-text-properties 0 3 (list 'sref sref) safe)
+ (setcdr e (replace-match safe t t (cdr e)))))
+ (while (string-match re string)
+ (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
+ (cdr e)))
+ (setq string (replace-match rpl t t string))))
+ (while (setq pchg (next-property-change pchg string))
+ (let ((sref (get-text-property pchg 'sref string)))
+ (when (and sref (string-match "SREF" string pchg))
+ (setq string (replace-match sref t t string)))))
+ string))
+
+(defun org-sublist (list start end)
+ "Return a section of LIST, from START to END.
+Counting starts at 1."
+ (let (rtn (c start))
+ (setq list (nthcdr (1- start) list))
+ (while (and list (<= c end))
+ (push (pop list) rtn)
+ (setq c (1+ c)))
+ (nreverse rtn)))
+
+(defun org-find-base-buffer-visiting (file)
+ "Like `find-buffer-visiting' but always return the base buffer and
+not an indirect buffer."
+ (let ((buf (or (get-file-buffer file)
+ (find-buffer-visiting file))))
+ (if buf
+ (or (buffer-base-buffer buf) buf)
+ nil)))
+
+(defun org-image-file-name-regexp (&optional extensions)
+ "Return regexp matching the file names of images.
+If EXTENSIONS is given, only match these."
+ (if (and (not extensions) (fboundp 'image-file-name-regexp))
+ (image-file-name-regexp)
+ (let ((image-file-name-extensions
+ (or extensions
+ '("png" "jpeg" "jpg" "gif" "tiff" "tif"
+ "xbm" "xpm" "pbm" "pgm" "ppm"))))
+ (concat "\\."
+ (regexp-opt (nconc (mapcar 'upcase
+ image-file-name-extensions)
+ image-file-name-extensions)
+ t)
+ "\\'"))))
+
+(defun org-file-image-p (file &optional extensions)
+ "Return non-nil if FILE is an image."
+ (save-match-data
+ (string-match (org-image-file-name-regexp extensions) file)))
+
+(defun org-get-cursor-date ()
+ "Return the date at cursor in as a time.
+This works in the calendar and in the agenda, anywhere else it just
+returns the current time."
+ (let (date day defd)
+ (cond
+ ((eq major-mode 'calendar-mode)
+ (setq date (calendar-cursor-to-date)
+ defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ ((eq major-mode 'org-agenda-mode)
+ (setq day (get-text-property (point) 'day))
+ (if day
+ (setq date (calendar-gregorian-from-absolute day)
+ defd (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))))
+ (or defd (current-time))))
+
+(defvar org-agenda-action-marker (make-marker)
+ "Marker pointing to the entry for the next agenda action.")
+
+(defun org-mark-entry-for-agenda-action ()
+ "Mark the current entry as target of an agenda action.
+Agenda actions are actions executed from the agenda with the key `k',
+which make use of the date at the cursor."
+ (interactive)
+ (move-marker org-agenda-action-marker
+ (save-excursion (org-back-to-heading t) (point))
+ (current-buffer))
+ (message
+ "Entry marked for action; press `k' at desired date in agenda or calendar"))
+
+(defun org-mark-subtree (&optional up)
+ "Mark the current subtree.
+This puts point at the start of the current subtree, and mark at
+the end. If a numeric prefix UP is given, move up into the
+hierarchy of headlines by UP levels before marking the subtree."
+ (interactive "P")
+ (org-with-limited-levels
+ (cond ((org-at-heading-p) (beginning-of-line))
+ ((org-before-first-heading-p) (error "Not in a subtree"))
+ (t (outline-previous-visible-heading 1))))
+ (when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-mark-element)
+ (org-mark-element)))
+
+;;; Indentation
+
+(defun org-indent-line ()
+ "Indent line depending on context."
+ (interactive)
+ (let* ((pos (point))
+ (itemp (org-at-item-p))
+ (case-fold-search t)
+ (org-drawer-regexp (or org-drawer-regexp "\000"))
+ (inline-task-p (and (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)))
+ (inline-re (and inline-task-p
+ (org-inlinetask-outline-regexp)))
+ column)
+ (if (and orgstruct-is-++ (eq pos (point)))
+ (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars))))
+ (indent-according-to-mode))
+ (beginning-of-line 1)
+ (cond
+ ;; Headings
+ ((looking-at org-outline-regexp) (setq column 0))
+ ;; Included files
+ ((looking-at "#\\+include:") (setq column 0))
+ ;; Footnote definition
+ ((looking-at org-footnote-definition-re) (setq column 0))
+ ;; Literal examples
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (setq column (org-get-indentation))) ; do nothing
+ ;; Lists
+ ((ignore-errors (goto-char (org-in-item-p)))
+ (setq column (if itemp
+ (org-get-indentation)
+ (org-list-item-body-column (point))))
+ (goto-char pos))
+ ;; Drawers
+ ((and (looking-at "[ \t]*:END:")
+ (save-excursion (re-search-backward org-drawer-regexp nil t)))
+ (save-excursion
+ (goto-char (1- (match-beginning 1)))
+ (setq column (current-column))))
+ ;; Special blocks
+ ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
+ (save-excursion
+ (re-search-backward
+ (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
+ (setq column (org-get-indentation (match-string 0))))
+ ((and (not (looking-at "[ \t]*#\\+begin_"))
+ (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
+ (save-excursion
+ (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
+ (setq column
+ (cond ((equal (downcase (match-string 1)) "src")
+ ;; src blocks: let `org-edit-src-exit' handle them
+ (org-get-indentation))
+ ((equal (downcase (match-string 1)) "example")
+ (max (org-get-indentation)
+ (org-get-indentation (match-string 0))))
+ (t
+ (org-get-indentation (match-string 0))))))
+ ;; This line has nothing special, look at the previous relevant
+ ;; line to compute indentation
+ (t
+ (beginning-of-line 0)
+ (while (and (not (bobp))
+ (not (looking-at org-drawer-regexp))
+ ;; When point started in an inline task, do not move
+ ;; above task starting line.
+ (not (and inline-task-p (looking-at inline-re)))
+ ;; Skip drawers, blocks, empty lines, verbatim,
+ ;; comments, tables, footnotes definitions, lists,
+ ;; inline tasks.
+ (or (and (looking-at "[ \t]*:END:")
+ (re-search-backward org-drawer-regexp nil t))
+ (and (looking-at "[ \t]*#\\+end_")
+ (re-search-backward "[ \t]*#\\+begin_"nil t))
+ (looking-at "[ \t]*[\n:#|]")
+ (looking-at org-footnote-definition-re)
+ (and (ignore-errors (goto-char (org-in-item-p)))
+ (goto-char
+ (org-list-get-top-point (org-list-struct))))
+ (and (not inline-task-p)
+ (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)
+ (or (org-inlinetask-goto-beginning) t))))
+ (beginning-of-line 0))
+ (cond
+ ;; There was an heading above.
+ ((looking-at "\\*+[ \t]+")
+ (if (not org-adapt-indentation)
+ (setq column 0)
+ (goto-char (match-end 0))
+ (setq column (current-column))))
+ ;; A drawer had started and is unfinished
+ ((looking-at org-drawer-regexp)
+ (goto-char (1- (match-beginning 1)))
+ (setq column (current-column)))
+ ;; Else, nothing noticeable found: get indentation and go on.
+ (t (setq column (org-get-indentation))))))
+ ;; Now apply indentation and move cursor accordingly
+ (goto-char pos)
+ (if (<= (current-column) (current-indentation))
+ (org-indent-line-to column)
+ (save-excursion (org-indent-line-to column)))
+ ;; Special polishing for properties, see `org-property-format'
+ (setq column (current-column))
+ (beginning-of-line 1)
+ (if (looking-at
+ "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
+ (replace-match (concat (match-string 1)
+ (format org-property-format
+ (match-string 2) (match-string 3)))
+ t t))
+ (org-move-to-column column))))
+
+(defun org-indent-drawer ()
+ "Indent the drawer at point."
+ (interactive)
+ (let ((p (point))
+ (e (and (save-excursion (re-search-forward ":END:" nil t))
+ (match-end 0)))
+ (folded
+ (save-excursion
+ (end-of-line)
+ (when (overlays-at (point))
+ (member 'invisible (overlay-properties
+ (car (overlays-at (point)))))))))
+ (when folded (org-cycle))
+ (indent-for-tab-command)
+ (while (and (move-beginning-of-line 2) (< (point) e))
+ (indent-for-tab-command))
+ (goto-char p)
+ (when folded (org-cycle)))
+ (message "Drawer at point indented"))
+
+(defun org-indent-block ()
+ "Indent the block at point."
+ (interactive)
+ (let ((p (point))
+ (case-fold-search t)
+ (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t))
+ (match-end 0)))
+ (folded
+ (save-excursion
+ (end-of-line)
+ (when (overlays-at (point))
+ (member 'invisible (overlay-properties
+ (car (overlays-at (point)))))))))
+ (when folded (org-cycle))
+ (indent-for-tab-command)
+ (while (and (move-beginning-of-line 2) (< (point) e))
+ (indent-for-tab-command))
+ (goto-char p)
+ (when folded (org-cycle)))
+ (message "Block at point indented"))
+
+(defun org-indent-region (start end)
+ "Indent region."
+ (interactive "r")
+ (save-excursion
+ (let ((line-end (org-current-line end)))
+ (goto-char start)
+ (while (< (org-current-line) line-end)
+ (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe))
+ (t (call-interactively 'org-indent-line)))
+ (move-beginning-of-line 2)))))
+
+
+;;; Filling
+
+;; We use our own fill-paragraph and auto-fill functions.
+
+;; `org-fill-paragraph' relies on adaptive filling and context
+;; checking. Appropriate `fill-prefix' is computed with
+;; `org-adaptive-fill-function'.
+
+;; `org-auto-fill-function' takes care of auto-filling. It calls
+;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with
+;; `org-adaptive-fill-function' value. Internally,
+;; `org-comment-line-break-function' breaks the line.
+
+;; `org-setup-filling' installs filling and auto-filling related
+;; variables during `org-mode' initialization.
+
+(defun org-setup-filling ()
+ (interactive)
+ ;; Prevent auto-fill from inserting unwanted new items.
+ (when (boundp 'fill-nobreak-predicate)
+ (org-set-local
+ 'fill-nobreak-predicate
+ (org-uniquify
+ (append fill-nobreak-predicate
+ '(org-fill-paragraph-separate-nobreak-p
+ org-fill-line-break-nobreak-p)))))
+ (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
+ (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
+ (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
+ (org-set-local 'comment-line-break-function 'org-comment-line-break-function))
+
+(defvar org-element-paragraph-separate) ; org-element.el
+(defun org-fill-paragraph-separate-nobreak-p ()
+ "Non-nil when a line break at point would insert a new item."
+ (looking-at (substring org-element-paragraph-separate 1)))
+
+(defun org-fill-line-break-nobreak-p ()
+ "Non-nil when a line break at point would create an Org line break."
+ (save-excursion
+ (skip-chars-backward "[ \t]")
+ (skip-chars-backward "\\\\")
+ (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
+
+(declare-function message-in-body-p "message" ())
+(defvar org-element--affiliated-re) ; From org-element.el
+(defun org-adaptive-fill-function ()
+ "Compute a fill prefix for the current line.
+Return fill prefix, as a string, or nil if current line isn't
+meant to be filled."
+ (org-with-wide-buffer
+ (unless (and (derived-mode-p 'message-mode) (not (message-in-body-p)))
+ ;; FIXME: This is really the job of orgstruct++-mode
+ (let* ((p (line-beginning-position))
+ (element (save-excursion (beginning-of-line)
+ (org-element-at-point)))
+ (type (org-element-type element))
+ (post-affiliated
+ (save-excursion
+ (goto-char (org-element-property :begin element))
+ (while (looking-at org-element--affiliated-re) (forward-line))
+ (point))))
+ (unless (< p post-affiliated)
+ (case type
+ (comment (looking-at "[ \t]*# ?") (match-string 0))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column post-affiliated) ? ))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; except if the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (cond ((eq (org-element-type parent) 'item)
+ (make-string (org-list-item-body-column
+ (org-element-property :begin parent))
+ ? ))
+ ((save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0))
+ (t ""))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ ""))))))))))
+
+(declare-function message-goto-body "message" ())
+(defvar message-cite-prefix-regexp) ; From message.el
+(defvar org-element-all-objects) ; From org-element.el
+(defun org-fill-paragraph (&optional justify)
+ "Fill element at point, when applicable.
+
+This function only applies to comment blocks, comments, example
+blocks and paragraphs. Also, as a special case, re-align table
+when point is at one.
+
+If JUSTIFY is non-nil (interactively, with prefix argument),
+justify as well. 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. The variable `fill-column' controls the
+width for filling.
+
+For convenience, when point is at a plain list, an item or
+a footnote definition, try to fill the first paragraph within."
+ ;; Falls back on message-fill-paragraph when necessary
+ (interactive)
+ (if (and (derived-mode-p 'message-mode)
+ (or (not (message-in-body-p))
+ (save-excursion (move-beginning-of-line 1)
+ (looking-at message-cite-prefix-regexp))))
+ (let ((fill-paragraph-function
+ (cadadr (assoc 'fill-paragraph-function org-fb-vars)))
+ (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars)))
+ (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars)))
+ (paragraph-separate
+ (cadadr (assoc 'paragraph-separate org-fb-vars))))
+ (fill-paragraph nil))
+ (save-excursion
+ ;; Move to end of line in order to get the first paragraph
+ ;; within a plain list or a footnote definition.
+ (end-of-line)
+ (let ((element (org-element-at-point)))
+ ;; First check if point is in a blank line at the beginning of
+ ;; the buffer. In that case, ignore filling.
+ (if (< (point) (org-element-property :begin element)) t
+ (case (org-element-type element)
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (org-table-align))
+ t)
+ (paragraph
+ ;; Paragraphs may contain `line-break' type objects.
+ (let ((beg (max (point-min)
+ (org-element-property :contents-begin element)))
+ (end (min (point-max)
+ (org-element-property :contents-end element))))
+ ;; Do nothing if point is at an affiliated keyword.
+ (if (< (point) beg) t
+ (when (derived-mode-p 'message-mode)
+ ;; In `message-mode', do not fill following
+ ;; citation in current paragraph nor text before
+ ;; message body.
+ (let ((body-start (save-excursion (message-goto-body))))
+ (when body-start (setq beg (max body-start beg))))
+ (when (save-excursion
+ (re-search-forward
+ (concat "^" message-cite-prefix-regexp) end t))
+ (setq end (match-beginning 0))))
+ ;; Fill paragraph, taking line breaks into
+ ;; consideration. For that, slice the paragraph
+ ;; using line breaks as separators, and fill the
+ ;; parts in reverse order to avoid messing with
+ ;; markers.
+ (save-excursion
+ (goto-char end)
+ (mapc
+ (lambda (pos)
+ (fill-region-as-paragraph pos (point) justify)
+ (goto-char pos))
+ ;; Find the list of ending positions for line
+ ;; breaks in the current paragraph. Add paragraph
+ ;; beginning to include first slice.
+ (nreverse
+ (cons
+ beg
+ (org-element-map
+ (org-element--parse-objects
+ beg end nil org-element-all-objects)
+ 'line-break
+ (lambda (lb) (org-element-property :end lb)))))))
+ t)))
+ ;; Contents of `comment-block' type elements should be
+ ;; filled as plain text, but only if point is within block
+ ;; markers.
+ (comment-block
+ (let* ((case-fold-search t)
+ (beg (save-excursion
+ (goto-char (org-element-property :begin element))
+ (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
+ (forward-line)
+ (point)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (re-search-backward "^[ \t]*#\\+end_comment" nil t)
+ (line-beginning-position))))
+ (when (and (>= (point) beg) (< (point) end))
+ (fill-region-as-paragraph
+ (save-excursion
+ (end-of-line)
+ (re-search-backward "^[ \t]*$" beg 'move)
+ (line-beginning-position))
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward "^[ \t]*$" end 'move)
+ (line-beginning-position))
+ justify)))
+ t)
+ ;; Fill comments.
+ (comment (fill-comment-paragraph justify))
+ ;; Ignore every other element.
+ (otherwise t)))))))
+
+(defun org-auto-fill-function ()
+ "Auto-fill function."
+ ;; Check if auto-filling is meaningful.
+ (let ((fc (current-fill-column)))
+ (when (and fc (> (current-column) fc))
+ (let ((fill-prefix (org-adaptive-fill-function)))
+ (when fill-prefix (do-auto-fill))))))
+
+(defun org-comment-line-break-function (&optional soft)
+ "Break line at point and indent, continuing comment if within one.
+The inserted newline is marked hard if variable
+`use-hard-newlines' is true, unless optional argument SOFT is
+non-nil."
+ (if soft (insert-and-inherit ?\n) (newline 1))
+ (save-excursion (forward-char -1) (delete-horizontal-space))
+ (delete-horizontal-space)
+ (indent-to-left-margin)
+ (insert-before-markers-and-inherit fill-prefix))
+
+
+;;; Comments
+
+;; Org comments syntax is quite complex. It requires the entire line
+;; to be just a comment. Also, even with the right syntax at the
+;; beginning of line, some some elements (i.e. verse-block or
+;; example-block) don't accept comments. Usual Emacs comment commands
+;; cannot cope with those requirements. Therefore, Org replaces them.
+
+;; Org still relies on `comment-dwim', but cannot trust
+;; `comment-only-p'. So, `comment-region-function' and
+;; `uncomment-region-function' both point
+;; to`org-comment-or-uncomment-region'. Eventually,
+;; `org-insert-comment' takes care of insertion of comments at the
+;; beginning of line.
+
+;; `org-setup-comments-handling' install comments related variables
+;; during `org-mode' initialization.
+
+(defun org-setup-comments-handling ()
+ (interactive)
+ (org-set-local 'comment-use-syntax nil)
+ (org-set-local 'comment-start "# ")
+ (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
+ (org-set-local 'comment-insert-comment-function 'org-insert-comment)
+ (org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
+ (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region))
+
+(defun org-insert-comment ()
+ "Insert an empty comment above current line.
+If the line is empty, insert comment at its beginning."
+ (beginning-of-line)
+ (if (looking-at "\\s-*$") (replace-match "") (open-line 1))
+ (org-indent-line)
+ (insert "# "))
+
+(defvar comment-empty-lines) ; From newcomment.el.
+(defun org-comment-or-uncomment-region (beg end &rest ignore)
+ "Comment or uncomment each non-blank line in the region.
+Uncomment each non-blank line between BEG and END if it only
+contains commented lines. Otherwise, comment them."
+ (save-restriction
+ ;; Restrict region
+ (narrow-to-region (save-excursion (goto-char beg)
+ (skip-chars-forward " \r\t\n" end)
+ (line-beginning-position))
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n" beg)
+ (line-end-position)))
+ (let ((uncommentp
+ ;; UNCOMMENTP is non-nil when every non blank line between
+ ;; BEG and END is a comment.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'comment)
+ (goto-char (min (point-max)
+ (org-element-property
+ :end element)))))))
+ (eobp))))
+ (if uncommentp
+ ;; Only blank lines and comments in region: uncomment it.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
+ (replace-match "" nil nil nil 1))
+ (forward-line)))
+ ;; Comment each line in region.
+ (let ((min-indent (point-max)))
+ ;; First find the minimum indentation across all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (zerop min-indent)))
+ (unless (looking-at "[ \t]*$")
+ (setq min-indent (min min-indent (current-indentation))))
+ (forward-line)))
+ ;; Then loop over all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
+ (org-move-to-column min-indent t)
+ (insert comment-start))
+ (forward-line))))))))
+
+
+;;; Other stuff.
+
+(defun org-toggle-fixed-width-section (arg)
+ "Toggle the fixed-width export.
+If there is no active region, the QUOTE keyword at the current headline is
+inserted or removed. When present, it causes the text between this headline
+and the next to be exported as fixed-width text, and unmodified.
+If there is an active region, this command adds or removes a colon as the
+first character of this line. If the first character of a line is a colon,
+this line is also exported in fixed-width font."
+ (interactive "P")
+ (let* ((cc 0)
+ (regionp (org-region-active-p))
+ (beg (if regionp (region-beginning) (point)))
+ (end (if regionp (region-end)))
+ (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
+ (case-fold-search nil)
+ (re "[ \t]*\\(:\\(?: \\|$\\)\\)")
+ off)
+ (if regionp
+ (save-excursion
+ (goto-char beg)
+ (setq cc (current-column))
+ (beginning-of-line 1)
+ (setq off (looking-at re))
+ (while (> nlines 0)
+ (setq nlines (1- nlines))
+ (beginning-of-line 1)
+ (cond
+ (arg
+ (org-move-to-column cc t)
+ (insert ": \n")
+ (forward-line -1))
+ ((and off (looking-at re))
+ (replace-match "" t t nil 1))
+ ((not off) (org-move-to-column cc t) (insert ": ")))
+ (forward-line 1)))
+ (save-excursion
+ (org-back-to-heading)
+ (cond
+ ((looking-at (format org-heading-keyword-regexp-format
+ org-quote-string))
+ (goto-char (match-end 1))
+ (looking-at (concat " +" org-quote-string))
+ (replace-match "" t t)
+ (when (eolp) (insert " ")))
+ ((looking-at org-outline-regexp)
+ (goto-char (match-end 0))
+ (insert org-quote-string " ")))))))
+
+(defun org-reftex-citation ()
+ "Use reftex-citation to insert a citation into the buffer.
+This looks for a line like
+
+#+BIBLIOGRAPHY: foo plain option:-d
+
+and derives from it that foo.bib is the bibliography file relevant
+for this document. It then installs the necessary environment for RefTeX
+to work in this buffer and calls `reftex-citation' to insert a citation
+into the buffer.
+
+Export of such citations to both LaTeX and HTML is handled by the contributed
+package org-exp-bibtex by Taru Karttunen."
+ (interactive)
+ (let ((reftex-docstruct-symbol 'rds)
+ (reftex-cite-format "\\cite{%l}")
+ rds bib)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((case-fold-search t)
+ (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
+ (if (not (save-excursion
+ (or (re-search-forward re nil t)
+ (re-search-backward re nil t))))
+ (error "No bibliography defined in file")
+ (setq bib (concat (match-string 1) ".bib")
+ rds (list (list 'bib bib)))))))
+ (call-interactively 'reftex-citation)))
+
+;;;; Functions extending outline functionality
+
+(defun org-beginning-of-line (&optional arg)
+ "Go to the beginning of the current line. If that is invisible, continue
+to a visible line beginning. This makes the function of C-a more intuitive.
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
+first attempt, and only move to after the tags when the cursor is already
+beyond the end of the headline."
+ (interactive "P")
+ (let ((pos (point))
+ (special (if (consp org-special-ctrl-a/e)
+ (car org-special-ctrl-a/e)
+ org-special-ctrl-a/e))
+ refpos)
+ (if (org-bound-and-true-p line-move-visual)
+ (beginning-of-visual-line 1)
+ (beginning-of-line 1))
+ (if (and arg (fboundp 'move-beginning-of-line))
+ (call-interactively 'move-beginning-of-line)
+ (if (bobp)
+ nil
+ (backward-char 1)
+ (if (org-truely-invisible-p)
+ (while (and (not (bobp)) (org-truely-invisible-p))
+ (backward-char 1)
+ (beginning-of-line 1))
+ (forward-char 1))))
+ (when special
+ (cond
+ ((and (looking-at org-complex-heading-regexp)
+ (= (char-after (match-end 1)) ?\ ))
+ (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
+ (point-at-eol)))
+ (goto-char
+ (if (eq special t)
+ (cond ((> pos refpos) refpos)
+ ((= pos (point)) refpos)
+ (t (point)))
+ (cond ((> pos (point)) (point))
+ ((not (eq last-command this-command)) (point))
+ (t refpos)))))
+ ((org-at-item-p)
+ ;; Being at an item and not looking at an the item means point
+ ;; was previously moved to beginning of a visual line, which
+ ;; doesn't contain the item. Therefore, do nothing special,
+ ;; just stay here.
+ (when (looking-at org-list-full-item-re)
+ ;; Set special position at first white space character after
+ ;; bullet, and check-box, if any.
+ (let ((after-bullet
+ (let ((box (match-end 3)))
+ (if (not box) (match-end 1)
+ (let ((after (char-after box)))
+ (if (and after (= after ? )) (1+ box) box))))))
+ ;; Special case: Move point to special position when
+ ;; currently after it or at beginning of line.
+ (if (eq special t)
+ (when (or (> pos after-bullet) (= (point) pos))
+ (goto-char after-bullet))
+ ;; Reversed case: Move point to special position when
+ ;; point was already at beginning of line and command is
+ ;; repeated.
+ (when (and (= (point) pos) (eq last-command this-command))
+ (goto-char after-bullet))))))))
+ (org-no-warnings
+ (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+
+(defun org-end-of-line (&optional arg)
+ "Go to the end of the line.
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
+first attempt, and only move to after the tags when the cursor is already
+beyond the end of the headline."
+ (interactive "P")
+ (let ((special (if (consp org-special-ctrl-a/e)
+ (cdr org-special-ctrl-a/e)
+ org-special-ctrl-a/e)))
+ (cond
+ ((or (not special) arg
+ (not (or (org-at-heading-p) (org-at-item-p) (org-at-drawer-p))))
+ (call-interactively
+ (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
+ ((fboundp 'move-end-of-line) 'move-end-of-line)
+ (t 'end-of-line))))
+ ((org-at-heading-p)
+ (let ((pos (point)))
+ (beginning-of-line 1)
+ (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
+ (if (eq special t)
+ (if (or (< pos (match-beginning 1))
+ (= pos (match-end 0)))
+ (goto-char (match-beginning 1))
+ (goto-char (match-end 0)))
+ (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
+ (goto-char (match-end 0))
+ (goto-char (match-beginning 1))))
+ (call-interactively (if (fboundp 'move-end-of-line)
+ 'move-end-of-line
+ 'end-of-line)))))
+ ((org-at-drawer-p)
+ (move-end-of-line 1)
+ (when (overlays-at (1- (point))) (backward-char 1)))
+ ;; At an item: Move before any hidden text.
+ (t (call-interactively
+ (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
+ ((fboundp 'move-end-of-line) 'move-end-of-line)
+ (t 'end-of-line)))))
+ (org-no-warnings
+ (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+
+(define-key org-mode-map "\C-a" 'org-beginning-of-line)
+(define-key org-mode-map "\C-e" 'org-end-of-line)
+
+(defun org-backward-sentence (&optional arg)
+ "Go to beginning of sentence, or beginning of table field.
+This will call `backward-sentence' or `org-table-beginning-of-field',
+depending on context."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
+ (t (call-interactively 'backward-sentence))))
+
+(defun org-forward-sentence (&optional arg)
+ "Go to end of sentence, or end of table field.
+This will call `forward-sentence' or `org-table-end-of-field',
+depending on context."
+ (interactive "P")
+ (cond
+ ((org-at-table-p) (call-interactively 'org-table-end-of-field))
+ (t (call-interactively 'forward-sentence))))
+
+(define-key org-mode-map "\M-a" 'org-backward-sentence)
+(define-key org-mode-map "\M-e" 'org-forward-sentence)
+
+(defun org-kill-line (&optional arg)
+ "Kill line, to tags or end of line."
+ (interactive "P")
+ (cond
+ ((or (not org-special-ctrl-k)
+ (bolp)
+ (not (org-at-heading-p)))
+ (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
+ org-ctrl-k-protect-subtree)
+ (if (or (eq org-ctrl-k-protect-subtree 'error)
+ (not (y-or-n-p "Kill hidden subtree along with headline? ")))
+ (error "C-k aborted - would kill hidden subtree")))
+ (call-interactively
+ (if (and (boundp 'visual-line-mode) visual-line-mode) 'kill-visual-line 'kill-line)))
+ ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
+ (kill-region (point) (match-beginning 1))
+ (org-set-tags nil t))
+ (t (kill-region (point) (point-at-eol)))))
+
+(define-key org-mode-map "\C-k" 'org-kill-line)
+
+(defun org-yank (&optional arg)
+ "Yank. If the kill is a subtree, treat it specially.
+This command will look at the current kill and check if is a single
+subtree, or a series of subtrees[1]. If it passes the test, and if the
+cursor is at the beginning of a line or after the stars of a currently
+empty headline, then the yank is handled specially. How exactly depends
+on the value of the following variables, both set by default.
+
+org-yank-folded-subtrees
+ When set, the subtree(s) will be folded after insertion, but only
+ if doing so would now swallow text after the yanked text.
+
+org-yank-adjusted-subtrees
+ When set, the subtree will be promoted or demoted in order to
+ fit into the local outline tree structure, which means that the level
+ will be adjusted so that it becomes the smaller one of the two
+ *visible* surrounding headings.
+
+Any prefix to this command will cause `yank' to be called directly with
+no special treatment. In particular, a simple \\[universal-argument] prefix \
+will just
+plainly yank the text as it is.
+
+\[1] The test checks if the first non-white line is a heading
+ and if there are no other headings with fewer stars."
+ (interactive "P")
+ (org-yank-generic 'yank arg))
+
+(defun org-yank-generic (command arg)
+ "Perform some yank-like command.
+
+This function implements the behavior described in the `org-yank'
+documentation. However, it has been generalized to work for any
+interactive command with similar behavior."
+
+ ;; pretend to be command COMMAND
+ (setq this-command command)
+
+ (if arg
+ (call-interactively command)
+
+ (let ((subtreep ; is kill a subtree, and the yank position appropriate?
+ (and (org-kill-is-subtree-p)
+ (or (bolp)
+ (and (looking-at "[ \t]*$")
+ (string-match
+ "\\`\\*+\\'"
+ (buffer-substring (point-at-bol) (point)))))))
+ swallowp)
+ (cond
+ ((and subtreep org-yank-folded-subtrees)
+ (let ((beg (point))
+ end)
+ (if (and subtreep org-yank-adjusted-subtrees)
+ (org-paste-subtree nil nil 'for-yank)
+ (call-interactively command))
+
+ (setq end (point))
+ (goto-char beg)
+ (when (and (bolp) subtreep
+ (not (setq swallowp
+ (org-yank-folding-would-swallow-text beg end))))
+ (org-with-limited-levels
+ (or (looking-at org-outline-regexp)
+ (re-search-forward org-outline-regexp-bol end t))
+ (while (and (< (point) end) (looking-at org-outline-regexp))
+ (hide-subtree)
+ (org-cycle-show-empty-lines 'folded)
+ (condition-case nil
+ (outline-forward-same-level 1)
+ (error (goto-char end))))))
+ (when swallowp
+ (message
+ "Inserted text not folded because that would swallow text"))
+
+ (goto-char end)
+ (skip-chars-forward " \t\n\r")
+ (beginning-of-line 1)
+ (push-mark beg 'nomsg)))
+ ((and subtreep org-yank-adjusted-subtrees)
+ (let ((beg (point-at-bol)))
+ (org-paste-subtree nil nil 'for-yank)
+ (push-mark beg 'nomsg)))
+ (t
+ (call-interactively command))))))
+
+(defun org-yank-folding-would-swallow-text (beg end)
+ "Would hide-subtree at BEG swallow any text after END?"
+ (let (level)
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (when (or (looking-at org-outline-regexp)
+ (re-search-forward org-outline-regexp-bol end t))
+ (setq level (org-outline-level)))
+ (goto-char end)
+ (skip-chars-forward " \t\r\n\v\f")
+ (if (or (eobp)
+ (and (bolp) (looking-at org-outline-regexp)
+ (<= (org-outline-level) level)))
+ nil ; Nothing would be swallowed
+ t))))) ; something would swallow
+
+(define-key org-mode-map "\C-y" 'org-yank)
+
+(defun org-truely-invisible-p ()
+ "Check if point is at a character currently not visible.
+This version does not only check the character property, but also
+`visible-mode'."
+ ;; Early versions of noutline don't have `outline-invisible-p'.
+ (if (org-bound-and-true-p visible-mode)
+ nil
+ (outline-invisible-p)))
+
+(defun org-invisible-p2 ()
+ "Check if point is at a character currently not visible."
+ (save-excursion
+ (if (and (eolp) (not (bobp))) (backward-char 1))
+ ;; Early versions of noutline don't have `outline-invisible-p'.
+ (outline-invisible-p)))
+
+(defun org-back-to-heading (&optional invisible-ok)
+ "Call `outline-back-to-heading', but provide a better error message."
+ (condition-case nil
+ (outline-back-to-heading invisible-ok)
+ (error (error "Before first headline at position %d in buffer %s"
+ (point) (current-buffer)))))
+
+(defun org-before-first-heading-p ()
+ "Before first heading?"
+ (save-excursion
+ (end-of-line)
+ (null (re-search-backward org-outline-regexp-bol nil t))))
+
+(defun org-at-heading-p (&optional ignored)
+ (outline-on-heading-p t))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-heading-p 'org-at-heading-p)
+
+(defun org-at-comment-p nil
+ "Is cursor in a line starting with a # character?"
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "^#")))
+
+(defun org-at-drawer-p nil
+ "Is cursor at a drawer keyword?"
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-drawer-regexp)))
+
+(defun org-at-block-p nil
+ "Is cursor at a block keyword?"
+ (save-excursion
+ (move-beginning-of-line 1)
+ (looking-at org-block-regexp)))
+
+(defun org-point-at-end-of-empty-headline ()
+ "If point is at the end of an empty headline, return t, else nil.
+If the heading only contains a TODO keyword, it is still still considered
+empty."
+ (and (looking-at "[ \t]*$")
+ (when org-todo-line-regexp
+ (save-excursion
+ (beginning-of-line 1)
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp)
+ (string= (match-string 3) ""))))))
+
+(defun org-at-heading-or-item-p ()
+ (or (org-at-heading-p) (org-at-item-p)))
+
+(defun org-at-target-p ()
+ (or (org-in-regexp org-radio-target-regexp)
+ (org-in-regexp org-target-regexp)))
+;; Compatibility alias with Org versions < 7.8.03
+(defalias 'org-on-target-p 'org-at-target-p)
+
+(defun org-up-heading-all (arg)
+ "Move to the heading line of which the present line is a subheading.
+This function considers both visible and invisible heading lines.
+With argument, move up ARG levels."
+ (if (fboundp 'outline-up-heading-all)
+ (outline-up-heading-all arg) ; emacs 21 version of outline.el
+ (outline-up-heading arg t))) ; emacs 22 version of outline.el
+
+(defun org-up-heading-safe ()
+ "Move to the heading line of which the present line is a subheading.
+This version will not throw an error. It will return the level of the
+headline found, or nil if no higher level is found.
+
+Also, this function will be a lot faster than `outline-up-heading',
+because it relies on stars being the outline starters. This can really
+make a significant difference in outlines with very many siblings."
+ (let (start-level re)
+ (org-back-to-heading t)
+ (setq start-level (funcall outline-level))
+ (if (equal start-level 1)
+ nil
+ (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} "))
+ (if (re-search-backward re nil t)
+ (funcall outline-level)))))
+
+(defun org-first-sibling-p ()
+ "Is this heading the first child of its parents?"
+ (interactive)
+ (let ((re org-outline-regexp-bol)
+ level l)
+ (unless (org-at-heading-p t)
+ (error "Not at a heading"))
+ (setq level (funcall outline-level))
+ (save-excursion
+ (if (not (re-search-backward re nil t))
+ t
+ (setq l (funcall outline-level))
+ (< l level)))))
+
+(defun org-goto-sibling (&optional previous)
+ "Goto the next sibling, even if it is invisible.
+When PREVIOUS is set, go to the previous sibling instead. Returns t
+when a sibling was found. When none is found, return nil and don't
+move point."
+ (let ((fun (if previous 're-search-backward 're-search-forward))
+ (pos (point))
+ (re org-outline-regexp-bol)
+ level l)
+ (when (condition-case nil (org-back-to-heading t) (error nil))
+ (setq level (funcall outline-level))
+ (catch 'exit
+ (or previous (forward-char 1))
+ (while (funcall fun re nil t)
+ (setq l (funcall outline-level))
+ (when (< l level) (goto-char pos) (throw 'exit nil))
+ (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
+ (goto-char pos)
+ nil))))
+
+(defun org-show-siblings ()
+ "Show all siblings of the current headline."
+ (save-excursion
+ (while (org-goto-sibling) (org-flag-heading nil)))
+ (save-excursion
+ (while (org-goto-sibling 'previous)
+ (org-flag-heading nil))))
+
+(defun org-goto-first-child ()
+ "Goto the first child, even if it is invisible.
+Return t when a child was found. Otherwise don't move point and
+return nil."
+ (let (level (pos (point)) (re org-outline-regexp-bol))
+ (when (condition-case nil (org-back-to-heading t) (error nil))
+ (setq level (outline-level))
+ (forward-char 1)
+ (if (and (re-search-forward re nil t) (> (outline-level) level))
+ (progn (goto-char (match-beginning 0)) t)
+ (goto-char pos) nil))))
+
+(defun org-show-hidden-entry ()
+ "Show an entry where even the heading is hidden."
+ (save-excursion
+ (org-show-entry)))
+
+(defun org-flag-heading (flag &optional entry)
+ "Flag the current heading. FLAG non-nil means make invisible.
+When ENTRY is non-nil, show the entire entry."
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Check if we should show the entire entry
+ (if entry
+ (progn
+ (org-show-entry)
+ (save-excursion
+ (and (outline-next-heading)
+ (org-flag-heading nil))))
+ (outline-flag-region (max (point-min) (1- (point)))
+ (save-excursion (outline-end-of-heading) (point))
+ flag))))
+
+(defun org-get-next-sibling ()
+ "Move to next heading of the same level, and return point.
+If there is no such heading, return nil.
+This is like outline-next-sibling, but invisible headings are ok."
+ (let ((level (funcall outline-level)))
+ (outline-next-heading)
+ (while (and (not (eobp)) (> (funcall outline-level) level))
+ (outline-next-heading))
+ (if (or (eobp) (< (funcall outline-level) level))
+ nil
+ (point))))
+
+(defun org-get-last-sibling ()
+ "Move to previous heading of the same level, and return point.
+If there is no such heading, return nil."
+ (let ((opoint (point))
+ (level (funcall outline-level)))
+ (outline-previous-heading)
+ (when (and (/= (point) opoint) (outline-on-heading-p t))
+ (while (and (> (funcall outline-level) level)
+ (not (bobp)))
+ (outline-previous-heading))
+ (if (< (funcall outline-level) level)
+ nil
+ (point)))))
+
+(defun org-end-of-subtree (&optional invisible-ok to-heading)
+ "Goto to the end of a subtree."
+ ;; This contains an exact copy of the original function, but it uses
+ ;; `org-back-to-heading', to make it work also in invisible
+ ;; trees. And is uses an invisible-ok argument.
+ ;; Under Emacs this is not needed, but the old outline.el needs this fix.
+ ;; Furthermore, when used inside Org, finding the end of a large subtree
+ ;; with many children and grandchildren etc, this can be much faster
+ ;; than the outline version.
+ (org-back-to-heading invisible-ok)
+ (let ((first t)
+ (level (funcall outline-level)))
+ (if (and (derived-mode-p 'org-mode) (< level 1000))
+ ;; A true heading (not a plain list item), in Org-mode
+ ;; This means we can easily find the end by looking
+ ;; only for the right number of stars. Using a regexp to do
+ ;; this is so much faster than using a Lisp loop.
+ (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
+ (forward-char 1)
+ (and (re-search-forward re nil 'move) (beginning-of-line 1)))
+ ;; something else, do it the slow way
+ (while (and (not (eobp))
+ (or first (> (funcall outline-level) level)))
+ (setq first nil)
+ (outline-next-heading)))
+ (unless to-heading
+ (if (memq (preceding-char) '(?\n ?\^M))
+ (progn
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (if (memq (preceding-char) '(?\n ?\^M))
+ ;; leave blank line before heading
+ (forward-char -1))))))
+ (point))
+
+(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
+ "Use Org version in org-mode, for dramatic speed-up."
+ (if (derived-mode-p 'org-mode)
+ (progn
+ (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char 1)))
+ ad-do-it))
+
+(defun org-end-of-meta-data-and-drawers ()
+ "Jump to the first text after meta data and drawers in the current entry.
+This will move over empty lines, lines with planning time stamps,
+clocking lines, and drawers."
+ (org-back-to-heading t)
+ (let ((end (save-excursion (outline-next-heading) (point)))
+ (re (concat "\\(" org-drawer-regexp "\\)"
+ "\\|" "[ \t]*" org-keyword-time-regexp)))
+ (forward-line 1)
+ (while (re-search-forward re end t)
+ (if (not (match-end 1))
+ ;; empty or planning line
+ (forward-line 1)
+ ;; a drawer, find the end
+ (re-search-forward "^[ \t]*:END:" end 'move)
+ (forward-line 1)))
+ (and (re-search-forward "[^\n]" nil t) (backward-char 1))
+ (point)))
+
+(defun org-forward-heading-same-level (arg &optional invisible-ok)
+ "Move forward to the arg'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading.
+Normally this only looks at visible headings, but when INVISIBLE-OK is
+non-nil it will also look at invisible ones."
+ (interactive "p")
+ (org-back-to-heading invisible-ok)
+ (org-at-heading-p)
+ (let* ((level (- (match-end 0) (match-beginning 0) 1))
+ (re (format "^\\*\\{1,%d\\} " level))
+ l)
+ (forward-char 1)
+ (while (> arg 0)
+ (while (and (re-search-forward re nil 'move)
+ (setq l (- (match-end 0) (match-beginning 0) 1))
+ (= l level)
+ (not invisible-ok)
+ (progn (backward-char 1) (outline-invisible-p)))
+ (if (< l level) (setq arg 1)))
+ (setq arg (1- arg)))
+ (beginning-of-line 1)))
+
+(defun org-backward-heading-same-level (arg &optional invisible-ok)
+ "Move backward to the arg'th subheading at same level as this one.
+Stop at the first and last subheadings of a superior heading."
+ (interactive "p")
+ (org-back-to-heading)
+ (org-at-heading-p)
+ (let* ((level (- (match-end 0) (match-beginning 0) 1))
+ (re (format "^\\*\\{1,%d\\} " level))
+ l)
+ (while (> arg 0)
+ (while (and (re-search-backward re nil 'move)
+ (setq l (- (match-end 0) (match-beginning 0) 1))
+ (= l level)
+ (not invisible-ok)
+ (outline-invisible-p))
+ (if (< l level) (setq arg 1)))
+ (setq arg (1- arg)))))
+
+;;;###autoload
+(defun org-forward-element ()
+ "Move forward by one element.
+Move to the next element at the same level, when possible."
+ (interactive)
+ (cond ((eobp) (error "Cannot move further down"))
+ ((org-with-limited-levels (org-at-heading-p))
+ (let ((origin (point)))
+ (org-forward-heading-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further down"))))
+ (t
+ (let* ((elem (org-element-at-point))
+ (end (org-element-property :end elem))
+ (parent (org-element-property :parent elem)))
+ (if (and parent (= (org-element-property :contents-end parent) end))
+ (goto-char (org-element-property :end parent))
+ (goto-char end))))))
+
+;;;###autoload
+(defun org-backward-element ()
+ "Move backward by one element.
+Move to the previous element at the same level, when possible."
+ (interactive)
+ (cond ((bobp) (error "Cannot move further up"))
+ ((org-with-limited-levels (org-at-heading-p))
+ ;; At an headline, move to the previous one, if any, or stay
+ ;; here.
+ (let ((origin (point)))
+ (org-backward-heading-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further up"))))
+ (t
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (car trail))
+ (prev-elem (nth 1 trail))
+ (beg (org-element-property :begin elem)))
+ (cond
+ ;; Move to beginning of current element if point isn't
+ ;; there already.
+ ((/= (point) beg) (goto-char beg))
+ (prev-elem (goto-char (org-element-property :begin prev-elem)))
+ ((org-before-first-heading-p) (goto-char (point-min)))
+ (t (org-back-to-heading)))))))
+
+;;;###autoload
+(defun org-up-element ()
+ "Move to upper element."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p))
+ (unless (org-up-heading-safe) (error "No surrounding element"))
+ (let* ((elem (org-element-at-point))
+ (parent (org-element-property :parent elem)))
+ (if parent (goto-char (org-element-property :begin parent))
+ (if (org-with-limited-levels (org-before-first-heading-p))
+ (error "No surrounding element")
+ (org-with-limited-levels (org-back-to-heading)))))))
+
+;;;###autoload
+(defvar org-element-greater-elements)
+(defun org-down-element ()
+ "Move to inner element."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (cond
+ ((memq (org-element-type element) '(plain-list table))
+ (goto-char (org-element-property :contents-begin element))
+ (forward-char))
+ ((memq (org-element-type element) org-element-greater-elements)
+ ;; If contents are hidden, first disclose them.
+ (when (org-element-property :hiddenp element) (org-cycle))
+ (goto-char (or (org-element-property :contents-begin element)
+ (error "No content for this element"))))
+ (t (error "No inner element")))))
+
+;;;###autoload
+(defun org-drag-element-backward ()
+ "Move backward element at point."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (car trail))
+ (prev-elem (nth 1 trail)))
+ ;; Error out if no previous element or previous element is
+ ;; a parent of the current one.
+ (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
+ (error "Cannot drag element backward")
+ (let ((pos (point)))
+ (org-element-swap-A-B prev-elem elem)
+ (goto-char (+ (org-element-property :begin prev-elem)
+ (- pos (org-element-property :begin elem)))))))))
+
+;;;###autoload
+(defun org-drag-element-forward ()
+ "Move forward element at point."
+ (interactive)
+ (let* ((pos (point))
+ (elem (org-element-at-point)))
+ (when (= (point-max) (org-element-property :end elem))
+ (error "Cannot drag element forward"))
+ (goto-char (org-element-property :end elem))
+ (let ((next-elem (org-element-at-point)))
+ (when (or (org-element-nested-p elem next-elem)
+ (and (eq (org-element-type next-elem) 'headline)
+ (not (eq (org-element-type elem) 'headline))))
+ (goto-char pos)
+ (error "Cannot drag element forward"))
+ ;; Compute new position of point: it's shifted by NEXT-ELEM
+ ;; body's length (without final blanks) and by the length of
+ ;; blanks between ELEM and NEXT-ELEM.
+ (let ((size-next (- (save-excursion
+ (goto-char (org-element-property :end next-elem))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ ;; Small correction if buffer doesn't end
+ ;; with a newline character.
+ (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
+ (org-element-property :begin next-elem)))
+ (size-blank (- (org-element-property :end elem)
+ (save-excursion
+ (goto-char (org-element-property :end elem))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point)))))
+ (org-element-swap-A-B elem next-elem)
+ (goto-char (+ pos size-next size-blank))))))
+
+;;;###autoload
+(defun org-mark-element ()
+ "Put point at beginning of this element, mark at end.
+
+Interactively, if this command is repeated or (in Transient Mark
+mode) if the mark is active, it marks the next element after the
+ones already marked."
+ (interactive)
+ (let (deactivate-mark)
+ (if (and (org-called-interactively-p 'any)
+ (or (and (eq last-command this-command) (mark t))
+ (and transient-mark-mode mark-active)))
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ (goto-char (org-element-property :end (org-element-at-point)))))
+ (let ((element (org-element-at-point)))
+ (end-of-line)
+ (push-mark (org-element-property :end element) t t)
+ (goto-char (org-element-property :begin element))))))
+
+;;;###autoload
+(defun org-narrow-to-element ()
+ "Narrow buffer to current element."
+ (interactive)
+ (let ((elem (org-element-at-point)))
+ (cond
+ ((eq (car elem) 'headline)
+ (narrow-to-region
+ (org-element-property :begin elem)
+ (org-element-property :end elem)))
+ ((memq (car elem) org-element-greater-elements)
+ (narrow-to-region
+ (org-element-property :contents-begin elem)
+ (org-element-property :contents-end elem)))
+ (t
+ (narrow-to-region
+ (org-element-property :begin elem)
+ (org-element-property :end elem))))))
+
+;;;###autoload
+(defun org-transpose-element ()
+ "Transpose current and previous elements, keeping blank lines between.
+Point is moved after both elements."
+ (interactive)
+ (org-skip-whitespace)
+ (let ((end (org-element-property :end (org-element-at-point))))
+ (org-drag-element-backward)
+ (goto-char end)))
+
+;;;###autoload
+(defun org-unindent-buffer ()
+ "Un-indent the visible part of the buffer.
+Relative indentation (between items, inside blocks, etc.) isn't
+modified."
+ (interactive)
+ (unless (eq major-mode 'org-mode)
+ (error "Cannot un-indent a buffer not in Org mode"))
+ (let* ((parse-tree (org-element-parse-buffer 'greater-element))
+ unindent-tree ; For byte-compiler.
+ (unindent-tree
+ (function
+ (lambda (contents)
+ (mapc
+ (lambda (element)
+ (if (memq (org-element-type element) '(headline section))
+ (funcall unindent-tree (org-element-contents element))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (org-element-property :begin element)
+ (org-element-property :end element))
+ (org-do-remove-indentation)))))
+ (reverse contents))))))
+ (funcall unindent-tree (org-element-contents parse-tree))))
+
+(defun org-show-subtree ()
+ "Show everything after this heading at deeper levels."
+ (interactive)
+ (outline-flag-region
+ (point)
+ (save-excursion
+ (org-end-of-subtree t t))
+ nil))
+
+(defun org-show-entry ()
+ "Show the body directly following this heading.
+Show the heading too, if it is currently invisible."
+ (interactive)
+ (save-excursion
+ (condition-case nil
+ (progn
+ (org-back-to-heading t)
+ (outline-flag-region
+ (max (point-min) (1- (point)))
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil)
+ (org-cycle-hide-drawers 'children))
+ (error nil))))
+
+(defun org-make-options-regexp (kwds &optional extra)
+ "Make a regular expression for keyword lines."
+ (concat
+ "^#\\+\\("
+ (mapconcat 'regexp-quote kwds "\\|")
+ (if extra (concat "\\|" extra))
+ "\\):[ \t]*\\(.*\\)"))
+
+;; Make isearch reveal the necessary context
+(defun org-isearch-end ()
+ "Reveal context after isearch exits."
+ (when isearch-success ; only if search was successful
+ (if (featurep 'xemacs)
+ ;; Under XEmacs, the hook is run in the correct place,
+ ;; we directly show the context.
+ (org-show-context 'isearch)
+ ;; In Emacs the hook runs *before* restoring the overlays.
+ ;; So we have to use a one-time post-command-hook to do this.
+ ;; (Emacs 22 has a special variable, see function `org-mode')
+ (unless (and (boundp 'isearch-mode-end-hook-quit)
+ isearch-mode-end-hook-quit)
+ ;; Only when the isearch was not quitted.
+ (org-add-hook 'post-command-hook 'org-isearch-post-command
+ 'append 'local)))))
+
+(defun org-isearch-post-command ()
+ "Remove self from hook, and show context."
+ (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
+ (org-show-context 'isearch))
+
+
+;;;; Integration with and fixes for other packages
+
+;;; Imenu support
+
+(defvar org-imenu-markers nil
+ "All markers currently used by Imenu.")
+(make-variable-buffer-local 'org-imenu-markers)
+
+(defun org-imenu-new-marker (&optional pos)
+ "Return a new marker for use by Imenu, and remember the marker."
+ (let ((m (make-marker)))
+ (move-marker m (or pos (point)))
+ (push m org-imenu-markers)
+ m))
+
+(defun org-imenu-get-tree ()
+ "Produce the index for Imenu."
+ (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
+ (setq org-imenu-markers nil)
+ (let* ((n org-imenu-depth)
+ (re (concat "^" (org-get-limited-outline-regexp)))
+ (subs (make-vector (1+ n) nil))
+ (last-level 0)
+ m level head)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (while (re-search-backward re nil t)
+ (setq level (org-reduced-level (funcall outline-level)))
+ (when (and (<= level n)
+ (looking-at org-complex-heading-regexp))
+ (setq head (org-link-display-format
+ (org-match-string-no-properties 4))
+ m (org-imenu-new-marker))
+ (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
+ (if (>= level last-level)
+ (push (cons head m) (aref subs level))
+ (push (cons head (aref subs (1+ level))) (aref subs level))
+ (loop for i from (1+ level) to n do (aset subs i nil)))
+ (setq last-level level)))))
+ (aref subs 1)))
+
+(eval-after-load "imenu"
+ '(progn
+ (add-hook 'imenu-after-jump-hook
+ (lambda ()
+ (if (derived-mode-p 'org-mode)
+ (org-show-context 'org-goto))))))
+
+(defun org-link-display-format (link)
+ "Replace a link with either the description, or the link target
+if no description is present"
+ (save-match-data
+ (if (string-match org-bracket-link-analytic-regexp link)
+ (replace-match (if (match-end 5)
+ (match-string 5 link)
+ (concat (match-string 1 link)
+ (match-string 3 link)))
+ nil t link)
+ link)))
+
+(defun org-toggle-link-display ()
+ "Toggle the literal or descriptive display of links."
+ (interactive)
+ (if org-descriptive-links
+ (progn (org-remove-from-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links nil))
+ (progn (add-to-invisibility-spec '(org-link))
+ (org-restart-font-lock)
+ (setq org-descriptive-links t))))
+
+;; Speedbar support
+
+(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
+ "Overlay marking the agenda restriction line in speedbar.")
+(overlay-put org-speedbar-restriction-lock-overlay
+ 'face 'org-agenda-restriction-lock)
+(overlay-put org-speedbar-restriction-lock-overlay
+ 'help-echo "Agendas are currently limited to this item.")
+(org-detach-overlay org-speedbar-restriction-lock-overlay)
+
+(defun org-speedbar-set-agenda-restriction ()
+ "Restrict future agenda commands to the location at point in speedbar.
+To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
+ (interactive)
+ (require 'org-agenda)
+ (let (p m tp np dir txt)
+ (cond
+ ((setq p (text-property-any (point-at-bol) (point-at-eol)
+ 'org-imenu t))
+ (setq m (get-text-property p 'org-imenu-marker))
+ (with-current-buffer (marker-buffer m)
+ (goto-char m)
+ (org-agenda-set-restriction-lock 'subtree)))
+ ((setq p (text-property-any (point-at-bol) (point-at-eol)
+ 'speedbar-function 'speedbar-find-file))
+ (setq tp (previous-single-property-change
+ (1+ p) 'speedbar-function)
+ np (next-single-property-change
+ tp 'speedbar-function)
+ dir (speedbar-line-directory)
+ txt (buffer-substring-no-properties (or tp (point-min))
+ (or np (point-max))))
+ (with-current-buffer (find-file-noselect
+ (let ((default-directory dir))
+ (expand-file-name txt)))
+ (unless (derived-mode-p 'org-mode)
+ (error "Cannot restrict to non-Org-mode file"))
+ (org-agenda-set-restriction-lock 'file)))
+ (t (error "Don't know how to restrict Org-mode's agenda")))
+ (move-overlay org-speedbar-restriction-lock-overlay
+ (point-at-bol) (point-at-eol))
+ (setq current-prefix-arg nil)
+ (org-agenda-maybe-redo)))
+
+(eval-after-load "speedbar"
+ '(progn
+ (speedbar-add-supported-extension ".org")
+ (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
+ (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
+ (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
+ (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
+ (add-hook 'speedbar-visiting-tag-hook
+ (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto))))))
+
+;;; Fixes and Hacks for problems with other packages
+
+;; Make flyspell not check words in links, to not mess up our keymap
+(defun org-mode-flyspell-verify ()
+ "Don't let flyspell put overlays at active buttons, or on
+ {todo,all-time,additional-option-like}-keywords."
+ (let ((pos (max (1- (point)) (point-min)))
+ (word (thing-at-point 'word)))
+ (and (not (get-text-property pos 'keymap))
+ (not (get-text-property pos 'org-no-flyspell))
+ (not (member word org-todo-keywords-1))
+ (not (member word org-all-time-keywords))
+ (not (member word org-options-keywords))
+ (not (member word (mapcar 'car org-startup-options)))
+ (not (member word org-additional-option-like-keywords-for-flyspell)))))
+
+(defun org-remove-flyspell-overlays-in (beg end)
+ "Remove flyspell overlays in region."
+ (and (org-bound-and-true-p flyspell-mode)
+ (fboundp 'flyspell-delete-region-overlays)
+ (flyspell-delete-region-overlays beg end))
+ (add-text-properties beg end '(org-no-flyspell t)))
+
+;; Make `bookmark-jump' shows the jump location if it was hidden.
+(eval-after-load "bookmark"
+ '(if (boundp 'bookmark-after-jump-hook)
+ ;; We can use the hook
+ (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
+ ;; Hook not available, use advice
+ (defadvice bookmark-jump (after org-make-visible activate)
+ "Make the position visible."
+ (org-bookmark-jump-unhide))))
+
+;; Make sure saveplace shows the location if it was hidden
+(eval-after-load "saveplace"
+ '(defadvice save-place-find-file-hook (after org-make-visible activate)
+ "Make the position visible."
+ (org-bookmark-jump-unhide)))
+
+;; Make sure ecb shows the location if it was hidden
+(eval-after-load "ecb"
+ '(defadvice ecb-method-clicked (after esf/org-show-context activate)
+ "Make hierarchy visible when jumping into location from ECB tree buffer."
+ (if (derived-mode-p 'org-mode)
+ (org-show-context))))
+
+(defun org-bookmark-jump-unhide ()
+ "Unhide the current position, to show the bookmark location."
+ (and (derived-mode-p 'org-mode)
+ (or (outline-invisible-p)
+ (save-excursion (goto-char (max (point-min) (1- (point))))
+ (outline-invisible-p)))
+ (org-show-context 'bookmark-jump)))
+
+;; Make session.el ignore our circular variable
+(eval-after-load "session"
+ '(add-to-list 'session-globals-exclude 'org-mark-ring))
+
+;;;; Experimental code
+
+(defun org-closed-in-range ()
+ "Sparse tree of items closed in a certain time range.
+Still experimental, may disappear in the future."
+ (interactive)
+ ;; Get the time interval from the user.
+ (let* ((time1 (org-float-time
+ (org-read-date nil 'to-time nil "Starting date: ")))
+ (time2 (org-float-time
+ (org-read-date nil 'to-time nil "End date:")))
+ ;; callback function
+ (callback (lambda ()
+ (let ((time
+ (org-float-time
+ (apply 'encode-time
+ (org-parse-time-string
+ (match-string 1))))))
+ ;; check if time in interval
+ (and (>= time time1) (<= time time2))))))
+ ;; make tree, check each match with the callback
+ (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
+
+;;;; Finish up
+
+(provide 'org)
+
+(run-hooks 'org-load-hook)
+
+;;; org.el ends here
diff --git a/local.mk b/local.mk
new file mode 100644
index 0000000..1ee2a95
--- /dev/null
+++ b/local.mk
@@ -0,0 +1 @@
+ORG_MAKE_DOC = info html pdf card
diff --git a/mk/default.mk b/mk/default.mk
new file mode 100644
index 0000000..3e1c550
--- /dev/null
+++ b/mk/default.mk
@@ -0,0 +1,148 @@
+##----------------------------------------------------------------------
+## NEVER EDIT THIS FILE, PUT ANY ADAPTATIONS INTO local.mk
+##-8<-------------------------------------------------------------------
+## CHECK AND ADAPT THE FOLLOWING DEFINITIONS
+##----------------------------------------------------------------------
+
+# Name of your emacs binary
+EMACS = emacs
+
+# Where local software is found
+prefix = /usr/share
+
+# Where local lisp files go.
+lispdir= $(prefix)/emacs/site-lisp/org
+
+# Where local data files go.
+datadir = $(prefix)/emacs/etc/org
+
+# Where info files go.
+infodir = $(prefix)/info
+
+# Define if you only need info documentation, the default includes html and pdf
+#ORG_MAKE_DOC = info # html pdf
+
+# Define if you want to include some (or all) files from contrib/lisp
+# just the filename please (no path prefix, no .el suffix), maybe with globbing
+#ORG_ADD_CONTRIB = org-e-* org-md org-export # e.g. the new exporter
+
+# Where to create temporary files for the testsuite
+# respect TMPDIR if it is already defined in the environment
+TMPDIR ?= /tmp
+testdir = $(TMPDIR)/tmp-orgtest
+
+# Configuration for testing
+# add options before standard load-path
+BTEST_PRE =
+# add options after standard load path
+BTEST_POST =
+ # -L <path-to>/ert # needed for Emacs23, Emacs24 has ert built in
+ # -L <path-to>/ess # needed for running R tests
+ # -L <path-to>/htmlize # need at least version 1.34 for source code formatting
+BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave python sh
+ # R # requires ESS to be installed and configured
+# extra packages to require for testing
+BTEST_EXTRA =
+ # ess-site # load ESS for R tests
+##->8-------------------------------------------------------------------
+## YOU MAY NEED TO ADAPT THESE DEFINITIONS
+##----------------------------------------------------------------------
+
+# How to run tests
+req-ob-lang = --eval '(require '"'"'ob-$(ob-lang))'
+req-extra = --eval '(require '"'"'$(req))'
+BTEST = $(BATCH) \
+ $(BTEST_PRE) \
+ --eval '(add-to-list '"'"'load-path "./lisp")' \
+ --eval '(add-to-list '"'"'load-path "./testing")' \
+ $(BTEST_POST) \
+ -l org-install.el \
+ -l testing/org-test.el \
+ $(foreach ob-lang,$(BTEST_OB_LANGUAGES),$(req-ob-lang)) \
+ $(foreach req,$(BTEST_EXTRA),$(req-extra)) \
+ --eval '(setq org-confirm-babel-evaluate nil)' \
+ -f org-test-run-batch-tests
+
+# Using emacs in batch mode.
+# BATCH = $(EMACS) -batch -vanilla # XEmacs
+BATCH = $(EMACS) -batch -Q
+
+# Emacs must be started in toplevel directory
+BATCHO = $(BATCH) \
+ --eval '(add-to-list '"'"'load-path "./lisp")'
+
+# How to generate local.mk
+MAKE_LOCAL_MK = $(BATCHO) \
+ --eval '(load "org-compat.el")' \
+ --eval '(load "../mk/org-fixup.el")' \
+ --eval '(org-make-local-mk)'
+
+# Emacs must be started in lisp directory
+BATCHL = $(BATCH) \
+ --eval '(add-to-list '"'"'load-path ".")'
+
+# How to generate org-install.el
+MAKE_ORG_INSTALL = $(BATCHL) \
+ --eval '(load "org-compat.el")' \
+ --eval '(load "../mk/org-fixup.el")' \
+ --eval '(org-make-org-install)'
+
+# How to generate org-version.el
+MAKE_ORG_VERSION = $(BATCHL) \
+ --eval '(load "org-compat.el")' \
+ --eval '(load "../mk/org-fixup.el")' \
+ --eval '(org-make-org-version "$(ORGVERSION)" "$(GITVERSION)" "$(datadir)")'
+
+# How to byte-compile the whole source directory
+ELCDIR = $(BATCHL) \
+ --eval '(batch-byte-recompile-directory 0)'
+
+# How to byte-compile a single file
+ELC = $(BATCHL) \
+ --eval '(batch-byte-compile)'
+
+# How to make a pdf file from a texinfo file
+TEXI2PDF = texi2pdf --batch --clean
+
+# How to make a pdf file from a tex file
+PDFTEX = pdftex
+
+# How to create directories with leading path components
+# MKDIR = mkdir -m 755 -p # try this if you have no install
+MKDIR = install -m 755 -d
+
+# How to create the info files from the texinfo file
+MAKEINFO = makeinfo
+
+# How to create the HTML file
+TEXI2HTML = makeinfo --html --number-sections
+
+# How to find files
+FIND = find
+
+# How to remove files
+RM = rm -f
+
+# How to remove files recursively
+RMR = rm -fr
+
+# How to copy the lisp files and elc files to their destination.
+# CP = cp -p # try this if you have no install
+CP = install -m 644 -p
+
+# How to obtain administrative privileges
+# leave blank if you don't need this
+# SUDO =
+SUDO = sudo
+
+# Name of the program to install info files
+# INSTALL_INFO = ginstall-info # Debian: avoid harmless warning message
+INSTALL_INFO = install-info
+
+# target method for 'compile'
+ORGCM = dirall
+# ORGCM = dirall # 1x slowdown compared to default compilation method
+# ORGCM = single # 4x one Emacs process per compilation
+# ORGCM = source # 5x ditto, but remove compiled file immediately
+# ORGCM = slint1 # 3x possibly elicit more warnings
+# ORGCM = slint2 # 7x possibly elicit even more warnings
diff --git a/mk/org-fixup.el b/mk/org-fixup.el
new file mode 100644
index 0000000..80439a9
--- /dev/null
+++ b/mk/org-fixup.el
@@ -0,0 +1,199 @@
+;;; org-fixup.el --- make life easier for folks without GNU make
+;;
+;; Author: Achim Gratz
+;; Keywords: orgmode
+;; Homepage: http://orgmode.org
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, 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; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+(require 'autoload)
+(require 'org-compat "org-compat.el")
+
+(defun org-make-org-version (org-release org-git-version odt-dir)
+ "Make the file org-version.el in the current directory.
+This function is internally used by the build system and should
+be used by foreign build systems or installers to produce this
+file in the installation directory of org-mode. Org will not
+work correctly if this file is not present (except directly from
+the Git work tree)."
+ (with-temp-buffer
+ (insert "\
+;;; org-version.el --- autogenerated file, do not edit
+;;
+;;; Code:
+;;;\#\#\#autoload
+\(defun org-release ()
+ \"The release version of org-mode.
+ Inserted by installing org-mode or when a release is made.\"
+ (let ((org-release \"" org-release "\"))
+ org-release))
+;;;\#\#\#autoload
+\(defun org-git-version ()
+ \"The Git version of org-mode.
+ Inserted by installing org-mode or when a release is made.\"
+ (let ((org-git-version \"" org-git-version "\"))
+ org-git-version))
+;;;\#\#\#autoload
+\(defconst org-odt-data-dir \"" odt-dir "\"
+ \"The location of ODT styles.\")
+\f\n\(provide 'org-version\)
+\f\n;; Local Variables:\n;; version-control: never
+;; no-byte-compile: t
+;; coding: utf-8\n;; End:\n;;; org-version.el ends here\n")
+ (toggle-read-only 0)
+ (write-file "org-version.el")))
+
+(defun org-make-org-install ()
+ "Make the file org-install.el in the current directory.
+This function is internally used by the build system and should
+be used by foreign build systems or installers to produce this
+file in the installation directory of org-mode. Org will not
+work correctly if this file is not up-to-date."
+ (with-temp-buffer
+ (set-visited-file-name "org-install.el")
+ (insert ";;; org-install.el --- autogenerated file, do not edit\n;;\n;;; Code:\n")
+ (let ((files (directory-files default-directory nil "^\\(org\\|ob\\)\\(-.*\\)?\\.el$")))
+ (mapc (lambda (f) (generate-file-autoloads f)) files))
+ (insert "\f\n(provide 'org-install)\n")
+ (insert "\f\n;; Local Variables:\n;; version-control: never\n")
+ (insert ";; no-byte-compile: t\n;; no-update-autoloads: t\n")
+ (insert ";; coding: utf-8\n;; End:\n;;; org-install.el ends here\n")
+ (toggle-read-only 0)
+ (save-buffer)))
+
+(defun org-make-autoloads (&optional compile force)
+ "Make the files org-install and org-version.el in the install directory.
+Finds the install directory by looking for library \"org\".
+Optionally byte-compile lisp files in the install directory or
+force re-compilation. This function is provided for easier
+manual install when the build system can't be used."
+ (let* ((origin default-directory)
+ (dirlisp (org-find-library-dir "org"))
+ (dirorg (concat dirlisp "../" ))
+ (dirodt (if (boundp 'org-odt-data-dir)
+ org-odt-data-dir
+ (concat dirorg "etc/"))))
+ (unwind-protect
+ (progn
+ (cd dirlisp)
+ (org-fixup)
+ (org-make-org-version (org-release) (org-git-version) dirodt)
+ (org-make-org-install)
+ (when compile (byte-recompile-directory dirlisp 0 force)))
+ (cd origin))))
+
+(defun org-make-autoloads-compile ()
+ "Call org-make-autoloads with compile argument.
+Convenience function for easier invocation from command line."
+ (org-make-autoloads 'compile nil))
+
+(defun org-make-autoloads-compile-force ()
+ "Call org-make-autoloads with compile force arguments.
+Convenience function for easier invocation from command line."
+ (org-make-autoloads 'compile 'force))
+
+;; Internal functions
+
+(defun org-make-local-mk ()
+ "Internal function for the build system."
+ (let ((default "mk/default.mk")
+ (local "local.mk"))
+ (unwind-protect
+ (with-temp-buffer
+ (insert-file-contents default)
+ (goto-char (point-min))
+ (when (search-forward "-8<-" nil t)
+ (forward-line 1)
+ (delete-region (point-min) (point)))
+ (when (search-forward "->8-" nil t)
+ (forward-line 0)
+ (delete-region (point) (point-max)))
+ (goto-char (point-min))
+ (insert "
+# Remove \"oldorg:\" to switch to \"all\" as the default target.
+# Change \"oldorg:\" to an existing target to make that target the default,
+# or define your own target here to become the default target.
+oldorg: # do what the old Makefile did by default.
+
+##----------------------------------------------------------------------
+")
+ (goto-char (point-max))
+ (insert "\
+# See default.mk for further configuration options.
+")
+ (toggle-read-only 0)
+ (write-file local))
+ nil)))
+
+(defun org-make-letterformat (a4name lettername)
+ "Internal function for the build system."
+ (unwind-protect
+ (with-temp-buffer
+ (insert-file-contents a4name)
+ (goto-char (point-min))
+ (while (search-forward "\\pdflayout=(0l)" nil t)
+ (replace-match "\\pdflayout=(1l)" nil t))
+ (toggle-read-only 0)
+ (write-file lettername))
+ nil))
+
+;; redefine version functions
+
+(defmacro org-fixup ()
+ (let* ((origin default-directory)
+ (dirlisp (org-find-library-dir "org"))
+ (dirorg (concat dirlisp "../" ))
+ (dirgit (concat dirorg ".git/" ))
+ (org-version "N/A-fixup")
+ (org-git-version "N/A-fixup !!check installation!!"))
+ (if (and (boundp 'org-fake-release) (stringp org-fake-release)
+ (boundp 'org-fake-git-version) (stringp org-fake-git-version))
+ (setq org-version org-fake-release
+ org-git-version org-fake-git-version)
+ (if (load (concat dirlisp "org-version.el") 'noerror 'nomessage 'nosuffix)
+ (setq org-version (org-release)
+ org-git-version (org-git-version))
+ (when (and (file-exists-p dirgit)
+ (executable-find "git"))
+ (unwind-protect
+ (progn
+ (cd dirorg)
+ (let ((git6 (substring (shell-command-to-string "git describe --abbrev=6 HEAD") 0 -1))
+ (git0 (substring (shell-command-to-string "git describe --abbrev=0 HEAD") 0 -1))
+ (gitd (string-match "\\S-"
+ (shell-command-to-string "git status -uno --porcelain"))))
+ (setq org-git-version (concat git6 (when gitd ".dirty") "-git"))
+ (if (string-match "^release_" git0)
+ (setq org-version (substring git0 8))
+ (setq org-version git0))))
+ (cd origin)))))
+ (message "org-fixup.el: redefined Org version")
+ `(progn
+ (defun org-release () ,org-version)
+ (defun org-git-version () ,org-git-version))))
+
+(provide 'org-fixup)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; coding: utf-8
+;; End:
+;;; org-fixup.el ends here
diff --git a/mk/targets.mk b/mk/targets.mk
new file mode 100644
index 0000000..4a9ee60
--- /dev/null
+++ b/mk/targets.mk
@@ -0,0 +1,155 @@
+.EXPORT_ALL_VARIABLES:
+.NOTPARALLEL: .PHONY
+# Additional distribution files
+DISTFILES_extra= Makefile request-assign-future.txt contrib etc
+
+LISPDIRS = lisp
+OTHERDIRS = doc etc
+CLEANDIRS = contrib testing mk
+SUBDIRS = $(OTHERDIRS) $(LISPDIRS)
+INSTSUB = $(SUBDIRS:%=install-%)
+ORG_MAKE_DOC ?= info html pdf
+
+ifneq ($(wildcard .git),)
+ GITVERSION ?= $(shell git describe --abbrev=6 HEAD)
+ ORGVERSION ?= $(subst release_,,$(shell git describe --abbrev=0 HEAD))
+ GITSTATUS ?= $(shell git status -uno --porcelain)
+else
+ -include mk/version.mk
+ GITVERSION ?= N/A
+ ORGVERSION ?= N/A
+endif
+DATE = $(shell date +%Y-%m-%d)
+ifneq ($(GITSTATUS),)
+ GITVERSION := $(GITVERSION:.dirty=).dirty
+endif
+
+.PHONY: all oldorg update update2 up0 up1 up2 single $(SUBDIRS) \
+ check test install $(INSTSUB) \
+ info html pdf card refcard doc docs \
+ autoloads cleanall clean $(CLEANDIRS:%=clean%) \
+ clean-install cleanelc cleandirs cleanaddcontrib \
+ cleanlisp cleandoc cleandocs cleantest \
+ compile compile-dirty uncompiled \
+ config config-test config-exe config-all config-eol config-version
+
+CONF_BASE = EMACS DESTDIR ORGCM ORG_MAKE_DOC
+CONF_DEST = lispdir infodir datadir testdir
+CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA
+CONF_EXEC = CP MKDIR RM RMR FIND SUDO PDFTEX TEXI2PDF TEXI2HTML MAKEINFO INSTALL_INFO
+CONF_CALL = BATCH BATCHL ELC ELCDIR BTEST MAKE_LOCAL_MK MAKE_ORG_INSTALL MAKE_ORG_VERSION
+config-eol:: EOL = \#
+config-eol:: config-all
+config config-all::
+ $(info )
+ $(info ========= Emacs executable and Installation paths)
+ $(foreach var,$(CONF_BASE),$(info $(var) = $($(var))$(EOL)))
+ $(foreach var,$(CONF_DEST),$(info $(var) = $(DESTDIR)$($(var))$(EOL)))
+ $(info ========= Additional files from contrib/lisp)
+ $(info $(notdir \
+ $(wildcard \
+ $(addsuffix .el, \
+ $(addprefix contrib/lisp/, \
+ $(basename \
+ $(notdir $(ORG_ADD_CONTRIB))))))))
+config-test config-all::
+ $(info )
+ $(info ========= Test configuration)
+ $(foreach var,$(CONF_TEST),$(info $(var) = $($(var))$(EOL)))
+config-exe config-all::
+ $(info )
+ $(info ========= Executables used by make)
+ $(foreach var,$(CONF_EXEC),$(info $(var) = $($(var))$(EOL)))
+config-cmd config-all::
+ $(info )
+ $(info ========= Commands used by make)
+ $(foreach var,$(CONF_CALL),$(info $(var) = $($(var))$(EOL)))
+config config-test config-exe config-all config-version::
+ $(info ========= Org version)
+ $(info make: Org-mode version $(ORGVERSION) ($(GITVERSION) => $(lispdir)))
+ @echo ""
+
+oldorg: compile info # what the old makefile did when no target was specified
+uncompiled: cleanlisp autoloads # for developing
+refcard: card
+update update2:: up0 all
+
+single: ORGCM=single
+single: compile
+
+.PRECIOUS: local.mk
+local.mk:
+ $(info ======================================================)
+ $(info = Invoke "make help" for a synopsis of make targets. =)
+ $(info = Created a default local.mk template. =)
+ $(info = Setting "oldorg" as the default target. =)
+ $(info = Please adapt local.mk to your local setup! =)
+ $(info ======================================================)
+ -@$(MAKE_LOCAL_MK)
+
+all compile::
+ $(foreach dir, doc lisp, $(MAKE) -C $(dir) clean;)
+compile compile-dirty::
+ $(MAKE) -C lisp $@
+all clean-install::
+ $(foreach dir, $(SUBDIRS), $(MAKE) -C $(dir) $@;)
+
+check test:: compile
+check test test-dirty::
+ -$(MKDIR) $(testdir)
+ TMPDIR=$(testdir) $(BTEST)
+ifeq ($(TEST_NO_AUTOCLEAN),) # define this variable to leave $(testdir) around for inspection
+ $(MAKE) cleantest
+endif
+
+up0 up1 up2::
+ git remote update
+ git pull
+up1 up2:: all
+ $(MAKE) test-dirty
+up2 update2::
+ $(SUDO) $(MAKE) install
+
+install: $(INSTSUB)
+
+install-info: install-doc
+
+doc docs: $(ORG_MAKE_DOC)
+
+info html pdf card:
+ $(MAKE) -C doc $@
+
+$(INSTSUB):
+ $(MAKE) -C $(@:install-%=%) install
+
+autoloads: lisp
+ $(MAKE) -C $< $@
+
+cleandirs:
+ $(foreach dir, $(SUBDIRS), $(MAKE) -C $(dir) cleanall;)
+
+clean: cleanlisp cleandoc
+
+cleanall: cleandirs cleantest cleanaddcontrib
+ -$(FIND) . \( -name \*~ -o -name \*# -o -name .#\* \) -exec $(RM) {} \;
+ -$(FIND) $(CLEANDIRS) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} \;
+
+$(CLEANDIRS:%=clean%):
+ -$(FIND) $(@:clean%=%) \( -name \*~ -o -name \*.elc \) -exec $(RM) {} \;
+
+cleanelc:
+ $(MAKE) -C lisp $@
+
+cleanaddcontrib:
+ -$(RM) $(wildcard $(addprefix lisp/,$(notdir $(wildcard contrib/lisp/*.el))))
+
+cleanlisp: cleanaddcontrib
+cleanlisp cleandoc:
+ $(MAKE) -C $(@:clean%=%) clean
+
+cleandocs:
+ $(MAKE) -C doc clean
+ -$(FIND) doc -name \*~ -exec $(RM) {} \;
+
+cleantest:
+ $(RMR) $(testdir)
diff --git a/mk/version.mk b/mk/version.mk
new file mode 100644
index 0000000..0d9c7af
--- /dev/null
+++ b/mk/version.mk
@@ -0,0 +1,2 @@
+ORGVERSION ?= 7.9.2
+GITVERSION ?= 7.9.2-dist
diff --git a/request-assign-future.txt b/request-assign-future.txt
new file mode 100644
index 0000000..8ee7747
--- /dev/null
+++ b/request-assign-future.txt
@@ -0,0 +1,44 @@
+Please email the following information to assign@gnu.org, and we
+will send you the assignment form for your past and future changes.
+
+Please use your full legal name (in ASCII characters) as the subject
+line of the message.
+----------------------------------------------------------------------
+REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES
+
+[What is the name of the program or package you're contributing to?]
+
+ Org-mode, which is part of Emacs
+
+[Did you copy any files or text written by someone else in these changes?
+Even if that material is free software, we need to know about it.]
+
+
+[Do you have an employer who might have a basis to claim to own
+your changes? Do you attend a school which might make such a claim?]
+
+
+[For the copyright registration, what country are you a citizen of?]
+
+
+[What year were you born?]
+
+
+[Please write your email address here.]
+
+
+[Please write your postal address here.]
+
+
+
+
+
+[Which files have you changed so far, and which new files have you written
+so far?]
+
+
+
+
+
+
+